The Haskell cryptonite package is used to allow for encrypted fields in a JSON settings file. Source code listed below.
Example JSON settings file
{"_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
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Mammon.Settings where
import Control.Lens
import Control.Monad (unless, when)
import Crypto.Cipher.AES (AES256)
import Data.Aeson
import Data.ByteArray (unpack)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import GHC.Generics
import qualified Mammon.Security as MS
import qualified Mammon.Types as MT
import qualified Mammon.Utils as MU
import System.Directory (createDirectoryIfMissing, doesFileExist)
import System.FilePath (addTrailingPathSeparator)
settingsPath :: FilePath
= ".binance"
settingsPath
settingsFile :: FilePath
= "binance-api-settings.json"
settingsFile
data AppSettingsSecurity = AppSettingsSecurity
_initIV :: T.Text,
{ _salt :: T.Text
}deriving (Generic, Read, Show, FromJSON, ToJSON)
'AppSettingsSecurity
makeLenses '
data AppSettings = AppSettings
_apiKey :: T.Text,
{ _apiKeySecurity :: AppSettingsSecurity,
_apiSecret :: T.Text,
_apiSecretSecurity :: AppSettingsSecurity,
_dbConnectionUriPrefix :: T.Text,
_dbConnectionUriPostfix :: T.Text
}deriving (Generic, Read, Show, FromJSON, ToJSON)
'AppSettings
makeLenses '
=
mkAppSettings AppSettings
= "binance-api-key-goes-here",
{ _apiKey =
_apiKeySecurity AppSettingsSecurity
= "",
{ _initIV = ""
_salt
},= "binance-api-secret-goes-here",
_apiSecret =
_apiSecretSecurity AppSettingsSecurity
= "",
{ _initIV = ""
_salt
},= "sqlite://",
_dbConnectionUriPrefix = "db/binance-api.db"
_dbConnectionUriPostfix
}
getAppBinanceApiKey :: Either String AppSettings -> T.Text
= case eas of
getAppBinanceApiKey eas Left e -> T.pack e
Right a -> _apiKey a
getAppBinanceApiKeySecurity :: Either String AppSettings -> (T.Text, T.Text)
= case eas of
getAppBinanceApiKeySecurity eas Left e -> let pe = T.pack e in (pe, pe)
Right a ->
let ak = _apiKeySecurity a
in (_initIV ak, _salt ak)
getAppBinanceApiSecret :: Either String AppSettings -> T.Text
= case eas of
getAppBinanceApiSecret eas Left e -> T.pack e
Right a -> _apiSecret a
getAppBinanceApiSecretSecurity :: Either String AppSettings -> (T.Text, T.Text)
= case eas of
getAppBinanceApiSecretSecurity eas Left e -> let pe = T.pack e in (pe, pe)
Right a ->
let ak = _apiSecretSecurity a
in (_initIV ak, _salt ak)
getAppBinanceDbUri :: FilePath -> Either String AppSettings -> T.Text
= case eas of
getAppBinanceDbUri fp eas Left e -> T.pack e
Right a -> _dbConnectionUriPrefix a <> T.pack (addTrailingPathSeparator fp) <> _dbConnectionUriPostfix a
readSettings :: FilePath -> MS.SecurityKey -> MT.Verbosity -> IO (Either String AppSettings)
= do
readSettings binanceApiHome securityKey verbosity <- getSettingsFromFile binanceApiHome
appSettings
decryptSettings appSettingswhere
= do
getSettingsFromFile bah let sfd = addTrailingPathSeparator bah <> addTrailingPathSeparator settingsPath
= sfd <> settingsFile
sfn <- checkSettingsExist sfd sfn
settingsExists == MT.Verbose) $
when (verbosity putStrLn $
"Settings file "
<> sfn
<> " "
<> if settingsExists
then "EXISTS"
else "CREATING (now edit Binance secret and -key in your settings file; execute encodeSettings with chosen securityKey"
$ do
unless settingsExists $ encode mkAppSettings
BL.writeFile sfn <$> getJSON sfn) :: IO (Either String AppSettings)
(eitherDecode decryptSettings :: Either String AppSettings -> IO (Either String AppSettings)
= do
decryptSettings as let apk = getAppBinanceApiKey as
= getAppBinanceApiKeySecurity as
(apksi, apkss) = getAppBinanceApiSecret as
aps = getAppBinanceApiSecretSecurity as
(apssi, apsss) <- decryptWithSecurityKey securityKey apksi apkss (MU.b64ToBS apk)
eak let eakt = TE.decodeUtf8 eak
<- decryptWithSecurityKey securityKey apssi apsss (MU.b64ToBS aps)
eas let east = TE.decodeUtf8 eas
pure $ case as of
Left e -> Left e
Right as' -> Right $ as' & apiKey .~ eakt & apiSecret .~ east
decryptWithSecurityKey :: MS.SecurityKey -> T.Text -> T.Text -> BS.ByteString -> IO BS.ByteString
= do
decryptWithSecurityKey sk pInitIV pSalt pd <- MS.mkIV (undefined :: AES256) $ MU.b64ToBS pInitIV
mInitIV let salt = MU.b64ToBS pSalt
= MS.deriveKey sk salt
key case mInitIV of
Nothing -> error "Failed to read the initialization vector (have you run with -e to encrypt plaintext Binance secret and -key?)"
Just initIV -> do
pure $ MS.decrypt key initIV pd
encodeSettings :: FilePath -> MS.SecurityKey -> MT.Verbosity -> IO (Either String AppSettings)
= do
encodeSettings binanceApiHome securityKey verbosity let sfd = addTrailingPathSeparator binanceApiHome <> addTrailingPathSeparator settingsPath
= sfd <> settingsFile
sfn <- initializeAppSettingsFile sfd sfn
appSettings
encryptSettings appSettings sfnwhere
= do
initializeAppSettingsFile sfd sfn <- checkSettingsExist sfd sfn
settingsExists $ do
unless settingsExists $ encode mkAppSettings
BL.writeFile sfn == MT.Verbose) $
when (verbosity putStrLn $
"Settings file "
<> sfn
<> " "
<> if settingsExists
then "EXISTS"
else "CREATING"
<$> getJSON sfn) :: IO (Either String AppSettings)
(eitherDecode encryptSettings :: Either String AppSettings -> FilePath -> IO (Either String AppSettings)
= do
encryptSettings as sfn let apk = getAppBinanceApiKey as
= getAppBinanceApiSecret as
aps <- encryptWithSecurityKey securityKey (TE.encodeUtf8 apk)
(ik, sk, eak) <- encryptWithSecurityKey securityKey (TE.encodeUtf8 aps)
(is, ss, eas) case as of
Left e -> pure $ Left e
Right as' ->
do
let as'' =
as'& apiKey .~ MU.b64FromBS eak
& apiKeySecurity .~ AppSettingsSecurity {_initIV = ik, _salt = sk}
& apiSecret .~ MU.b64FromBS eas
& apiSecretSecurity .~ AppSettingsSecurity {_initIV = is, _salt = ss}
$ encode as''
BL.writeFile sfn pure $ Right as''
encryptWithSecurityKey :: MS.SecurityKey -> BS.ByteString -> IO (T.Text, T.Text, BS.ByteString)
= do
encryptWithSecurityKey sk pd <- MS.random MS.saltSize
salt <- MS.genRandomIV (undefined :: AES256)
mInitIV case mInitIV of
Nothing -> error "Failed to generate a random initialization vector (check your software source code)."
Just initIV -> do
let key = MS.deriveKey sk salt
let initIV' = MU.b64FromW8Array $ unpack initIV
let salt' = MU.b64FromBS salt
pure (initIV', salt', MS.encrypt key initIV pd)
-- | Checks for existing settings.
= do
checkSettingsExist sfd sfn True sfd
createDirectoryIfMissing
doesFileExist sfn
-- | Get JSON from file denoted by path.
getJSON :: FilePath -> IO BL.ByteString
= BL.readFile getJSON
Security.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Mammon.Security where
import Crypto.Cipher.AES (AES256)
import Crypto.Cipher.Types (BlockCipher (..), Cipher (..), IV, makeIV)
import Crypto.Error (throwCryptoError)
import Crypto.KDF.Scrypt (Parameters (..), generate)
import Crypto.Random (getSystemDRG, randomBytesGenerate)
import qualified Crypto.Random.Types as CRT
import qualified Data.ByteString as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Word
saltSize :: Int
= 32
saltSize
= 16 :: Word64
paramN
= 8
paramR
= 1
paramP
= 32
paramKeyLen
type SecurityKey = T.Text
-- | AES256 encryption
encrypt :: BS.ByteString -> IV AES256 -> BS.ByteString -> BS.ByteString
= ctrCombine ctx
encrypt key where
ctx :: AES256
= throwCryptoError $ cipherInit key
ctx
-- | i.e. encrypt (because symmetrical)
decrypt :: BS.ByteString -> IV AES256 -> BS.ByteString -> BS.ByteString
= encrypt
decrypt
-- | Generate a random initialization vector for a given block cipher
genRandomIV :: forall m c. (CRT.MonadRandom m, BlockCipher c) => c -> m (Maybe (IV c))
= do
genRandomIV _ bytes :: BS.ByteString <- CRT.getRandomBytes $ blockSize (undefined :: c)
return $ makeIV bytes
mkIV :: forall m c. (CRT.MonadRandom m, BlockCipher c) => c -> BS.ByteString -> m (Maybe (IV c))
= do
mkIV _ iv let bytes :: BS.ByteString = iv
return $ makeIV bytes
-- | Scrypt KDF
--
-- `password` security key
-- `salt` salt value
deriveKey :: T.Text -> BS.ByteString -> BS.ByteString
= generate params (TE.encodeUtf8 password)
deriveKey password where
= Parameters {n = paramN, r = paramR, p = paramP, outputLength = paramKeyLen}
params
-- | For generating the salt
random :: Int -> IO BS.ByteString
= do
random size <- getSystemDRG
drg let (bytes, _) = randomBytesGenerate size drg
return bytes
Utils.hs
module Mammon.Utils where
import Data.ByteArray.Encoding (Base (Base64), convertFromBase, convertToBase)
import qualified Data.ByteString as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import GHC.Word (Word8)
b64FromBS :: BS.ByteString -> T.Text
= TE.decodeUtf8 (convertToBase Base64 bs :: BS.ByteString)
b64FromBS bs
b64ToBS :: T.Text -> BS.ByteString
= case convertFromBase Base64 (TE.encodeUtf8 ts) :: Either String BS.ByteString of
b64ToBS ts Left e -> TE.encodeUtf8 (T.pack e)
Right bs -> bs
b64FromW8Array :: [Word8] -> T.Text
= b64FromBS . BS.pack
b64FromW8Array
b64ToW8Array :: T.Text -> [Word8]
= BS.unpack . b64ToBS
b64ToW8Array
Types.hs
module Mammon.Types where
data Verbosity = Normal | Verbose deriving (Eq)
data Connection = Connected | Disconnected deriving (Eq)
data 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!