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