binance-exports (empty) → 0.1.0.0
raw patch · 10 files changed
+850/−0 lines, 10 filesdep +aesondep +basedep +binance-exportssetup-changed
Dependencies added: aeson, base, binance-exports, bytedump, bytestring, cassava, cmdargs, cryptohash-sha256, hedgehog, http-client, http-types, mtl, req, safe-exceptions, scientific, tasty, tasty-hedgehog, tasty-hunit, text, time
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- README.md +70/−0
- Setup.hs +2/−0
- app/Main.hs +7/−0
- binance-exports.cabal +132/−0
- src/Console/Binance/Exports/Csv.hs +85/−0
- src/Console/Binance/Exports/Main.hs +156/−0
- src/Web/Binance.hs +329/−0
- tests/Spec.hs +34/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# CHANGELOG++## v0.1.0.0++* Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Pavan Rikhi (c) 2022++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Pavan Rikhi nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,70 @@+# binance-exports++[](https://github.com/prikhi/binance-exports/actions/workflows/main.yml)+++Export Your Binance Trade History to a CSV.++Sometime during February 2022, Binance removed their `Trade History` page,+along with the ability to export your completed trades. The `Order History`+export is still available, but the format is more difficult to parse. This+command is a replacement for the `Trade History` export, generating CSVs with+an almost-identical format. There are two differences: we split the trade+symbol into two separate asset columns & include the trade ID.++Requires [`stack`][get-stack] & a Binance.us API key & secret:++```sh+stack run -- -k <API_KEY> -s <API_SECRET> <SYMBOL1> <SYMBOL2> etc+stack run -- --help+```++TODO:++* Switch between Binance & Binance US APIs+* Config file & env var overrides for CLI args+* Release v1, add package to hackage & stackage+++[get-stack]: https://docs.haskellstack.org/en/stable/README/+++## Install++You can install the CLI exe by running `stack install`. This lets you call the+executable directly instead of through stack:++```sh+$ stack install+$ export PATH="${HOME}/.local/bin/:${PATH}"+$ binance-exports -k <API_KEY> -s <API_SECRET> SOLUSD+time,base-asset,quote-asset,type,price,quantity,total,fee,fee-currency,trade-id+2022-03-01 21:20:44,SOL,USD,BUY,42.2424,0.42,42.90010000,0.0009001,BNB,9001+```+++## Build++You can build the project with stack:++```sh+stack build+```++For development, you can enable fast builds with file-watching,+documentation-building, & test-running:++```sh+stack test --haddock --fast --file-watch --pedantic+```++To build & open the documentation, run:++```sh+stack haddock --open binance-exports+```+++## LICENSE++BSD-3
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,7 @@+module Main where++import Console.Binance.Exports.Main+++main :: IO ()+main = getArgs >>= run
+ binance-exports.cabal view
@@ -0,0 +1,132 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name: binance-exports+version: 0.1.0.0+synopsis: Generate CSV Exports o your Binance Trade History.+description: @binance-exports@ is a CLI program that queries the Binance.us API for your+ Trade History & exports all trades to a CSV file.+ .+ Sometime during February 2022, Binance removed their @Trade History@ page,+ along with the ability to export your completed trades. The @Order History@+ export is still available, but the format is more difficult to parse.+ .+ This package contains a replacement executable for the @Trade History@+ export, generating CSVs with an almost-identical format. There are two+ differences: we split the trade symbol into two separate asset columns &+ include the trade ID.+ .+ You can install @binance-exports@ with Stack: @stack install --resolver+ nightly binance-exports@. Then run the following to print out your trades+ for a given symbol:+ .+ @+ $ binance-exports -k \<API_KEY\> -s \<API_SECRET\> SOLUSD+ time,base-asset,quote-asset,type,price,quantity,total,fee,fee-currency,trade-id+ 2022-03-01 21:20:44,SOL,USD,BUY,42.2424,0.42,42.90010000,0.0009001,BNB,9001+ @+ .+ See @binance-exports --help@ for additional options.+category: Web+homepage: https://github.com/prikhi/binance-exports#readme+bug-reports: https://github.com/prikhi/binance-exports/issues+author: Pavan Rikhi+maintainer: pavan.rikhi@gmail.com+copyright: 2022 Pavan Rikhi+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/prikhi/binance-exports++library+ exposed-modules:+ Console.Binance.Exports.Csv+ Console.Binance.Exports.Main+ Web.Binance+ other-modules:+ Paths_binance_exports+ hs-source-dirs:+ src+ default-extensions:+ DeriveGeneric+ LambdaCase+ NamedFieldPuns+ OverloadedStrings+ TupleSections+ TypeApplications+ TypeOperators+ ViewPatterns+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -O2+ build-depends:+ aeson <3+ , base >=4.7 && <5+ , bytedump <2+ , bytestring <1+ , cassava <1+ , cmdargs >=0.10 && <1+ , cryptohash-sha256 <1+ , http-client <1+ , http-types <1+ , mtl <3+ , req <4+ , safe-exceptions <1+ , scientific <1+ , text <2+ , time <2+ default-language: Haskell2010++executable binance-exports+ main-is: Main.hs+ other-modules:+ Paths_binance_exports+ hs-source-dirs:+ app+ default-extensions:+ DeriveGeneric+ LambdaCase+ NamedFieldPuns+ OverloadedStrings+ TupleSections+ TypeApplications+ TypeOperators+ ViewPatterns+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -O2 -threaded -rtsopts -with-rtsopts "-N -T"+ build-depends:+ base >=4.7 && <5+ , binance-exports+ default-language: Haskell2010++test-suite binance-exports-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_binance_exports+ hs-source-dirs:+ tests+ default-extensions:+ DeriveGeneric+ LambdaCase+ NamedFieldPuns+ OverloadedStrings+ TupleSections+ TypeApplications+ TypeOperators+ ViewPatterns+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -O2 -threaded -rtsopts -with-rtsopts "-N -T"+ build-depends:+ base >=4.7 && <5+ , binance-exports+ , hedgehog+ , tasty+ , tasty-hedgehog+ , tasty-hunit+ default-language: Haskell2010
+ src/Console/Binance/Exports/Csv.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE RecordWildCards #-}+{- | Types & CSV serialization for the exports.+-}+module Console.Binance.Exports.Csv+ ( TradeExportData(..)+ , buildTradeExport+ ) where+import Data.Csv ( (.=)+ , DefaultOrdered(..)+ , ToNamedRecord(..)+ , defaultEncodeOptions+ , encUseCrLf+ , encodeDefaultOrderedByNameWith+ , header+ , namedRecord+ )+import Data.Scientific ( FPFormat(..)+ , Scientific+ , formatScientific+ , isInteger+ )+import Data.Time ( defaultTimeLocale+ , formatTime+ )+import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )++import qualified Data.ByteString.Lazy as LBS+import Web.Binance ( SymbolDetails(..)+ , Trade(..)+ )+++-- | We need both the 'SymbolDetails' & the 'Trade' to generate an export+-- line.+data TradeExportData = TradeExportData+ { tedSymbol :: SymbolDetails+ , tedTrade :: Trade+ }+ deriving (Show, Read, Eq, Ord)++-- | We match the format of the old @Trade History@ export as much as+-- possible, but use the asset precisions for the @price@ & @quantity@+-- fields & output the @trade-id@ as well.+instance ToNamedRecord TradeExportData where+ toNamedRecord (TradeExportData SymbolDetails {..} Trade {..}) = namedRecord+ [ "time" .= formatTime defaultTimeLocale+ "%F %T"+ (posixSecondsToUTCTime tTime)+ , "base-asset" .= sdBaseAsset+ , "quote-asset" .= sdQuoteAsset+ , "type" .= if tIsBuyer then "BUY" else ("SELL" :: String)+ , "price" .= formatScientific Fixed (Just sdQuoteAssetPrecision) tPrice+ , "quantity"+ .= formatScientific Fixed (Just sdBaseAssetPrecision) tQuantity+ , "total" .= renderScientific (tPrice * tQuantity)+ , "fee" .= renderScientific tCommission+ , "fee-currency" .= tCommissionAsset+ , "trade-id" .= tId+ ]+ where+ -- | Render as an integer if possible, otherwise render to the+ -- minimum decimal precision needed.+ renderScientific :: Scientific -> String+ renderScientific p = if isInteger p+ then formatScientific Fixed (Just 0) p+ else formatScientific Fixed Nothing p++instance DefaultOrdered TradeExportData where+ headerOrder _ = header+ [ "time"+ , "base-asset"+ , "quote-asset"+ , "type"+ , "price"+ , "quantity"+ , "total"+ , "fee"+ , "fee-currency"+ , "trade-id"+ ]++-- | Generate a CSV from the trade data.+buildTradeExport :: [TradeExportData] -> LBS.ByteString+buildTradeExport =+ encodeDefaultOrderedByNameWith (defaultEncodeOptions { encUseCrLf = False })
+ src/Console/Binance/Exports/Main.hs view
@@ -0,0 +1,156 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RecordWildCards #-}+{- | CLI application harness.+-}+module Console.Binance.Exports.Main+ ( run+ , getArgs+ , Args(..)+ ) where++import Control.Monad.IO.Class ( liftIO )+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 System.Console.CmdArgs ( (&=)+ , Data+ , Typeable+ , args+ , cmdArgs+ , def+ , explicit+ , help+ , helpArg+ , name+ , program+ , summary+ , typ+ )+import System.Exit ( exitFailure )+import System.IO ( stderr )++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 :: Args -> IO ()+run Args {..} = do+ results <- runApi cfg $ do+ symbolDetails <-+ fmap eiSymbols+ $ getExchangeInfo (map T.pack symbols)+ >>= handleBinanceError+ rawExportData <- concat <$> mapM getTradesForSymbol symbolDetails+ return . filterYear $ sortOn (Down . tTime . tedTrade) rawExportData+ -- Write CSV to file or stdout+ let outputFileOrStdout = fromMaybe "-" outputFile+ let output = buildTradeExport results+ if outputFileOrStdout == "-"+ then LBS.putStr output+ else LBS.writeFile outputFileOrStdout output+ where+ -- | Build a config for the Binance API requests from the CLI+ -- arguments.+ cfg :: BinanceConfig+ cfg = BinanceConfig { bcApiKey = T.pack apiKey+ , bcApiSecret = T.pack apiSecret+ }+ -- | 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 = \case+ Left e -> liftIO $ do+ T.hPutStrLn stderr+ $ "[ERROR] Binance API Error Code "+ <> T.pack (show $ beCode e)+ <> ": "+ <> beMsg e+ exitFailure+ Right r -> return r+ -- | Get all trades for the given symbol & convert them into the export+ -- format.+ getTradesForSymbol :: SymbolDetails -> BinanceApiM [TradeExportData]+ getTradesForSymbol s =+ map (TradeExportData s) <$> getTradeHistory (sdSymbol s) Nothing Nothing+ -- | Filter the trades if a 'year' argument has been passed.+ filterYear :: [TradeExportData] -> [TradeExportData]+ filterYear = case year of+ Nothing -> id+ Just y ->+ filter+ $ (\(y_, _, _) -> y == y_)+ . toGregorian+ . utctDay+ . posixSecondsToUTCTime+ . tTime+ . tedTrade+++-- CLI ARGS++-- | CLI arguments supported by the executable.+data Args = Args+ { apiKey :: String+ , apiSecret :: String+ , symbols :: [String]+ , year :: Maybe Integer+ , outputFile :: Maybe FilePath+ }+ deriving (Show, Read, Eq, Data, Typeable)+++-- | Parse the CLI arguments with 'System.Console.CmdArgs'.+getArgs :: IO Args+getArgs = cmdArgs argSpec+++-- | Defines & documents the CLI arguments.+argSpec :: Args+argSpec =+ Args+ { apiKey = def+ &= explicit+ &= name "k"+ &= name "api-key"+ &= help "Binance API Key"+ &= typ "KEY"+ , apiSecret = def+ &= explicit+ &= name "s"+ &= name "api-secret"+ &= help "Binance API Secret"+ &= typ "SECRET"+ , year = Nothing+ &= explicit+ &= name "y"+ &= name "year"+ &= help "Limit output to year"+ &= typ "YYYY"+ , outputFile =+ Nothing+ &= explicit+ &= name "o"+ &= name "output-file"+ &= help "File to write the export to. Default: stdout"+ &= typ "FILE"+ , symbols = def &= args &= typ "SYMBOL [SYMBOL ...]"+ }+ &= summary+ ( "binance-exports v"+ <> showVersion version+ <> ", Pavan Rikhi 2022"+ )+ &= program "binance-exports"+ &= helpArg [name "h"]+ &= help "Export Binance Trade History to a CSV"
+ src/Web/Binance.hs view
@@ -0,0 +1,329 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-| Request functions & response types for the Binance.US API+-}+module Web.Binance+ (+ -- * API+ BinanceApiM+ , runApi+ , BinanceConfig(..)+ , BinanceError(..)+ -- * Requests+ -- ** Exchange Info+ , getExchangeInfo+ , ExchangeInfo(..)+ , SymbolDetails(..)+ -- ** Trade History+ , getTradeHistory+ , Trade(..)+ -- * Helpers+ , runSignedRequest+ , mkSignature+ ) where++import Control.Exception.Safe ( MonadCatch+ , MonadThrow+ , throw+ , try+ )+import Control.Monad.Reader ( (<=<)+ , MonadIO+ , MonadReader+ , ReaderT+ , ask+ , lift+ , liftIO+ , runReaderT+ )+import Crypto.Hash.SHA256 ( hmac )+import Data.Aeson ( (.:)+ , FromJSON(..)+ , eitherDecodeStrict'+ , withObject+ )+import Data.Function ( on )+import Data.List ( minimumBy )+import Data.Proxy ( Proxy )+import Data.Scientific ( Scientific )+import Data.Text.Encoding ( encodeUtf8 )+import Data.Time ( UTCTime+ , getCurrentTime+ )+import Data.Time.Clock.POSIX ( POSIXTime+ , posixSecondsToUTCTime+ )+import Data.Time.Format ( defaultTimeLocale+ , formatTime+ )+import Network.HTTP.Client ( HttpException(..)+ , HttpExceptionContent(..)+ , RequestBody(..)+ , queryString+ , requestBody+ , responseStatus+ )+import Network.HTTP.Req as Req+ ( (/:)+ , (=:)+ , AllowsBody+ , GET(..)+ , HttpBody+ , HttpBodyAllowed+ , HttpException(..)+ , HttpMethod+ , HttpResponse+ , JsonResponse+ , MonadHttp(..)+ , NoReqBody(..)+ , Option+ , ProvidesBody+ , Req+ , Url+ , defaultHttpConfig+ , header+ , https+ , jsonResponse+ , req+ , reqCb+ , responseBody+ , runReq+ )+import Network.HTTP.Types ( statusCode )+import Text.Bytedump ( hexString )++import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Text as T+++-- | Necessary configuration data for making requests to the Binance API.+data BinanceConfig = BinanceConfig+ { bcApiKey :: T.Text+ -- ^ Your API Key+ , bcApiSecret :: T.Text+ -- ^ Your API Key's Secret+ }+ deriving (Show, Read, Eq, Ord)++-- | The monad in which Binance API requests are run.+newtype BinanceApiM a = BinanceApiM+ { runBinanceApiM :: ReaderT BinanceConfig Req a+ } deriving (Functor, Applicative, Monad, MonadIO, MonadReader BinanceConfig, MonadThrow, MonadCatch)++-- | Run a series of API requests with the given Config.+runApi :: BinanceConfig -> BinanceApiM a -> IO a+runApi cfg = runReq defaultHttpConfig . flip runReaderT cfg . runBinanceApiM++-- | Use 'MonadHttp' from the 'Req' instance.+instance MonadHttp BinanceApiM where+ handleHttpException = BinanceApiM . lift . handleHttpException++-- | Error responses from the API.+data BinanceError = BinanceError+ { beCode :: Int+ , beMsg :: T.Text+ }+ deriving (Show, Read, Eq, Ord)++instance FromJSON BinanceError where+ parseJSON = withObject "BinanceError"+ $ \o -> BinanceError <$> o .: "code" <*> o .: "msg"++-- | Decode a 'BinanceError' from a 400-error response, re-throwing all+-- other exception types.+catchErrorResponse+ :: (MonadThrow m, FromJSON a)+ => Either Req.HttpException (JsonResponse a)+ -> m (Either BinanceError a)+catchErrorResponse = \case+ Right r -> return . Right $ responseBody r+ Left e@(VanillaHttpException (HttpExceptionRequest _ (StatusCodeException (statusCode . responseStatus -> 400) errBody)))+ -> either (const $ throw e) (return . Left)+ $ eitherDecodeStrict' errBody+ Left e -> throw e+++-- EXCHANGE INFO++-- | Get Exchange Information for the Given Symbol. Right now, just returns+-- the requested symbol information.+--+-- Returns Left if a passed symbol is invalid.+getExchangeInfo+ :: (MonadHttp m, MonadCatch m)+ => [T.Text]+ -> m (Either BinanceError ExchangeInfo)+getExchangeInfo symbols = do+ let symbolsParam =+ mconcat+ [ "["+ , T.intercalate "," (map (\s -> "\"" <> s <> "\"") symbols)+ , "]"+ ]+ catchErrorResponse <=< try $ req+ GET+ (https "api.binance.us" /: "api" /: "v3" /: "exchangeInfo")+ NoReqBody+ jsonResponse+ ("symbols" =: symbolsParam)++-- | General information about the exchange. Currently we only parse out+-- the details of requested symbols.+newtype ExchangeInfo = ExchangeInfo+ { eiSymbols :: [SymbolDetails]+ } deriving (Show, Read, Eq, Ord)++instance FromJSON ExchangeInfo where+ parseJSON =+ withObject "ExchangeInfo" $ \o -> ExchangeInfo <$> o .: "symbols"++-- | The asset pairs for a trade symbol, along with Binance's precisions+-- for each asset.+data SymbolDetails = SymbolDetails+ { sdSymbol :: T.Text+ , sdBaseAsset :: T.Text+ , sdBaseAssetPrecision :: Int+ , sdQuoteAsset :: T.Text+ , sdQuoteAssetPrecision :: Int+ }+ deriving (Show, Read, Eq, Ord)++instance FromJSON SymbolDetails where+ parseJSON = withObject "SymbolDetails" $ \o -> do+ sdSymbol <- o .: "symbol"+ sdBaseAsset <- o .: "baseAsset"+ sdBaseAssetPrecision <- o .: "baseAssetPrecision"+ sdQuoteAsset <- o .: "quoteAsset"+ sdQuoteAssetPrecision <- o .: "quoteAssetPrecision"+ return SymbolDetails { .. }+++-- TRADE HISTORY++-- | Get Trade History for the Given Symbol.+getTradeHistory+ :: (MonadHttp m, MonadReader BinanceConfig m)+ => T.Text+ -- ^ Full symbol/pair of trades to fetch, e.g. @BNBUSD@.+ -> Maybe UTCTime+ -- ^ Start of time range+ -> Maybe UTCTime+ -- ^ End of time range+ -> m [Trade]+getTradeHistory symbol mbStart mbEnd = do+ cfg <- ask+ timestamp <- utcToMs <$> liftIO getCurrentTime+ let limit = (1000 :: Int)+ resp <- runSignedRequest+ GET+ (https "api.binance.us" /: "api" /: "v3" /: "myTrades")+ NoReqBody+ jsonResponse+ (mconcat+ [ "symbol" =: symbol+ , "timestamp" =: timestamp+ , "limit" =: limit+ , maybe mempty (("startTime" =:) . utcToMs) mbStart+ , maybe mempty (("endTime" =:) . utcToMs) mbEnd+ , header "X-MBX-APIKEY" (encodeUtf8 $ bcApiKey cfg)+ ]+ )+ let results = responseBody resp+ if length results /= limit+ then return results+ else do+ let minTime = minimumBy (compare `on` tTime) results+ (results <>) <$> getTradeHistory+ symbol+ mbStart+ (Just . posixSecondsToUTCTime $ tTime minTime)++-- | A single trade made on Binance.+data Trade = Trade+ { tSymbol :: T.Text+ -- ^ Full symbol of the trade - base asset & quote asset+ , tId :: Integer+ -- ^ Trade's ID number+ , tOrderId :: Integer+ -- ^ Order ID number from which the Trade was made+ , tPrice :: Scientific+ , tQuantity :: Scientific+ , tQuoteQuantity :: Scientific+ -- ^ The total amount spent/received during the trade. Note that we do+ -- not use this value in our exports, as Binance truncates it & loses+ -- a fraction of the amount. You probably want to do @'tQuantity'+ -- * 'tPrice'@ instead.+ , tCommission :: Scientific+ , tCommissionAsset :: T.Text+ , tTime :: POSIXTime+ , tIsBuyer :: Bool+ , tIsMaker :: Bool+ , tIsBestMatch :: Bool+ }+ deriving (Show, Read, Eq, Ord)++instance FromJSON Trade where+ parseJSON = withObject "Trade" $ \o -> do+ tSymbol <- o .: "symbol"+ tId <- o .: "id"+ tOrderId <- o .: "orderId"+ tPrice <- read <$> o .: "price"+ tQuantity <- read <$> o .: "qty"+ tQuoteQuantity <- read <$> o .: "quoteQty"+ tCommission <- read <$> o .: "commission"+ tCommissionAsset <- o .: "commissionAsset"+ -- Binance API returns milliseconds, POSIXTime is seconds+ tTime <- (/ 1000.0) <$> o .: "time"+ tIsBuyer <- o .: "isBuyer"+ tIsMaker <- o .: "isMaker"+ tIsBestMatch <- o .: "isBestMatch"+ return Trade { .. }+++-- UTILS++-- | Run a request for a SIGNED endpoint by inserting the signature before+-- making the request.+runSignedRequest+ :: ( MonadHttp m+ , HttpMethod method+ , HttpBody body+ , HttpResponse response+ , HttpBodyAllowed (AllowsBody method) (ProvidesBody body)+ , MonadReader BinanceConfig m+ )+ => method+ -> Url scheme+ -> body+ -> Proxy response+ -> Option scheme+ -> m response+runSignedRequest m u b p s = do+ cfg <- ask+ reqCb m u b p s $ \req_ -> do+ let qs = BS.drop 1 $ queryString req_+ body = getBodyBS $ requestBody req_+ sig = mkSignature cfg qs body+ qs_ = if BS.length qs == 0+ then "?signature=" <> sig+ else qs <> "&signature=" <> sig+ return $ req_ { queryString = qs_ }+ where+ getBodyBS = \case+ RequestBodyLBS lbs -> LBS.toStrict lbs+ RequestBodyBS bs -> bs+ _ -> ""++-- | Generate a HMAC SHA256 signature for a SIGNED api request.+mkSignature :: BinanceConfig -> BS.ByteString -> BS.ByteString -> BS.ByteString+mkSignature cfg queryParams reqBody =+ let totalParams = queryParams <> reqBody+ key = encodeUtf8 $ bcApiSecret cfg+ in BC.pack . concatMap hexString . BS.unpack $ hmac key totalParams++-- | Convert UTC into posix milliseconds for the Binance API.+utcToMs :: UTCTime -> String+utcToMs = formatTime defaultTimeLocale "%s000"
+ tests/Spec.hs view
@@ -0,0 +1,34 @@+import Hedgehog+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.Hedgehog++import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+++main :: IO ()+main = defaultMain tests+++tests :: TestTree+tests = testGroup "Tests" [unitTests, properties]+++unitTests :: TestTree+unitTests = testGroup "Unit Tests" [testCase "2+2 = 4" testAddition]+ where+ testAddition :: Assertion+ testAddition = (2 + 2) @?= (4 :: Integer)+++properties :: TestTree+properties = testGroup+ "Properties"+ [testProperty "Addition is Communative" testAdditionCommunative]+ where+ testAdditionCommunative :: Property+ testAdditionCommunative = property $ do+ let genInt = Gen.int $ Range.linear 0 9001+ (a, b) <- forAll $ (,) <$> genInt <*> genInt+ (a + b) === (b + a)