diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# CHANGELOG + +## v0.1.0.0 + +* Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,70 @@ +# binance-exports + +[![binance-exports Build Status](https://github.com/prikhi/binance-exports/actions/workflows/main.yml/badge.svg)](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 -s 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 -s 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 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,7 @@ +module Main where + +import Console.Binance.Exports.Main + + +main :: IO () +main = getArgs >>= run diff --git a/binance-exports.cabal b/binance-exports.cabal new file mode 100644 --- /dev/null +++ b/binance-exports.cabal @@ -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 \ -s \ 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 diff --git a/src/Console/Binance/Exports/Csv.hs b/src/Console/Binance/Exports/Csv.hs new file mode 100644 --- /dev/null +++ b/src/Console/Binance/Exports/Csv.hs @@ -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 }) diff --git a/src/Console/Binance/Exports/Main.hs b/src/Console/Binance/Exports/Main.hs new file mode 100644 --- /dev/null +++ b/src/Console/Binance/Exports/Main.hs @@ -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" diff --git a/src/Web/Binance.hs b/src/Web/Binance.hs new file mode 100644 --- /dev/null +++ b/src/Web/Binance.hs @@ -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" diff --git a/tests/Spec.hs b/tests/Spec.hs new file mode 100644 --- /dev/null +++ b/tests/Spec.hs @@ -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)