{-# 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                  ( (<=<) )
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
    { BinanceConfig -> Text
bcApiKey    :: T.Text
    -- ^ Your API Key
    , BinanceConfig -> Text
bcApiSecret :: T.Text
    -- ^ Your API Key's Secret
    }
    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)

-- | The monad in which Binance API requests are run.
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)

-- | Run a series of API requests with the given Config.
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

-- | Use 'MonadHttp' from the 'Req' instance.
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

-- | Error responses from the API.
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"

-- | 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 :: 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


-- 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 :: 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)

-- | General information about the exchange. Currently we only parse out
-- the details of requested symbols.
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"

-- | The asset pairs for a trade symbol, along with Binance's precisions
-- for each asset.
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
.. }


-- 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 :: 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)

-- | A single trade made on Binance.
data Trade = Trade
    { Trade -> Text
tSymbol          :: T.Text
    -- ^ Full symbol of the trade - base asset & quote asset
    , Trade -> Integer
tId              :: Integer
    -- ^ Trade's ID number
    , Trade -> Integer
tOrderId         :: Integer
    -- ^ Order ID number from which the Trade was made
    , Trade -> Scientific
tPrice           :: Scientific
    , Trade -> Scientific
tQuantity        :: Scientific
    , Trade -> 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.
    , 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"
        -- Binance API returns milliseconds, POSIXTime is seconds
        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
.. }


-- UTILS

-- | Run a request for a @SIGNED@ endpoint by inserting the signature into
-- the query string 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 :: 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
""

-- | Generate a HMAC "Crpto.Hash.SHA256" signature for a @SIGNED@ api
-- request.
mkSignature
    :: BinanceConfig
    -- ^ API Credentials
    -> BS.ByteString
    -- ^ Query parameters (with no leading @?@)
    -> BS.ByteString
    -- ^ Request body
    -> 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

-- | Convert UTC into posix milliseconds for the Binance API.
utcToMs :: UTCTime -> String
utcToMs :: UTCTime -> String
utcToMs = forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%s000"