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

Ter leering ende vermaeck

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!

Posts in this Series