{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Web.Binance
(
BinanceApiM
, runApi
, BinanceConfig(..)
, BinanceError(..)
, getExchangeInfo
, ExchangeInfo(..)
, SymbolDetails(..)
, getTradeHistory
, Trade(..)
, runSignedRequest
, mkSignature
) where
import Control.Exception.Safe ( MonadCatch
, MonadThrow
, throw
, try
)
import Control.Monad ( (<=<) )
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
data BinanceConfig = BinanceConfig
{ BinanceConfig -> Text
bcApiKey :: T.Text
, BinanceConfig -> Text
bcApiSecret :: T.Text
}
deriving (Int -> BinanceConfig -> ShowS
[BinanceConfig] -> ShowS
BinanceConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinanceConfig] -> ShowS
$cshowList :: [BinanceConfig] -> ShowS
show :: BinanceConfig -> String
$cshow :: BinanceConfig -> String
showsPrec :: Int -> BinanceConfig -> ShowS
$cshowsPrec :: Int -> BinanceConfig -> ShowS
Show, ReadPrec [BinanceConfig]
ReadPrec BinanceConfig
Int -> ReadS BinanceConfig
ReadS [BinanceConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BinanceConfig]
$creadListPrec :: ReadPrec [BinanceConfig]
readPrec :: ReadPrec BinanceConfig
$creadPrec :: ReadPrec BinanceConfig
readList :: ReadS [BinanceConfig]
$creadList :: ReadS [BinanceConfig]
readsPrec :: Int -> ReadS BinanceConfig
$creadsPrec :: Int -> ReadS BinanceConfig
Read, BinanceConfig -> BinanceConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinanceConfig -> BinanceConfig -> Bool
$c/= :: BinanceConfig -> BinanceConfig -> Bool
== :: BinanceConfig -> BinanceConfig -> Bool
$c== :: BinanceConfig -> BinanceConfig -> Bool
Eq, Eq BinanceConfig
BinanceConfig -> BinanceConfig -> Bool
BinanceConfig -> BinanceConfig -> Ordering
BinanceConfig -> BinanceConfig -> BinanceConfig
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BinanceConfig -> BinanceConfig -> BinanceConfig
$cmin :: BinanceConfig -> BinanceConfig -> BinanceConfig
max :: BinanceConfig -> BinanceConfig -> BinanceConfig
$cmax :: BinanceConfig -> BinanceConfig -> BinanceConfig
>= :: BinanceConfig -> BinanceConfig -> Bool
$c>= :: BinanceConfig -> BinanceConfig -> Bool
> :: BinanceConfig -> BinanceConfig -> Bool
$c> :: BinanceConfig -> BinanceConfig -> Bool
<= :: BinanceConfig -> BinanceConfig -> Bool
$c<= :: BinanceConfig -> BinanceConfig -> Bool
< :: BinanceConfig -> BinanceConfig -> Bool
$c< :: BinanceConfig -> BinanceConfig -> Bool
compare :: BinanceConfig -> BinanceConfig -> Ordering
$ccompare :: BinanceConfig -> BinanceConfig -> Ordering
Ord)
newtype BinanceApiM a = BinanceApiM
{ forall a. BinanceApiM a -> ReaderT BinanceConfig Req a
runBinanceApiM :: ReaderT BinanceConfig Req a
} deriving (forall a b. a -> BinanceApiM b -> BinanceApiM a
forall a b. (a -> b) -> BinanceApiM a -> BinanceApiM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> BinanceApiM b -> BinanceApiM a
$c<$ :: forall a b. a -> BinanceApiM b -> BinanceApiM a
fmap :: forall a b. (a -> b) -> BinanceApiM a -> BinanceApiM b
$cfmap :: forall a b. (a -> b) -> BinanceApiM a -> BinanceApiM b
Functor, Functor BinanceApiM
forall a. a -> BinanceApiM a
forall a b. BinanceApiM a -> BinanceApiM b -> BinanceApiM a
forall a b. BinanceApiM a -> BinanceApiM b -> BinanceApiM b
forall a b. BinanceApiM (a -> b) -> BinanceApiM a -> BinanceApiM b
forall a b c.
(a -> b -> c) -> BinanceApiM a -> BinanceApiM b -> BinanceApiM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. BinanceApiM a -> BinanceApiM b -> BinanceApiM a
$c<* :: forall a b. BinanceApiM a -> BinanceApiM b -> BinanceApiM a
*> :: forall a b. BinanceApiM a -> BinanceApiM b -> BinanceApiM b
$c*> :: forall a b. BinanceApiM a -> BinanceApiM b -> BinanceApiM b
liftA2 :: forall a b c.
(a -> b -> c) -> BinanceApiM a -> BinanceApiM b -> BinanceApiM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> BinanceApiM a -> BinanceApiM b -> BinanceApiM c
<*> :: forall a b. BinanceApiM (a -> b) -> BinanceApiM a -> BinanceApiM b
$c<*> :: forall a b. BinanceApiM (a -> b) -> BinanceApiM a -> BinanceApiM b
pure :: forall a. a -> BinanceApiM a
$cpure :: forall a. a -> BinanceApiM a
Applicative, Applicative BinanceApiM
forall a. a -> BinanceApiM a
forall a b. BinanceApiM a -> BinanceApiM b -> BinanceApiM b
forall a b. BinanceApiM a -> (a -> BinanceApiM b) -> BinanceApiM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> BinanceApiM a
$creturn :: forall a. a -> BinanceApiM a
>> :: forall a b. BinanceApiM a -> BinanceApiM b -> BinanceApiM b
$c>> :: forall a b. BinanceApiM a -> BinanceApiM b -> BinanceApiM b
>>= :: forall a b. BinanceApiM a -> (a -> BinanceApiM b) -> BinanceApiM b
$c>>= :: forall a b. BinanceApiM a -> (a -> BinanceApiM b) -> BinanceApiM b
Monad, Monad BinanceApiM
forall a. IO a -> BinanceApiM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> BinanceApiM a
$cliftIO :: forall a. IO a -> BinanceApiM a
MonadIO, MonadReader BinanceConfig, Monad BinanceApiM
forall e a. Exception e => e -> BinanceApiM a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> BinanceApiM a
$cthrowM :: forall e a. Exception e => e -> BinanceApiM a
MonadThrow, MonadThrow BinanceApiM
forall e a.
Exception e =>
BinanceApiM a -> (e -> BinanceApiM a) -> BinanceApiM a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a.
Exception e =>
BinanceApiM a -> (e -> BinanceApiM a) -> BinanceApiM a
$ccatch :: forall e a.
Exception e =>
BinanceApiM a -> (e -> BinanceApiM a) -> BinanceApiM a
MonadCatch)
runApi :: BinanceConfig -> BinanceApiM a -> IO a
runApi :: forall a. BinanceConfig -> BinanceApiM a -> IO a
runApi BinanceConfig
cfg = forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
defaultHttpConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT BinanceConfig
cfg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BinanceApiM a -> ReaderT BinanceConfig Req a
runBinanceApiM
instance MonadHttp BinanceApiM where
handleHttpException :: forall a. HttpException -> BinanceApiM a
handleHttpException = forall a. ReaderT BinanceConfig Req a -> BinanceApiM a
BinanceApiM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
data BinanceError = BinanceError
{ BinanceError -> Int
beCode :: Int
, BinanceError -> Text
beMsg :: T.Text
}
deriving (Int -> BinanceError -> ShowS
[BinanceError] -> ShowS
BinanceError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinanceError] -> ShowS
$cshowList :: [BinanceError] -> ShowS
show :: BinanceError -> String
$cshow :: BinanceError -> String
showsPrec :: Int -> BinanceError -> ShowS
$cshowsPrec :: Int -> BinanceError -> ShowS
Show, ReadPrec [BinanceError]
ReadPrec BinanceError
Int -> ReadS BinanceError
ReadS [BinanceError]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BinanceError]
$creadListPrec :: ReadPrec [BinanceError]
readPrec :: ReadPrec BinanceError
$creadPrec :: ReadPrec BinanceError
readList :: ReadS [BinanceError]
$creadList :: ReadS [BinanceError]
readsPrec :: Int -> ReadS BinanceError
$creadsPrec :: Int -> ReadS BinanceError
Read, BinanceError -> BinanceError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinanceError -> BinanceError -> Bool
$c/= :: BinanceError -> BinanceError -> Bool
== :: BinanceError -> BinanceError -> Bool
$c== :: BinanceError -> BinanceError -> Bool
Eq, Eq BinanceError
BinanceError -> BinanceError -> Bool
BinanceError -> BinanceError -> Ordering
BinanceError -> BinanceError -> BinanceError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BinanceError -> BinanceError -> BinanceError
$cmin :: BinanceError -> BinanceError -> BinanceError
max :: BinanceError -> BinanceError -> BinanceError
$cmax :: BinanceError -> BinanceError -> BinanceError
>= :: BinanceError -> BinanceError -> Bool
$c>= :: BinanceError -> BinanceError -> Bool
> :: BinanceError -> BinanceError -> Bool
$c> :: BinanceError -> BinanceError -> Bool
<= :: BinanceError -> BinanceError -> Bool
$c<= :: BinanceError -> BinanceError -> Bool
< :: BinanceError -> BinanceError -> Bool
$c< :: BinanceError -> BinanceError -> Bool
compare :: BinanceError -> BinanceError -> Ordering
$ccompare :: BinanceError -> BinanceError -> Ordering
Ord)
instance FromJSON BinanceError where
parseJSON :: Value -> Parser BinanceError
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BinanceError"
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> Text -> BinanceError
BinanceError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"msg"
catchErrorResponse
:: (MonadThrow m, FromJSON a)
=> Either Req.HttpException (JsonResponse a)
-> m (Either BinanceError a)
catchErrorResponse :: forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Either HttpException (JsonResponse a) -> m (Either BinanceError a)
catchErrorResponse = \case
Right JsonResponse a
r -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody JsonResponse a
r
Left e :: HttpException
e@(VanillaHttpException (HttpExceptionRequest Request
_ (StatusCodeException (Status -> Int
statusCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> Status
responseStatus -> Int
400) ByteString
errBody)))
-> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw HttpException
e) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)
forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' ByteString
errBody
Left HttpException
e -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw HttpException
e
getExchangeInfo
:: (MonadHttp m, MonadCatch m)
=> [T.Text]
-> m (Either BinanceError ExchangeInfo)
getExchangeInfo :: forall (m :: * -> *).
(MonadHttp m, MonadCatch m) =>
[Text] -> m (Either BinanceError ExchangeInfo)
getExchangeInfo [Text]
symbols = do
let symbolsParam :: Text
symbolsParam =
forall a. Monoid a => [a] -> a
mconcat
[ Text
"["
, Text -> [Text] -> Text
T.intercalate Text
"," (forall a b. (a -> b) -> [a] -> [b]
map (\Text
s -> Text
"\"" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
"\"") [Text]
symbols)
, Text
"]"
]
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Either HttpException (JsonResponse a) -> m (Either BinanceError a)
catchErrorResponse forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req
GET
GET
(Text -> Url 'Https
https Text
"api.binance.us" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"api" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"v3" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"exchangeInfo")
NoReqBody
NoReqBody
forall a. Proxy (JsonResponse a)
jsonResponse
(Text
"symbols" forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: Text
symbolsParam)
newtype ExchangeInfo = ExchangeInfo
{ ExchangeInfo -> [SymbolDetails]
eiSymbols :: [SymbolDetails]
} deriving (Int -> ExchangeInfo -> ShowS
[ExchangeInfo] -> ShowS
ExchangeInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExchangeInfo] -> ShowS
$cshowList :: [ExchangeInfo] -> ShowS
show :: ExchangeInfo -> String
$cshow :: ExchangeInfo -> String
showsPrec :: Int -> ExchangeInfo -> ShowS
$cshowsPrec :: Int -> ExchangeInfo -> ShowS
Show, ReadPrec [ExchangeInfo]
ReadPrec ExchangeInfo
Int -> ReadS ExchangeInfo
ReadS [ExchangeInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExchangeInfo]
$creadListPrec :: ReadPrec [ExchangeInfo]
readPrec :: ReadPrec ExchangeInfo
$creadPrec :: ReadPrec ExchangeInfo
readList :: ReadS [ExchangeInfo]
$creadList :: ReadS [ExchangeInfo]
readsPrec :: Int -> ReadS ExchangeInfo
$creadsPrec :: Int -> ReadS ExchangeInfo
Read, ExchangeInfo -> ExchangeInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExchangeInfo -> ExchangeInfo -> Bool
$c/= :: ExchangeInfo -> ExchangeInfo -> Bool
== :: ExchangeInfo -> ExchangeInfo -> Bool
$c== :: ExchangeInfo -> ExchangeInfo -> Bool
Eq, Eq ExchangeInfo
ExchangeInfo -> ExchangeInfo -> Bool
ExchangeInfo -> ExchangeInfo -> Ordering
ExchangeInfo -> ExchangeInfo -> ExchangeInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExchangeInfo -> ExchangeInfo -> ExchangeInfo
$cmin :: ExchangeInfo -> ExchangeInfo -> ExchangeInfo
max :: ExchangeInfo -> ExchangeInfo -> ExchangeInfo
$cmax :: ExchangeInfo -> ExchangeInfo -> ExchangeInfo
>= :: ExchangeInfo -> ExchangeInfo -> Bool
$c>= :: ExchangeInfo -> ExchangeInfo -> Bool
> :: ExchangeInfo -> ExchangeInfo -> Bool
$c> :: ExchangeInfo -> ExchangeInfo -> Bool
<= :: ExchangeInfo -> ExchangeInfo -> Bool
$c<= :: ExchangeInfo -> ExchangeInfo -> Bool
< :: ExchangeInfo -> ExchangeInfo -> Bool
$c< :: ExchangeInfo -> ExchangeInfo -> Bool
compare :: ExchangeInfo -> ExchangeInfo -> Ordering
$ccompare :: ExchangeInfo -> ExchangeInfo -> Ordering
Ord)
instance FromJSON ExchangeInfo where
parseJSON :: Value -> Parser ExchangeInfo
parseJSON =
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExchangeInfo" forall a b. (a -> b) -> a -> b
$ \Object
o -> [SymbolDetails] -> ExchangeInfo
ExchangeInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"symbols"
data SymbolDetails = SymbolDetails
{ SymbolDetails -> Text
sdSymbol :: T.Text
, SymbolDetails -> Text
sdBaseAsset :: T.Text
, SymbolDetails -> Int
sdBaseAssetPrecision :: Int
, SymbolDetails -> Text
sdQuoteAsset :: T.Text
, SymbolDetails -> Int
sdQuoteAssetPrecision :: Int
}
deriving (Int -> SymbolDetails -> ShowS
[SymbolDetails] -> ShowS
SymbolDetails -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SymbolDetails] -> ShowS
$cshowList :: [SymbolDetails] -> ShowS
show :: SymbolDetails -> String
$cshow :: SymbolDetails -> String
showsPrec :: Int -> SymbolDetails -> ShowS
$cshowsPrec :: Int -> SymbolDetails -> ShowS
Show, ReadPrec [SymbolDetails]
ReadPrec SymbolDetails
Int -> ReadS SymbolDetails
ReadS [SymbolDetails]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SymbolDetails]
$creadListPrec :: ReadPrec [SymbolDetails]
readPrec :: ReadPrec SymbolDetails
$creadPrec :: ReadPrec SymbolDetails
readList :: ReadS [SymbolDetails]
$creadList :: ReadS [SymbolDetails]
readsPrec :: Int -> ReadS SymbolDetails
$creadsPrec :: Int -> ReadS SymbolDetails
Read, SymbolDetails -> SymbolDetails -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SymbolDetails -> SymbolDetails -> Bool
$c/= :: SymbolDetails -> SymbolDetails -> Bool
== :: SymbolDetails -> SymbolDetails -> Bool
$c== :: SymbolDetails -> SymbolDetails -> Bool
Eq, Eq SymbolDetails
SymbolDetails -> SymbolDetails -> Bool
SymbolDetails -> SymbolDetails -> Ordering
SymbolDetails -> SymbolDetails -> SymbolDetails
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SymbolDetails -> SymbolDetails -> SymbolDetails
$cmin :: SymbolDetails -> SymbolDetails -> SymbolDetails
max :: SymbolDetails -> SymbolDetails -> SymbolDetails
$cmax :: SymbolDetails -> SymbolDetails -> SymbolDetails
>= :: SymbolDetails -> SymbolDetails -> Bool
$c>= :: SymbolDetails -> SymbolDetails -> Bool
> :: SymbolDetails -> SymbolDetails -> Bool
$c> :: SymbolDetails -> SymbolDetails -> Bool
<= :: SymbolDetails -> SymbolDetails -> Bool
$c<= :: SymbolDetails -> SymbolDetails -> Bool
< :: SymbolDetails -> SymbolDetails -> Bool
$c< :: SymbolDetails -> SymbolDetails -> Bool
compare :: SymbolDetails -> SymbolDetails -> Ordering
$ccompare :: SymbolDetails -> SymbolDetails -> Ordering
Ord)
instance FromJSON SymbolDetails where
parseJSON :: Value -> Parser SymbolDetails
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SymbolDetails" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Text
sdSymbol <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"symbol"
Text
sdBaseAsset <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"baseAsset"
Int
sdBaseAssetPrecision <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"baseAssetPrecision"
Text
sdQuoteAsset <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"quoteAsset"
Int
sdQuoteAssetPrecision <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"quoteAssetPrecision"
forall (m :: * -> *) a. Monad m => a -> m a
return SymbolDetails { Int
Text
sdQuoteAssetPrecision :: Int
sdQuoteAsset :: Text
sdBaseAssetPrecision :: Int
sdBaseAsset :: Text
sdSymbol :: Text
sdQuoteAssetPrecision :: Int
sdQuoteAsset :: Text
sdBaseAssetPrecision :: Int
sdBaseAsset :: Text
sdSymbol :: Text
.. }
getTradeHistory
:: (MonadHttp m, MonadReader BinanceConfig m)
=> T.Text
-> Maybe UTCTime
-> Maybe UTCTime
-> m [Trade]
getTradeHistory :: forall (m :: * -> *).
(MonadHttp m, MonadReader BinanceConfig m) =>
Text -> Maybe UTCTime -> Maybe UTCTime -> m [Trade]
getTradeHistory Text
symbol Maybe UTCTime
mbStart Maybe UTCTime
mbEnd = do
BinanceConfig
cfg <- forall r (m :: * -> *). MonadReader r m => m r
ask
String
timestamp <- UTCTime -> String
utcToMs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
let limit :: Int
limit = (Int
1000 :: Int)
JsonResponse [Trade]
resp <- forall (m :: * -> *) method body response (scheme :: Scheme).
(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
GET
GET
(Text -> Url 'Https
https Text
"api.binance.us" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"api" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"v3" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"myTrades")
NoReqBody
NoReqBody
forall a. Proxy (JsonResponse a)
jsonResponse
(forall a. Monoid a => [a] -> a
mconcat
[ Text
"symbol" forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: Text
symbol
, Text
"timestamp" forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: String
timestamp
, Text
"limit" forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: Int
limit
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty ((Text
"startTime" forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
utcToMs) Maybe UTCTime
mbStart
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty ((Text
"endTime" forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
utcToMs) Maybe UTCTime
mbEnd
, forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"X-MBX-APIKEY" (Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ BinanceConfig -> Text
bcApiKey BinanceConfig
cfg)
]
)
let results :: HttpResponseBody (JsonResponse [Trade])
results = forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody JsonResponse [Trade]
resp
if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Trade]
results forall a. Eq a => a -> a -> Bool
/= Int
limit
then forall (m :: * -> *) a. Monad m => a -> m a
return [Trade]
results
else do
let minTime :: Trade
minTime = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Trade -> POSIXTime
tTime) [Trade]
results
([Trade]
results forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(MonadHttp m, MonadReader BinanceConfig m) =>
Text -> Maybe UTCTime -> Maybe UTCTime -> m [Trade]
getTradeHistory
Text
symbol
Maybe UTCTime
mbStart
(forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime forall a b. (a -> b) -> a -> b
$ Trade -> POSIXTime
tTime Trade
minTime)
data Trade = Trade
{ Trade -> Text
tSymbol :: T.Text
, Trade -> Integer
tId :: Integer
, Trade -> Integer
tOrderId :: Integer
, Trade -> Scientific
tPrice :: Scientific
, Trade -> Scientific
tQuantity :: Scientific
, Trade -> Scientific
tQuoteQuantity :: Scientific
, Trade -> Scientific
tCommission :: Scientific
, Trade -> Text
tCommissionAsset :: T.Text
, Trade -> POSIXTime
tTime :: POSIXTime
, Trade -> Bool
tIsBuyer :: Bool
, Trade -> Bool
tIsMaker :: Bool
, Trade -> Bool
tIsBestMatch :: Bool
}
deriving (Int -> Trade -> ShowS
[Trade] -> ShowS
Trade -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Trade] -> ShowS
$cshowList :: [Trade] -> ShowS
show :: Trade -> String
$cshow :: Trade -> String
showsPrec :: Int -> Trade -> ShowS
$cshowsPrec :: Int -> Trade -> ShowS
Show, ReadPrec [Trade]
ReadPrec Trade
Int -> ReadS Trade
ReadS [Trade]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Trade]
$creadListPrec :: ReadPrec [Trade]
readPrec :: ReadPrec Trade
$creadPrec :: ReadPrec Trade
readList :: ReadS [Trade]
$creadList :: ReadS [Trade]
readsPrec :: Int -> ReadS Trade
$creadsPrec :: Int -> ReadS Trade
Read, Trade -> Trade -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Trade -> Trade -> Bool
$c/= :: Trade -> Trade -> Bool
== :: Trade -> Trade -> Bool
$c== :: Trade -> Trade -> Bool
Eq, Eq Trade
Trade -> Trade -> Bool
Trade -> Trade -> Ordering
Trade -> Trade -> Trade
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Trade -> Trade -> Trade
$cmin :: Trade -> Trade -> Trade
max :: Trade -> Trade -> Trade
$cmax :: Trade -> Trade -> Trade
>= :: Trade -> Trade -> Bool
$c>= :: Trade -> Trade -> Bool
> :: Trade -> Trade -> Bool
$c> :: Trade -> Trade -> Bool
<= :: Trade -> Trade -> Bool
$c<= :: Trade -> Trade -> Bool
< :: Trade -> Trade -> Bool
$c< :: Trade -> Trade -> Bool
compare :: Trade -> Trade -> Ordering
$ccompare :: Trade -> Trade -> Ordering
Ord)
instance FromJSON Trade where
parseJSON :: Value -> Parser Trade
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Trade" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Text
tSymbol <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"symbol"
Integer
tId <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
Integer
tOrderId <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"orderId"
Scientific
tPrice <- forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"price"
Scientific
tQuantity <- forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"qty"
Scientific
tQuoteQuantity <- forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"quoteQty"
Scientific
tCommission <- forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"commission"
Text
tCommissionAsset <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"commissionAsset"
POSIXTime
tTime <- (forall a. Fractional a => a -> a -> a
/ POSIXTime
1000.0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"time"
Bool
tIsBuyer <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"isBuyer"
Bool
tIsMaker <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"isMaker"
Bool
tIsBestMatch <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"isBestMatch"
forall (m :: * -> *) a. Monad m => a -> m a
return Trade { Bool
Integer
Scientific
Text
POSIXTime
tIsBestMatch :: Bool
tIsMaker :: Bool
tIsBuyer :: Bool
tTime :: POSIXTime
tCommissionAsset :: Text
tCommission :: Scientific
tQuoteQuantity :: Scientific
tQuantity :: Scientific
tPrice :: Scientific
tOrderId :: Integer
tId :: Integer
tSymbol :: Text
tIsBestMatch :: Bool
tIsMaker :: Bool
tIsBuyer :: Bool
tCommissionAsset :: Text
tCommission :: Scientific
tQuoteQuantity :: Scientific
tQuantity :: Scientific
tPrice :: Scientific
tOrderId :: Integer
tId :: Integer
tSymbol :: Text
tTime :: POSIXTime
.. }
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 :: forall (m :: * -> *) method body response (scheme :: Scheme).
(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 method
m Url scheme
u body
b Proxy response
p Option scheme
s = do
BinanceConfig
cfg <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> (Request -> m Request)
-> m response
reqCb method
m Url scheme
u body
b Proxy response
p Option scheme
s forall a b. (a -> b) -> a -> b
$ \Request
req_ -> do
let qs :: ByteString
qs = Int -> ByteString -> ByteString
BS.drop Int
1 forall a b. (a -> b) -> a -> b
$ Request -> ByteString
queryString Request
req_
body :: ByteString
body = RequestBody -> ByteString
getBodyBS forall a b. (a -> b) -> a -> b
$ Request -> RequestBody
requestBody Request
req_
sig :: ByteString
sig = BinanceConfig -> ByteString -> ByteString -> ByteString
mkSignature BinanceConfig
cfg ByteString
qs ByteString
body
qs_ :: ByteString
qs_ = if ByteString -> Int
BS.length ByteString
qs forall a. Eq a => a -> a -> Bool
== Int
0
then ByteString
"?signature=" forall a. Semigroup a => a -> a -> a
<> ByteString
sig
else ByteString
qs forall a. Semigroup a => a -> a -> a
<> ByteString
"&signature=" forall a. Semigroup a => a -> a -> a
<> ByteString
sig
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Request
req_ { queryString :: ByteString
queryString = ByteString
qs_ }
where
getBodyBS :: RequestBody -> ByteString
getBodyBS = \case
RequestBodyLBS ByteString
lbs -> ByteString -> ByteString
LBS.toStrict ByteString
lbs
RequestBodyBS ByteString
bs -> ByteString
bs
RequestBody
_ -> ByteString
""
mkSignature
:: BinanceConfig
-> BS.ByteString
-> BS.ByteString
-> BS.ByteString
mkSignature :: BinanceConfig -> ByteString -> ByteString -> ByteString
mkSignature BinanceConfig
cfg ByteString
queryParams ByteString
reqBody =
let totalParams :: ByteString
totalParams = ByteString
queryParams forall a. Semigroup a => a -> a -> a
<> ByteString
reqBody
key :: ByteString
key = Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ BinanceConfig -> Text
bcApiSecret BinanceConfig
cfg
in String -> ByteString
BC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Word8 -> String
hexString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
hmac ByteString
key ByteString
totalParams
utcToMs :: UTCTime -> String
utcToMs :: UTCTime -> String
utcToMs = forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%s000"