{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{- | CLI application harness.
-}
module Console.Binance.Exports.Main
    ( run
    , getArgs
    , Args(..)
    , loadConfigFile
    , ConfigFile(..)
    ) where

import           Control.Applicative            ( (<|>) )
import           Control.Exception.Safe         ( try )
import           Control.Monad                  ( (<=<) )
import           Control.Monad.IO.Class         ( liftIO )
import           Data.Aeson                     ( (.:)
                                                , FromJSON(..)
                                                , withObject
                                                )
import           Data.List                      ( sortOn )
import           Data.Maybe                     ( fromMaybe )
import           Data.Ord                       ( Down(..) )
import           Data.Time                      ( UTCTime(..)
                                                , toGregorian
                                                )
import           Data.Time.Clock.POSIX          ( posixSecondsToUTCTime )
import           Data.Version                   ( showVersion )
import           Data.Yaml                      ( prettyPrintParseException )
import           Data.Yaml.Config               ( ignoreEnv
                                                , loadYamlSettings
                                                )
import           System.Console.CmdArgs         ( (&=)
                                                , Data
                                                , Typeable
                                                , args
                                                , cmdArgs
                                                , def
                                                , details
                                                , explicit
                                                , help
                                                , helpArg
                                                , name
                                                , program
                                                , summary
                                                , typ
                                                )
import           System.Directory               ( doesFileExist )
import           System.Environment             ( lookupEnv )
import           System.Environment.XDG.BaseDir ( getUserConfigFile )
import           System.Exit                    ( exitFailure )
import           System.IO                      ( hPutStrLn
                                                , stderr
                                                )
import           Text.RawString.QQ              ( r )

import           Console.Binance.Exports.Csv
import           Paths_binance_exports          ( version )
import           Web.Binance

import qualified Data.ByteString.Lazy.Char8    as LBS
import qualified Data.Text                     as T
import qualified Data.Text.IO                  as T


-- | Generate & print a trade export based on the executable arguments.
run :: ConfigFile -> Args -> IO ()
run :: ConfigFile -> Args -> IO ()
run ConfigFile
cfg Args
cfgArgs = do
    AppConfig {[Text]
Maybe Integer
Maybe FilePath
BinanceConfig
outputFile :: AppConfig -> Maybe FilePath
year :: AppConfig -> Maybe Integer
symbols :: AppConfig -> [Text]
binanceCfg :: AppConfig -> BinanceConfig
outputFile :: Maybe FilePath
year :: Maybe Integer
symbols :: [Text]
binanceCfg :: BinanceConfig
..} <- ConfigFile -> Args -> IO AppConfig
mergeCfgEnvArgs ConfigFile
cfg Args
cfgArgs
    [TradeExportData]
results        <- BinanceConfig
-> BinanceApiM [TradeExportData] -> IO [TradeExportData]
forall a. BinanceConfig -> BinanceApiM a -> IO a
runApi BinanceConfig
binanceCfg (BinanceApiM [TradeExportData] -> IO [TradeExportData])
-> BinanceApiM [TradeExportData] -> IO [TradeExportData]
forall a b. (a -> b) -> a -> b
$ do
        [SymbolDetails]
symbolDetails <-
            (ExchangeInfo -> [SymbolDetails])
-> BinanceApiM ExchangeInfo -> BinanceApiM [SymbolDetails]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExchangeInfo -> [SymbolDetails]
eiSymbols (BinanceApiM ExchangeInfo -> BinanceApiM [SymbolDetails])
-> BinanceApiM ExchangeInfo -> BinanceApiM [SymbolDetails]
forall a b. (a -> b) -> a -> b
$ [Text] -> BinanceApiM (Either BinanceError ExchangeInfo)
forall (m :: * -> *).
(MonadHttp m, MonadCatch m) =>
[Text] -> m (Either BinanceError ExchangeInfo)
getExchangeInfo [Text]
symbols BinanceApiM (Either BinanceError ExchangeInfo)
-> (Either BinanceError ExchangeInfo -> BinanceApiM ExchangeInfo)
-> BinanceApiM ExchangeInfo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either BinanceError ExchangeInfo -> BinanceApiM ExchangeInfo
forall a. Either BinanceError a -> BinanceApiM a
handleBinanceError
        [TradeExportData]
rawExportData <- [[TradeExportData]] -> [TradeExportData]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[TradeExportData]] -> [TradeExportData])
-> BinanceApiM [[TradeExportData]] -> BinanceApiM [TradeExportData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SymbolDetails -> BinanceApiM [TradeExportData])
-> [SymbolDetails] -> BinanceApiM [[TradeExportData]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SymbolDetails -> BinanceApiM [TradeExportData]
getTradesForSymbol [SymbolDetails]
symbolDetails
        [TradeExportData] -> BinanceApiM [TradeExportData]
forall (m :: * -> *) a. Monad m => a -> m a
return ([TradeExportData] -> BinanceApiM [TradeExportData])
-> ([TradeExportData] -> [TradeExportData])
-> [TradeExportData]
-> BinanceApiM [TradeExportData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Integer -> [TradeExportData] -> [TradeExportData]
filterYear Maybe Integer
year ([TradeExportData] -> BinanceApiM [TradeExportData])
-> [TradeExportData] -> BinanceApiM [TradeExportData]
forall a b. (a -> b) -> a -> b
$ (TradeExportData -> Down POSIXTime)
-> [TradeExportData] -> [TradeExportData]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (POSIXTime -> Down POSIXTime
forall a. a -> Down a
Down (POSIXTime -> Down POSIXTime)
-> (TradeExportData -> POSIXTime)
-> TradeExportData
-> Down POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trade -> POSIXTime
tTime (Trade -> POSIXTime)
-> (TradeExportData -> Trade) -> TradeExportData -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TradeExportData -> Trade
tedTrade)
                                          [TradeExportData]
rawExportData
    -- Write CSV to file or stdout
    let outputFileOrStdout :: FilePath
outputFileOrStdout = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"-" Maybe FilePath
outputFile
    let output :: ByteString
output             = [TradeExportData] -> ByteString
buildTradeExport [TradeExportData]
results
    if FilePath
outputFileOrStdout FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"-"
        then ByteString -> IO ()
LBS.putStr ByteString
output
        else FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
outputFileOrStdout ByteString
output
  where
    -- | If an error is present, print the code & message to stderr, then
    -- exit with an error status code.
    handleBinanceError :: Either BinanceError a -> BinanceApiM a
    handleBinanceError :: Either BinanceError a -> BinanceApiM a
handleBinanceError = \case
        Left BinanceError
e ->
            IO a -> BinanceApiM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
                (IO a -> BinanceApiM a) -> IO a -> BinanceApiM a
forall a b. (a -> b) -> a -> b
$  Text -> IO a
forall a. Text -> IO a
exitWithErr
                (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$  Text
"Binance API Error Code "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath) -> Int -> FilePath
forall a b. (a -> b) -> a -> b
$ BinanceError -> Int
beCode BinanceError
e)
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BinanceError -> Text
beMsg BinanceError
e
        Right a
a -> a -> BinanceApiM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    -- | Get all trades for the given symbol & convert them into the export
    -- format.
    getTradesForSymbol :: SymbolDetails -> BinanceApiM [TradeExportData]
    getTradesForSymbol :: SymbolDetails -> BinanceApiM [TradeExportData]
getTradesForSymbol SymbolDetails
s =
        (Trade -> TradeExportData) -> [Trade] -> [TradeExportData]
forall a b. (a -> b) -> [a] -> [b]
map (SymbolDetails -> Trade -> TradeExportData
TradeExportData SymbolDetails
s) ([Trade] -> [TradeExportData])
-> BinanceApiM [Trade] -> BinanceApiM [TradeExportData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe UTCTime -> Maybe UTCTime -> BinanceApiM [Trade]
forall (m :: * -> *).
(MonadHttp m, MonadReader BinanceConfig m) =>
Text -> Maybe UTCTime -> Maybe UTCTime -> m [Trade]
getTradeHistory (SymbolDetails -> Text
sdSymbol SymbolDetails
s) Maybe UTCTime
forall a. Maybe a
Nothing Maybe UTCTime
forall a. Maybe a
Nothing
    -- | Filter the trades if a 'year' argument has been passed.
    filterYear :: Maybe Integer -> [TradeExportData] -> [TradeExportData]
    filterYear :: Maybe Integer -> [TradeExportData] -> [TradeExportData]
filterYear = \case
        Maybe Integer
Nothing -> [TradeExportData] -> [TradeExportData]
forall a. a -> a
id
        Just Integer
y ->
            (TradeExportData -> Bool) -> [TradeExportData] -> [TradeExportData]
forall a. (a -> Bool) -> [a] -> [a]
filter
                ((TradeExportData -> Bool)
 -> [TradeExportData] -> [TradeExportData])
-> (TradeExportData -> Bool)
-> [TradeExportData]
-> [TradeExportData]
forall a b. (a -> b) -> a -> b
$ (\(Integer
y_, Int
_, Int
_) -> Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
y_)
                ((Integer, Int, Int) -> Bool)
-> (TradeExportData -> (Integer, Int, Int))
-> TradeExportData
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, Int, Int)
toGregorian
                (Day -> (Integer, Int, Int))
-> (TradeExportData -> Day)
-> TradeExportData
-> (Integer, Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Day
utctDay
                (UTCTime -> Day)
-> (TradeExportData -> UTCTime) -> TradeExportData -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime
                (POSIXTime -> UTCTime)
-> (TradeExportData -> POSIXTime) -> TradeExportData -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trade -> POSIXTime
tTime
                (Trade -> POSIXTime)
-> (TradeExportData -> Trade) -> TradeExportData -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TradeExportData -> Trade
tedTrade

-- | Print some error text to 'stderr', then exit with a failure code.
exitWithErr :: T.Text -> IO a
exitWithErr :: Text -> IO a
exitWithErr = IO a -> () -> IO a
forall a b. a -> b -> a
const IO a
forall a. IO a
exitFailure (() -> IO a) -> (Text -> IO ()) -> Text -> IO a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr (Text -> IO ()) -> (Text -> Text) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"[ERROR] " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)


-- CONFIGURATION

data AppConfig = AppConfig
    { AppConfig -> BinanceConfig
binanceCfg :: BinanceConfig
    , AppConfig -> [Text]
symbols    :: [T.Text]
    , AppConfig -> Maybe Integer
year       :: Maybe Integer
    , AppConfig -> Maybe FilePath
outputFile :: Maybe FilePath
    }
    deriving (Int -> AppConfig -> ShowS
[AppConfig] -> ShowS
AppConfig -> FilePath
(Int -> AppConfig -> ShowS)
-> (AppConfig -> FilePath)
-> ([AppConfig] -> ShowS)
-> Show AppConfig
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AppConfig] -> ShowS
$cshowList :: [AppConfig] -> ShowS
show :: AppConfig -> FilePath
$cshow :: AppConfig -> FilePath
showsPrec :: Int -> AppConfig -> ShowS
$cshowsPrec :: Int -> AppConfig -> ShowS
Show, AppConfig -> AppConfig -> Bool
(AppConfig -> AppConfig -> Bool)
-> (AppConfig -> AppConfig -> Bool) -> Eq AppConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AppConfig -> AppConfig -> Bool
$c/= :: AppConfig -> AppConfig -> Bool
== :: AppConfig -> AppConfig -> Bool
$c== :: AppConfig -> AppConfig -> Bool
Eq)

-- | Given a parsed configuration file & CLI arguments, check for
-- environmental variables and either build an AppConfig or log an error
-- & exit if no API credentials or symbols have been passed.
mergeCfgEnvArgs :: ConfigFile -> Args -> IO AppConfig
mergeCfgEnvArgs :: ConfigFile -> Args -> IO AppConfig
mergeCfgEnvArgs ConfigFile {Maybe [Text]
Maybe Text
cfgSymbols :: ConfigFile -> Maybe [Text]
cfgApiSecret :: ConfigFile -> Maybe Text
cfgApiKey :: ConfigFile -> Maybe Text
cfgSymbols :: Maybe [Text]
cfgApiSecret :: Maybe Text
cfgApiKey :: Maybe Text
..} Args {[Text]
Maybe Integer
Maybe FilePath
Maybe Text
argOutputFile :: Args -> Maybe FilePath
argYear :: Args -> Maybe Integer
argSymbols :: Args -> [Text]
argApiSecret :: Args -> Maybe Text
argApiKey :: Args -> Maybe Text
argOutputFile :: Maybe FilePath
argYear :: Maybe Integer
argSymbols :: [Text]
argApiSecret :: Maybe Text
argApiKey :: Maybe Text
..} = do
    Maybe Text
envApiKey    <- (FilePath -> Text) -> Maybe FilePath -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
T.pack (Maybe FilePath -> Maybe Text)
-> IO (Maybe FilePath) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"BINANCE_API_KEY"
    Maybe Text
envApiSecret <- (FilePath -> Text) -> Maybe FilePath -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
T.pack (Maybe FilePath -> Maybe Text)
-> IO (Maybe FilePath) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"BINANCE_API_SECRET"
    Text
apiKey       <-
        Text -> Maybe Text -> IO Text
forall a. Text -> Maybe a -> IO a
requiredValue Text
"Pass a Binance API Key with `-k` or $BINANCE_API_KEY."
        (Maybe Text -> IO Text) -> Maybe Text -> IO Text
forall a b. (a -> b) -> a -> b
$   Maybe Text
argApiKey
        Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
envApiKey
        Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
cfgApiKey
    Text
apiSecret <-
        Text -> Maybe Text -> IO Text
forall a. Text -> Maybe a -> IO a
requiredValue
            Text
"Pass a Binance API Secret with `-s` or $BINANCE_API_SECRET."
        (Maybe Text -> IO Text) -> Maybe Text -> IO Text
forall a b. (a -> b) -> a -> b
$   Maybe Text
argApiSecret
        Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
envApiSecret
        Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
cfgApiSecret
    let binanceCfg :: BinanceConfig
binanceCfg =
            BinanceConfig :: Text -> Text -> BinanceConfig
BinanceConfig { bcApiKey :: Text
bcApiKey = Text
apiKey, bcApiSecret :: Text
bcApiSecret = Text
apiSecret }
    [Text]
symbols <- case ([Text]
argSymbols, [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Text]
cfgSymbols) of
        ([], []) -> Text -> IO [Text]
forall a. Text -> IO a
exitWithErr Text
"Pass at least one symbol."
        ([], [Text]
s ) -> [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
s
        ([Text]
s , [Text]
_ ) -> [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
s
    AppConfig -> IO AppConfig
forall (m :: * -> *) a. Monad m => a -> m a
return AppConfig :: BinanceConfig
-> [Text] -> Maybe Integer -> Maybe FilePath -> AppConfig
AppConfig { year :: Maybe Integer
year = Maybe Integer
argYear, outputFile :: Maybe FilePath
outputFile = Maybe FilePath
argOutputFile, [Text]
BinanceConfig
symbols :: [Text]
binanceCfg :: BinanceConfig
symbols :: [Text]
binanceCfg :: BinanceConfig
.. }
  where
    requiredValue :: T.Text -> Maybe a -> IO a
    requiredValue :: Text -> Maybe a -> IO a
requiredValue Text
errMsg = IO a -> (a -> IO a) -> Maybe a -> IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> IO a
forall a. Text -> IO a
exitWithErr Text
errMsg) a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return


-- CONFIG FILE

-- | Optional configuration data parsed from the config file.
data ConfigFile = ConfigFile
    { ConfigFile -> Maybe Text
cfgApiKey    :: Maybe T.Text
    , ConfigFile -> Maybe Text
cfgApiSecret :: Maybe T.Text
    , ConfigFile -> Maybe [Text]
cfgSymbols   :: Maybe [T.Text]
    }
    deriving (Int -> ConfigFile -> ShowS
[ConfigFile] -> ShowS
ConfigFile -> FilePath
(Int -> ConfigFile -> ShowS)
-> (ConfigFile -> FilePath)
-> ([ConfigFile] -> ShowS)
-> Show ConfigFile
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ConfigFile] -> ShowS
$cshowList :: [ConfigFile] -> ShowS
show :: ConfigFile -> FilePath
$cshow :: ConfigFile -> FilePath
showsPrec :: Int -> ConfigFile -> ShowS
$cshowsPrec :: Int -> ConfigFile -> ShowS
Show, ConfigFile -> ConfigFile -> Bool
(ConfigFile -> ConfigFile -> Bool)
-> (ConfigFile -> ConfigFile -> Bool) -> Eq ConfigFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigFile -> ConfigFile -> Bool
$c/= :: ConfigFile -> ConfigFile -> Bool
== :: ConfigFile -> ConfigFile -> Bool
$c== :: ConfigFile -> ConfigFile -> Bool
Eq)

instance FromJSON ConfigFile where
    parseJSON :: Value -> Parser ConfigFile
parseJSON = FilePath
-> (Object -> Parser ConfigFile) -> Value -> Parser ConfigFile
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"ConfigFile" ((Object -> Parser ConfigFile) -> Value -> Parser ConfigFile)
-> (Object -> Parser ConfigFile) -> Value -> Parser ConfigFile
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Maybe Text
cfgApiKey    <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"api-key"
        Maybe Text
cfgApiSecret <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"api-secret"
        Maybe [Text]
cfgSymbols   <- Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"symbols"
        ConfigFile -> Parser ConfigFile
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigFile :: Maybe Text -> Maybe Text -> Maybe [Text] -> ConfigFile
ConfigFile { Maybe [Text]
Maybe Text
cfgSymbols :: Maybe [Text]
cfgApiSecret :: Maybe Text
cfgApiKey :: Maybe Text
cfgSymbols :: Maybe [Text]
cfgApiSecret :: Maybe Text
cfgApiKey :: Maybe Text
.. }

-- | Attempt to read a 'ConfigFile' from
-- @$XDG_CONFIG_HOME/binance-exports/config.yaml@. Print any parsing errors
-- to 'stderr'.
loadConfigFile :: IO ConfigFile
loadConfigFile :: IO ConfigFile
loadConfigFile = do
    FilePath
configPath   <- FilePath -> FilePath -> IO FilePath
getUserConfigFile FilePath
"binance-exports" FilePath
"config.yaml"
    Bool
configExists <- FilePath -> IO Bool
doesFileExist FilePath
configPath
    if Bool
configExists
        then IO ConfigFile -> IO (Either ParseException ConfigFile)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try ([FilePath] -> [Value] -> EnvUsage -> IO ConfigFile
forall settings.
FromJSON settings =>
[FilePath] -> [Value] -> EnvUsage -> IO settings
loadYamlSettings [FilePath
configPath] [] EnvUsage
ignoreEnv) IO (Either ParseException ConfigFile)
-> (Either ParseException ConfigFile -> IO ConfigFile)
-> IO ConfigFile
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left (FilePath -> [FilePath]
lines (FilePath -> [FilePath])
-> (ParseException -> FilePath) -> ParseException -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> FilePath
prettyPrintParseException -> [FilePath]
errorMsgs) ->
                Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
"[WARN] Invalid Configuration Format:"
                    IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> ShowS -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"\t" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<>)) [FilePath]
errorMsgs
                    IO () -> IO ConfigFile -> IO ConfigFile
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConfigFile -> IO ConfigFile
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigFile
defaultConfig
            Right ConfigFile
cfg -> ConfigFile -> IO ConfigFile
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigFile
cfg
        else ConfigFile -> IO ConfigFile
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigFile
defaultConfig
  where
    defaultConfig :: ConfigFile
    defaultConfig :: ConfigFile
defaultConfig = Maybe Text -> Maybe Text -> Maybe [Text] -> ConfigFile
ConfigFile Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing


-- CLI ARGS

-- | CLI arguments supported by the executable.
data Args = Args
    { Args -> Maybe Text
argApiKey     :: Maybe T.Text
    , Args -> Maybe Text
argApiSecret  :: Maybe T.Text
    , Args -> [Text]
argSymbols    :: [T.Text]
    , Args -> Maybe Integer
argYear       :: Maybe Integer
    , Args -> Maybe FilePath
argOutputFile :: Maybe FilePath
    }
    deriving (Int -> Args -> ShowS
[Args] -> ShowS
Args -> FilePath
(Int -> Args -> ShowS)
-> (Args -> FilePath) -> ([Args] -> ShowS) -> Show Args
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Args] -> ShowS
$cshowList :: [Args] -> ShowS
show :: Args -> FilePath
$cshow :: Args -> FilePath
showsPrec :: Int -> Args -> ShowS
$cshowsPrec :: Int -> Args -> ShowS
Show, ReadPrec [Args]
ReadPrec Args
Int -> ReadS Args
ReadS [Args]
(Int -> ReadS Args)
-> ReadS [Args] -> ReadPrec Args -> ReadPrec [Args] -> Read Args
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Args]
$creadListPrec :: ReadPrec [Args]
readPrec :: ReadPrec Args
$creadPrec :: ReadPrec Args
readList :: ReadS [Args]
$creadList :: ReadS [Args]
readsPrec :: Int -> ReadS Args
$creadsPrec :: Int -> ReadS Args
Read, Args -> Args -> Bool
(Args -> Args -> Bool) -> (Args -> Args -> Bool) -> Eq Args
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Args -> Args -> Bool
$c/= :: Args -> Args -> Bool
== :: Args -> Args -> Bool
$c== :: Args -> Args -> Bool
Eq, Typeable Args
DataType
Constr
Typeable Args
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Args -> c Args)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Args)
-> (Args -> Constr)
-> (Args -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Args))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Args))
-> ((forall b. Data b => b -> b) -> Args -> Args)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Args -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Args -> r)
-> (forall u. (forall d. Data d => d -> u) -> Args -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Args -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Args -> m Args)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Args -> m Args)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Args -> m Args)
-> Data Args
Args -> DataType
Args -> Constr
(forall b. Data b => b -> b) -> Args -> Args
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Args -> c Args
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Args
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Args -> u
forall u. (forall d. Data d => d -> u) -> Args -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Args -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Args -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Args -> m Args
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Args -> m Args
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Args
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Args -> c Args
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Args)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Args)
$cArgs :: Constr
$tArgs :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Args -> m Args
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Args -> m Args
gmapMp :: (forall d. Data d => d -> m d) -> Args -> m Args
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Args -> m Args
gmapM :: (forall d. Data d => d -> m d) -> Args -> m Args
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Args -> m Args
gmapQi :: Int -> (forall d. Data d => d -> u) -> Args -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Args -> u
gmapQ :: (forall d. Data d => d -> u) -> Args -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Args -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Args -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Args -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Args -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Args -> r
gmapT :: (forall b. Data b => b -> b) -> Args -> Args
$cgmapT :: (forall b. Data b => b -> b) -> Args -> Args
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Args)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Args)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Args)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Args)
dataTypeOf :: Args -> DataType
$cdataTypeOf :: Args -> DataType
toConstr :: Args -> Constr
$ctoConstr :: Args -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Args
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Args
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Args -> c Args
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Args -> c Args
$cp1Data :: Typeable Args
Data, Typeable)


-- | Parse the CLI arguments with 'System.Console.CmdArgs'.
getArgs :: IO Args
getArgs :: IO Args
getArgs = Args -> IO Args
forall a. Data a => a -> IO a
cmdArgs Args
argSpec


-- | Defines & documents the CLI arguments.
argSpec :: Args
argSpec :: Args
argSpec =
    Args :: Maybe Text
-> Maybe Text -> [Text] -> Maybe Integer -> Maybe FilePath -> Args
Args
            { argApiKey :: Maybe Text
argApiKey     = Maybe Text
forall a. Default a => a
def
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
help FilePath
"Binance API Key"
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
name FilePath
"k"
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
name FilePath
"api-key"
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= Ann
explicit
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
typ FilePath
"KEY"
            , argApiSecret :: Maybe Text
argApiSecret  = Maybe Text
forall a. Default a => a
def
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
help FilePath
"Binance API Secret"
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
name FilePath
"s"
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
name FilePath
"api-secret"
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= Ann
explicit
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
typ FilePath
"SECRET"
            , argYear :: Maybe Integer
argYear       = Maybe Integer
forall a. Maybe a
Nothing
                              Maybe Integer -> Ann -> Maybe Integer
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
help FilePath
"Limit output to year"
                              Maybe Integer -> Ann -> Maybe Integer
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
name FilePath
"y"
                              Maybe Integer -> Ann -> Maybe Integer
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
name FilePath
"year"
                              Maybe Integer -> Ann -> Maybe Integer
forall val. Data val => val -> Ann -> val
&= Ann
explicit
                              Maybe Integer -> Ann -> Maybe Integer
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
typ FilePath
"YYYY"
            , argOutputFile :: Maybe FilePath
argOutputFile =
                Maybe FilePath
forall a. Maybe a
Nothing
                Maybe FilePath -> Ann -> Maybe FilePath
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
help FilePath
"File to write the export to. Default: stdout"
                Maybe FilePath -> Ann -> Maybe FilePath
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
name FilePath
"o"
                Maybe FilePath -> Ann -> Maybe FilePath
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
name FilePath
"output-file"
                Maybe FilePath -> Ann -> Maybe FilePath
forall val. Data val => val -> Ann -> val
&= Ann
explicit
                Maybe FilePath -> Ann -> Maybe FilePath
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
typ FilePath
"FILE"
            , argSymbols :: [Text]
argSymbols    = [Text]
forall a. Default a => a
def [Text] -> Ann -> [Text]
forall val. Data val => val -> Ann -> val
&= Ann
args [Text] -> Ann -> [Text]
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
typ FilePath
"SYMBOL [SYMBOL ...]"
            }
        Args -> Ann -> Args
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
summary
               (  FilePath
"binance-exports v"
               FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Version -> FilePath
showVersion Version
version
               FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
", Pavan Rikhi 2022"
               )
        Args -> Ann -> Args
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
program FilePath
"binance-exports"
        Args -> Ann -> Args
forall val. Data val => val -> Ann -> val
&= [Ann] -> Ann
helpArg [FilePath -> Ann
name FilePath
"h"]
        Args -> Ann -> Args
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
help FilePath
"Export Binance Trade History to a CSV"
        Args -> Ann -> Args
forall val. Data val => val -> Ann -> val
&= [FilePath] -> Ann
details [FilePath]
programDetails


programDetails :: [String]
programDetails :: [FilePath]
programDetails = FilePath -> [FilePath]
lines [r|
binance-exports generates a CSV export of your Binances Trade History. It
is intended to replace Binance's (removed) Trade History export.


DESCRIPTION

By default, we will pull every single trade you have made for the passed
symbols & print them out in reverse-chronological order with the following
fields:

   time,base-asset,quote-asset,type,price,quantity,total,fee,fee-currency,trade-id

This closely matches Binance's Trade History export, except we've split the
`symbol` column into `base-asset` & `quote-asset` columns and include the
`trade-id`.


OUTPUT FILE

You can use the `-o` flag to set the file we will write the CSV data into.
By default, the export is simply printed to stdout.

Warning: the export file will always be overwritten. We do not support
appending to an existing file.


ENVIRONMENTAL VARIABLES

Instead of passing in your API credentials via the `-k` & `-s` CLI flags,
you can set the `$BINANCE_API_KEY` & `$BINANCE_API_SECRET` environmental
variables.


CONFIGURATION FILE

You can also set some program options in a YAML file. We attempt to parse
a configuration file at `$XDG_CONFIG_HOME/binance-exports.yaml`. It
supports the following top-level keys:

    - `api-key`:        (string) Your Binance API key
    - `api-secret`:     (string) Your Binance API secret
    - `symbols`:        (list of strings) The trade symbols to fetch

Environmental variables will override any configuration options, and CLI
flags will override both environmental variables & configuration file
options.


USAGE EXAMPLES

Fetch all my BNB trades:
    binance-exports BNBUSD

Fetch my BTC trades from 2020:
    binance-exports -y 2020 BTCUSD

Fetch my BNB & BTC trades from 2022, write them to a file:
    binance-exports -y 2022 -o 2022-binance-trades.csv BNBUSD BTCUSD
|]