Encrypted fields in JSON settings file
The Haskell cryptonite package is used to allow for encrypted fields in a JSON settings file. Source code listed below.
Example JSON settings file
1{"_apiKey":"f0KBfirFsznsAr/4s3q4TYpawUumsVGeBg==","_apiKeySecurity":{"_initIV":"nyT7ZdnFD4+8BJ9rHFMrFQ==","_salt":"1uEgA3kzWZBU5vqr/AKhhtwhCCCkuXZmTsVVbILilcU="},"_apiSecret":"y1UGRtm3IGMDKPb4I9pR/KmO8+gjyMScxeRBfw==","_apiSecretSecurity":{"_initIV":"Bpj0VfEVtwor0GQzKRVraA==","_salt":"BnC1a9BlmnK+FzZIVRnZwub74lhyZQgdW8JClKLkxq4="},"_dbConnectionUriPostfix":"db/binance-api.db","_dbConnectionUriPrefix":"sqlite://"}
Settings.hs
1{-# LANGUAGE DeriveAnyClass #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE TemplateHaskell #-}
6
7module Mammon.Settings where
8
9import Control.Lens
10import Control.Monad (unless, when)
11import Crypto.Cipher.AES (AES256)
12import Data.Aeson
13import Data.ByteArray (unpack)
14import qualified Data.ByteString as BS
15import qualified Data.ByteString.Lazy as BL
16import qualified Data.Text as T
17import qualified Data.Text.Encoding as TE
18import GHC.Generics
19import qualified Mammon.Security as MS
20import qualified Mammon.Types as MT
21import qualified Mammon.Utils as MU
22import System.Directory (createDirectoryIfMissing, doesFileExist)
23import System.FilePath (addTrailingPathSeparator)
24
25settingsPath :: FilePath
26settingsPath = ".binance"
27
28settingsFile :: FilePath
29settingsFile = "binance-api-settings.json"
30
31data AppSettingsSecurity = AppSettingsSecurity
32 { _initIV :: T.Text,
33 _salt :: T.Text
34 }
35 deriving (Generic, Read, Show, FromJSON, ToJSON)
36
37makeLenses ''AppSettingsSecurity
38
39data AppSettings = AppSettings
40 { _apiKey :: T.Text,
41 _apiKeySecurity :: AppSettingsSecurity,
42 _apiSecret :: T.Text,
43 _apiSecretSecurity :: AppSettingsSecurity,
44 _dbConnectionUriPrefix :: T.Text,
45 _dbConnectionUriPostfix :: T.Text
46 }
47 deriving (Generic, Read, Show, FromJSON, ToJSON)
48
49makeLenses ''AppSettings
50
51mkAppSettings =
52 AppSettings
53 { _apiKey = "binance-api-key-goes-here",
54 _apiKeySecurity =
55 AppSettingsSecurity
56 { _initIV = "",
57 _salt = ""
58 },
59 _apiSecret = "binance-api-secret-goes-here",
60 _apiSecretSecurity =
61 AppSettingsSecurity
62 { _initIV = "",
63 _salt = ""
64 },
65 _dbConnectionUriPrefix = "sqlite://",
66 _dbConnectionUriPostfix = "db/binance-api.db"
67 }
68
69getAppBinanceApiKey :: Either String AppSettings -> T.Text
70getAppBinanceApiKey eas = case eas of
71 Left e -> T.pack e
72 Right a -> _apiKey a
73
74getAppBinanceApiKeySecurity :: Either String AppSettings -> (T.Text, T.Text)
75getAppBinanceApiKeySecurity eas = case eas of
76 Left e -> let pe = T.pack e in (pe, pe)
77 Right a ->
78 let ak = _apiKeySecurity a
79 in (_initIV ak, _salt ak)
80
81getAppBinanceApiSecret :: Either String AppSettings -> T.Text
82getAppBinanceApiSecret eas = case eas of
83 Left e -> T.pack e
84 Right a -> _apiSecret a
85
86getAppBinanceApiSecretSecurity :: Either String AppSettings -> (T.Text, T.Text)
87getAppBinanceApiSecretSecurity eas = case eas of
88 Left e -> let pe = T.pack e in (pe, pe)
89 Right a ->
90 let ak = _apiSecretSecurity a
91 in (_initIV ak, _salt ak)
92
93getAppBinanceDbUri :: FilePath -> Either String AppSettings -> T.Text
94getAppBinanceDbUri fp eas = case eas of
95 Left e -> T.pack e
96 Right a -> _dbConnectionUriPrefix a <> T.pack (addTrailingPathSeparator fp) <> _dbConnectionUriPostfix a
97
98readSettings :: FilePath -> MS.SecurityKey -> MT.Verbosity -> IO (Either String AppSettings)
99readSettings binanceApiHome securityKey verbosity = do
100 appSettings <- getSettingsFromFile binanceApiHome
101 decryptSettings appSettings
102 where
103 getSettingsFromFile bah = do
104 let sfd = addTrailingPathSeparator bah <> addTrailingPathSeparator settingsPath
105 sfn = sfd <> settingsFile
106 settingsExists <- checkSettingsExist sfd sfn
107 when (verbosity == MT.Verbose) $
108 putStrLn $
109 "Settings file "
110 <> sfn
111 <> " "
112 <> if settingsExists
113 then "EXISTS"
114 else "CREATING (now edit Binance secret and -key in your settings file; execute encodeSettings with chosen securityKey"
115 unless settingsExists $ do
116 BL.writeFile sfn $ encode mkAppSettings
117 (eitherDecode <$> getJSON sfn) :: IO (Either String AppSettings)
118 decryptSettings :: Either String AppSettings -> IO (Either String AppSettings)
119 decryptSettings as = do
120 let apk = getAppBinanceApiKey as
121 (apksi, apkss) = getAppBinanceApiKeySecurity as
122 aps = getAppBinanceApiSecret as
123 (apssi, apsss) = getAppBinanceApiSecretSecurity as
124 eak <- decryptWithSecurityKey securityKey apksi apkss (MU.b64ToBS apk)
125 let eakt = TE.decodeUtf8 eak
126 eas <- decryptWithSecurityKey securityKey apssi apsss (MU.b64ToBS aps)
127 let east = TE.decodeUtf8 eas
128 pure $ case as of
129 Left e -> Left e
130 Right as' -> Right $ as' & apiKey .~ eakt & apiSecret .~ east
131
132decryptWithSecurityKey :: MS.SecurityKey -> T.Text -> T.Text -> BS.ByteString -> IO BS.ByteString
133decryptWithSecurityKey sk pInitIV pSalt pd = do
134 mInitIV <- MS.mkIV (undefined :: AES256) $ MU.b64ToBS pInitIV
135 let salt = MU.b64ToBS pSalt
136 key = MS.deriveKey sk salt
137 case mInitIV of
138 Nothing -> error "Failed to read the initialization vector (have you run with -e to encrypt plaintext Binance secret and -key?)"
139 Just initIV -> do
140 pure $ MS.decrypt key initIV pd
141
142encodeSettings :: FilePath -> MS.SecurityKey -> MT.Verbosity -> IO (Either String AppSettings)
143encodeSettings binanceApiHome securityKey verbosity = do
144 let sfd = addTrailingPathSeparator binanceApiHome <> addTrailingPathSeparator settingsPath
145 sfn = sfd <> settingsFile
146 appSettings <- initializeAppSettingsFile sfd sfn
147 encryptSettings appSettings sfn
148 where
149 initializeAppSettingsFile sfd sfn = do
150 settingsExists <- checkSettingsExist sfd sfn
151 unless settingsExists $ do
152 BL.writeFile sfn $ encode mkAppSettings
153 when (verbosity == MT.Verbose) $
154 putStrLn $
155 "Settings file "
156 <> sfn
157 <> " "
158 <> if settingsExists
159 then "EXISTS"
160 else "CREATING"
161 (eitherDecode <$> getJSON sfn) :: IO (Either String AppSettings)
162 encryptSettings :: Either String AppSettings -> FilePath -> IO (Either String AppSettings)
163 encryptSettings as sfn = do
164 let apk = getAppBinanceApiKey as
165 aps = getAppBinanceApiSecret as
166 (ik, sk, eak) <- encryptWithSecurityKey securityKey (TE.encodeUtf8 apk)
167 (is, ss, eas) <- encryptWithSecurityKey securityKey (TE.encodeUtf8 aps)
168 case as of
169 Left e -> pure $ Left e
170 Right as' ->
171 do
172 let as'' =
173 as'
174 & apiKey .~ MU.b64FromBS eak
175 & apiKeySecurity .~ AppSettingsSecurity {_initIV = ik, _salt = sk}
176 & apiSecret .~ MU.b64FromBS eas
177 & apiSecretSecurity .~ AppSettingsSecurity {_initIV = is, _salt = ss}
178 BL.writeFile sfn $ encode as''
179 pure $ Right as''
180
181encryptWithSecurityKey :: MS.SecurityKey -> BS.ByteString -> IO (T.Text, T.Text, BS.ByteString)
182encryptWithSecurityKey sk pd = do
183 salt <- MS.random MS.saltSize
184 mInitIV <- MS.genRandomIV (undefined :: AES256)
185 case mInitIV of
186 Nothing -> error "Failed to generate a random initialization vector (check your software source code)."
187 Just initIV -> do
188 let key = MS.deriveKey sk salt
189 let initIV' = MU.b64FromW8Array $ unpack initIV
190 let salt' = MU.b64FromBS salt
191 pure (initIV', salt', MS.encrypt key initIV pd)
192
193-- | Checks for existing settings.
194checkSettingsExist sfd sfn = do
195 createDirectoryIfMissing True sfd
196 doesFileExist sfn
197
198-- | Get JSON from file denoted by path.
199getJSON :: FilePath -> IO BL.ByteString
200getJSON = BL.readFile
Security.hs
1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3
4module Mammon.Security where
5
6import Crypto.Cipher.AES (AES256)
7import Crypto.Cipher.Types (BlockCipher (..), Cipher (..), IV, makeIV)
8import Crypto.Error (throwCryptoError)
9import Crypto.KDF.Scrypt (Parameters (..), generate)
10import Crypto.Random (getSystemDRG, randomBytesGenerate)
11import qualified Crypto.Random.Types as CRT
12import qualified Data.ByteString as BS
13import qualified Data.Text as T
14import qualified Data.Text.Encoding as TE
15import Data.Word
16
17saltSize :: Int
18saltSize = 32
19
20paramN = 16 :: Word64
21
22paramR = 8
23
24paramP = 1
25
26paramKeyLen = 32
27
28type SecurityKey = T.Text
29
30-- | AES256 encryption
31encrypt :: BS.ByteString -> IV AES256 -> BS.ByteString -> BS.ByteString
32encrypt key = ctrCombine ctx
33 where
34 ctx :: AES256
35 ctx = throwCryptoError $ cipherInit key
36
37-- | i.e. encrypt (because symmetrical)
38decrypt :: BS.ByteString -> IV AES256 -> BS.ByteString -> BS.ByteString
39decrypt = encrypt
40
41-- | Generate a random initialization vector for a given block cipher
42genRandomIV :: forall m c. (CRT.MonadRandom m, BlockCipher c) => c -> m (Maybe (IV c))
43genRandomIV _ = do
44 bytes :: BS.ByteString <- CRT.getRandomBytes $ blockSize (undefined :: c)
45 return $ makeIV bytes
46
47mkIV :: forall m c. (CRT.MonadRandom m, BlockCipher c) => c -> BS.ByteString -> m (Maybe (IV c))
48mkIV _ iv = do
49 let bytes :: BS.ByteString = iv
50 return $ makeIV bytes
51
52-- | Scrypt KDF
53--
54-- `password` security key
55-- `salt` salt value
56deriveKey :: T.Text -> BS.ByteString -> BS.ByteString
57deriveKey password = generate params (TE.encodeUtf8 password)
58 where
59 params = Parameters {n = paramN, r = paramR, p = paramP, outputLength = paramKeyLen}
60
61-- | For generating the salt
62random :: Int -> IO BS.ByteString
63random size = do
64 drg <- getSystemDRG
65 let (bytes, _) = randomBytesGenerate size drg
66 return bytes
Utils.hs
1module Mammon.Utils where
2
3import Data.ByteArray.Encoding (Base (Base64), convertFromBase, convertToBase)
4import qualified Data.ByteString as BS
5import qualified Data.Text as T
6import qualified Data.Text.Encoding as TE
7import GHC.Word (Word8)
8
9b64FromBS :: BS.ByteString -> T.Text
10b64FromBS bs = TE.decodeUtf8 (convertToBase Base64 bs :: BS.ByteString)
11
12b64ToBS :: T.Text -> BS.ByteString
13b64ToBS ts = case convertFromBase Base64 (TE.encodeUtf8 ts) :: Either String BS.ByteString of
14 Left e -> TE.encodeUtf8 (T.pack e)
15 Right bs -> bs
16
17b64FromW8Array :: [Word8] -> T.Text
18b64FromW8Array = b64FromBS . BS.pack
19
20b64ToW8Array :: T.Text -> [Word8]
21b64ToW8Array = BS.unpack . b64ToBS
Types.hs
1module Mammon.Types where
2
3data Verbosity = Normal | Verbose deriving (Eq)
4
5data Connection = Connected | Disconnected deriving (Eq)
6
7data Trading = Unarmed | Armed deriving (Eq)
Disclaimer
This code appears to work, but I have not battle tested it, hence no guarantees are given at all! Specifically the paramN, paramR and paramP values for deriveKey may need revising — see the Crypto.KDF.Scrypt documentation.
Use this software at your own risk — caveat emptor!