{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-| Request functions & response types for the Gemini Exchange API.
-}
module Web.Gemini
    ( GeminiApiM
    , runApi
    , GeminiConfig(..)
    , GeminiError(..)
    -- * Requests
    -- ** Symbol Details
    , getSymbolDetails
    , SymbolDetails(..)
    -- ** Trade History
    , getMyTrades
    , Trade(..)
    -- ** Transfer History
    , getMyTransfers
    , Transfer(..)
    -- ** Earn History
    , getMyEarnTransactions
    , EarnHistory(..)
    , EarnTransaction(..)
    -- * Helpers
    , protectedGeminiRequest
    , retryWithRateLimit
    , createSignature
    , makeNonce
    ) where

import           Control.Concurrent             ( threadDelay )
import           Control.Exception.Safe         ( MonadCatch
                                                , MonadThrow
                                                , try
                                                )
import           Control.Monad.Reader           ( MonadIO(liftIO)
                                                , MonadReader(ask)
                                                , ReaderT(..)
                                                , lift
                                                )
import           Crypto.Hash                    ( SHA384 )
import           Crypto.MAC.HMAC                ( hmac
                                                , hmacGetDigest
                                                )
import           Data.Aeson                     ( (.:)
                                                , (.:?)
                                                , FromJSON(..)
                                                , ToJSON(..)
                                                , Value(..)
                                                , eitherDecode
                                                , encode
                                                , withObject
                                                )
import           Data.Base64.Types              ( extractBase64 )
import           Data.ByteString.Base64         ( encodeBase64' )
import           Data.Maybe                     ( fromMaybe
                                                , listToMaybe
                                                , mapMaybe
                                                )
import           Data.Ratio                     ( (%) )
import           Data.Scientific                ( Scientific )
import           Data.Text                      ( Text )
import           Data.Text.Encoding             ( encodeUtf8 )
import           Data.Time                      ( UTCTime )
import           Data.Time.Clock.POSIX          ( POSIXTime
                                                , getPOSIXTime
                                                , utcTimeToPOSIXSeconds
                                                )
import           Data.Version                   ( showVersion )
import           GHC.Generics                   ( Generic )
import           Network.HTTP.Client            ( HttpException(..)
                                                , HttpExceptionContent(..)
                                                , responseStatus
                                                )
import           Network.HTTP.Req               ( (/:)
                                                , GET(..)
                                                , HttpBodyAllowed
                                                , HttpException(..)
                                                , HttpMethod(..)
                                                , JsonResponse
                                                , MonadHttp(..)
                                                , NoReqBody(..)
                                                , Option
                                                , POST(..)
                                                , ProvidesBody
                                                , Req
                                                , Url
                                                , defaultHttpConfig
                                                , header
                                                , https
                                                , jsonResponse
                                                , req
                                                , responseBody
                                                , runReq
                                                )
import           Network.HTTP.Types             ( Status(..) )
import           Text.Read                      ( readMaybe )

import           Paths_gemini_exports           ( version )

import qualified Data.Aeson.KeyMap             as KM
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


-- | Required configuration data for making requests to the Gemini API.
data GeminiConfig = GeminiConfig
    { GeminiConfig -> Text
gcApiKey    :: Text
    , GeminiConfig -> Text
gcApiSecret :: Text
    }
    deriving (Int -> GeminiConfig -> ShowS
[GeminiConfig] -> ShowS
GeminiConfig -> String
(Int -> GeminiConfig -> ShowS)
-> (GeminiConfig -> String)
-> ([GeminiConfig] -> ShowS)
-> Show GeminiConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeminiConfig -> ShowS
showsPrec :: Int -> GeminiConfig -> ShowS
$cshow :: GeminiConfig -> String
show :: GeminiConfig -> String
$cshowList :: [GeminiConfig] -> ShowS
showList :: [GeminiConfig] -> ShowS
Show, ReadPrec [GeminiConfig]
ReadPrec GeminiConfig
Int -> ReadS GeminiConfig
ReadS [GeminiConfig]
(Int -> ReadS GeminiConfig)
-> ReadS [GeminiConfig]
-> ReadPrec GeminiConfig
-> ReadPrec [GeminiConfig]
-> Read GeminiConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS GeminiConfig
readsPrec :: Int -> ReadS GeminiConfig
$creadList :: ReadS [GeminiConfig]
readList :: ReadS [GeminiConfig]
$creadPrec :: ReadPrec GeminiConfig
readPrec :: ReadPrec GeminiConfig
$creadListPrec :: ReadPrec [GeminiConfig]
readListPrec :: ReadPrec [GeminiConfig]
Read, GeminiConfig -> GeminiConfig -> Bool
(GeminiConfig -> GeminiConfig -> Bool)
-> (GeminiConfig -> GeminiConfig -> Bool) -> Eq GeminiConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GeminiConfig -> GeminiConfig -> Bool
== :: GeminiConfig -> GeminiConfig -> Bool
$c/= :: GeminiConfig -> GeminiConfig -> Bool
/= :: GeminiConfig -> GeminiConfig -> Bool
Eq, Eq GeminiConfig
Eq GeminiConfig =>
(GeminiConfig -> GeminiConfig -> Ordering)
-> (GeminiConfig -> GeminiConfig -> Bool)
-> (GeminiConfig -> GeminiConfig -> Bool)
-> (GeminiConfig -> GeminiConfig -> Bool)
-> (GeminiConfig -> GeminiConfig -> Bool)
-> (GeminiConfig -> GeminiConfig -> GeminiConfig)
-> (GeminiConfig -> GeminiConfig -> GeminiConfig)
-> Ord GeminiConfig
GeminiConfig -> GeminiConfig -> Bool
GeminiConfig -> GeminiConfig -> Ordering
GeminiConfig -> GeminiConfig -> GeminiConfig
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
$ccompare :: GeminiConfig -> GeminiConfig -> Ordering
compare :: GeminiConfig -> GeminiConfig -> Ordering
$c< :: GeminiConfig -> GeminiConfig -> Bool
< :: GeminiConfig -> GeminiConfig -> Bool
$c<= :: GeminiConfig -> GeminiConfig -> Bool
<= :: GeminiConfig -> GeminiConfig -> Bool
$c> :: GeminiConfig -> GeminiConfig -> Bool
> :: GeminiConfig -> GeminiConfig -> Bool
$c>= :: GeminiConfig -> GeminiConfig -> Bool
>= :: GeminiConfig -> GeminiConfig -> Bool
$cmax :: GeminiConfig -> GeminiConfig -> GeminiConfig
max :: GeminiConfig -> GeminiConfig -> GeminiConfig
$cmin :: GeminiConfig -> GeminiConfig -> GeminiConfig
min :: GeminiConfig -> GeminiConfig -> GeminiConfig
Ord)

-- | Monad in which Gemini API requests are run.
newtype GeminiApiM a = GeminiApiM
    { forall a. GeminiApiM a -> ReaderT GeminiConfig Req a
runGeminiApiM :: ReaderT GeminiConfig Req a
    } deriving ((forall a b. (a -> b) -> GeminiApiM a -> GeminiApiM b)
-> (forall a b. a -> GeminiApiM b -> GeminiApiM a)
-> Functor GeminiApiM
forall a b. a -> GeminiApiM b -> GeminiApiM a
forall a b. (a -> b) -> GeminiApiM a -> GeminiApiM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GeminiApiM a -> GeminiApiM b
fmap :: forall a b. (a -> b) -> GeminiApiM a -> GeminiApiM b
$c<$ :: forall a b. a -> GeminiApiM b -> GeminiApiM a
<$ :: forall a b. a -> GeminiApiM b -> GeminiApiM a
Functor, Functor GeminiApiM
Functor GeminiApiM =>
(forall a. a -> GeminiApiM a)
-> (forall a b.
    GeminiApiM (a -> b) -> GeminiApiM a -> GeminiApiM b)
-> (forall a b c.
    (a -> b -> c) -> GeminiApiM a -> GeminiApiM b -> GeminiApiM c)
-> (forall a b. GeminiApiM a -> GeminiApiM b -> GeminiApiM b)
-> (forall a b. GeminiApiM a -> GeminiApiM b -> GeminiApiM a)
-> Applicative GeminiApiM
forall a. a -> GeminiApiM a
forall a b. GeminiApiM a -> GeminiApiM b -> GeminiApiM a
forall a b. GeminiApiM a -> GeminiApiM b -> GeminiApiM b
forall a b. GeminiApiM (a -> b) -> GeminiApiM a -> GeminiApiM b
forall a b c.
(a -> b -> c) -> GeminiApiM a -> GeminiApiM b -> GeminiApiM 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
$cpure :: forall a. a -> GeminiApiM a
pure :: forall a. a -> GeminiApiM a
$c<*> :: forall a b. GeminiApiM (a -> b) -> GeminiApiM a -> GeminiApiM b
<*> :: forall a b. GeminiApiM (a -> b) -> GeminiApiM a -> GeminiApiM b
$cliftA2 :: forall a b c.
(a -> b -> c) -> GeminiApiM a -> GeminiApiM b -> GeminiApiM c
liftA2 :: forall a b c.
(a -> b -> c) -> GeminiApiM a -> GeminiApiM b -> GeminiApiM c
$c*> :: forall a b. GeminiApiM a -> GeminiApiM b -> GeminiApiM b
*> :: forall a b. GeminiApiM a -> GeminiApiM b -> GeminiApiM b
$c<* :: forall a b. GeminiApiM a -> GeminiApiM b -> GeminiApiM a
<* :: forall a b. GeminiApiM a -> GeminiApiM b -> GeminiApiM a
Applicative, Applicative GeminiApiM
Applicative GeminiApiM =>
(forall a b. GeminiApiM a -> (a -> GeminiApiM b) -> GeminiApiM b)
-> (forall a b. GeminiApiM a -> GeminiApiM b -> GeminiApiM b)
-> (forall a. a -> GeminiApiM a)
-> Monad GeminiApiM
forall a. a -> GeminiApiM a
forall a b. GeminiApiM a -> GeminiApiM b -> GeminiApiM b
forall a b. GeminiApiM a -> (a -> GeminiApiM b) -> GeminiApiM 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
$c>>= :: forall a b. GeminiApiM a -> (a -> GeminiApiM b) -> GeminiApiM b
>>= :: forall a b. GeminiApiM a -> (a -> GeminiApiM b) -> GeminiApiM b
$c>> :: forall a b. GeminiApiM a -> GeminiApiM b -> GeminiApiM b
>> :: forall a b. GeminiApiM a -> GeminiApiM b -> GeminiApiM b
$creturn :: forall a. a -> GeminiApiM a
return :: forall a. a -> GeminiApiM a
Monad, Monad GeminiApiM
Monad GeminiApiM =>
(forall a. IO a -> GeminiApiM a) -> MonadIO GeminiApiM
forall a. IO a -> GeminiApiM a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> GeminiApiM a
liftIO :: forall a. IO a -> GeminiApiM a
MonadIO, MonadReader GeminiConfig, Monad GeminiApiM
Monad GeminiApiM =>
(forall e a. (HasCallStack, Exception e) => e -> GeminiApiM a)
-> MonadThrow GeminiApiM
forall e a. (HasCallStack, Exception e) => e -> GeminiApiM a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> GeminiApiM a
throwM :: forall e a. (HasCallStack, Exception e) => e -> GeminiApiM a
MonadThrow, MonadThrow GeminiApiM
MonadThrow GeminiApiM =>
(forall e a.
 (HasCallStack, Exception e) =>
 GeminiApiM a -> (e -> GeminiApiM a) -> GeminiApiM a)
-> MonadCatch GeminiApiM
forall e a.
(HasCallStack, Exception e) =>
GeminiApiM a -> (e -> GeminiApiM a) -> GeminiApiM a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall e a.
(HasCallStack, Exception e) =>
GeminiApiM a -> (e -> GeminiApiM a) -> GeminiApiM a
catch :: forall e a.
(HasCallStack, Exception e) =>
GeminiApiM a -> (e -> GeminiApiM a) -> GeminiApiM a
MonadCatch)

-- | Run a series of API requests with the given Config.
runApi :: GeminiConfig -> GeminiApiM a -> IO a
runApi :: forall a. GeminiConfig -> GeminiApiM a -> IO a
runApi GeminiConfig
cfg = HttpConfig -> Req a -> IO a
forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
defaultHttpConfig (Req a -> IO a) -> (GeminiApiM a -> Req a) -> GeminiApiM a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT GeminiConfig Req a -> GeminiConfig -> Req a)
-> GeminiConfig -> ReaderT GeminiConfig Req a -> Req a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT GeminiConfig Req a -> GeminiConfig -> Req a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT GeminiConfig
cfg (ReaderT GeminiConfig Req a -> Req a)
-> (GeminiApiM a -> ReaderT GeminiConfig Req a)
-> GeminiApiM a
-> Req a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeminiApiM a -> ReaderT GeminiConfig Req a
forall a. GeminiApiM a -> ReaderT GeminiConfig Req a
runGeminiApiM

-- | Use 'MonadHttp' from the 'Req' monad.
instance MonadHttp GeminiApiM where
    handleHttpException :: forall a. HttpException -> GeminiApiM a
handleHttpException = ReaderT GeminiConfig Req a -> GeminiApiM a
forall a. ReaderT GeminiConfig Req a -> GeminiApiM a
GeminiApiM (ReaderT GeminiConfig Req a -> GeminiApiM a)
-> (HttpException -> ReaderT GeminiConfig Req a)
-> HttpException
-> GeminiApiM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Req a -> ReaderT GeminiConfig Req a
forall (m :: * -> *) a. Monad m => m a -> ReaderT GeminiConfig m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Req a -> ReaderT GeminiConfig Req a)
-> (HttpException -> Req a)
-> HttpException
-> ReaderT GeminiConfig Req a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> Req a
forall a. HttpException -> Req a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException

-- | Potential error response body from the API.
data GeminiError = GeminiError
    { GeminiError -> Text
geReason  :: Text
    , GeminiError -> Text
geMessage :: Text
    }
    deriving (Int -> GeminiError -> ShowS
[GeminiError] -> ShowS
GeminiError -> String
(Int -> GeminiError -> ShowS)
-> (GeminiError -> String)
-> ([GeminiError] -> ShowS)
-> Show GeminiError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeminiError -> ShowS
showsPrec :: Int -> GeminiError -> ShowS
$cshow :: GeminiError -> String
show :: GeminiError -> String
$cshowList :: [GeminiError] -> ShowS
showList :: [GeminiError] -> ShowS
Show, ReadPrec [GeminiError]
ReadPrec GeminiError
Int -> ReadS GeminiError
ReadS [GeminiError]
(Int -> ReadS GeminiError)
-> ReadS [GeminiError]
-> ReadPrec GeminiError
-> ReadPrec [GeminiError]
-> Read GeminiError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS GeminiError
readsPrec :: Int -> ReadS GeminiError
$creadList :: ReadS [GeminiError]
readList :: ReadS [GeminiError]
$creadPrec :: ReadPrec GeminiError
readPrec :: ReadPrec GeminiError
$creadListPrec :: ReadPrec [GeminiError]
readListPrec :: ReadPrec [GeminiError]
Read, GeminiError -> GeminiError -> Bool
(GeminiError -> GeminiError -> Bool)
-> (GeminiError -> GeminiError -> Bool) -> Eq GeminiError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GeminiError -> GeminiError -> Bool
== :: GeminiError -> GeminiError -> Bool
$c/= :: GeminiError -> GeminiError -> Bool
/= :: GeminiError -> GeminiError -> Bool
Eq, Eq GeminiError
Eq GeminiError =>
(GeminiError -> GeminiError -> Ordering)
-> (GeminiError -> GeminiError -> Bool)
-> (GeminiError -> GeminiError -> Bool)
-> (GeminiError -> GeminiError -> Bool)
-> (GeminiError -> GeminiError -> Bool)
-> (GeminiError -> GeminiError -> GeminiError)
-> (GeminiError -> GeminiError -> GeminiError)
-> Ord GeminiError
GeminiError -> GeminiError -> Bool
GeminiError -> GeminiError -> Ordering
GeminiError -> GeminiError -> GeminiError
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
$ccompare :: GeminiError -> GeminiError -> Ordering
compare :: GeminiError -> GeminiError -> Ordering
$c< :: GeminiError -> GeminiError -> Bool
< :: GeminiError -> GeminiError -> Bool
$c<= :: GeminiError -> GeminiError -> Bool
<= :: GeminiError -> GeminiError -> Bool
$c> :: GeminiError -> GeminiError -> Bool
> :: GeminiError -> GeminiError -> Bool
$c>= :: GeminiError -> GeminiError -> Bool
>= :: GeminiError -> GeminiError -> Bool
$cmax :: GeminiError -> GeminiError -> GeminiError
max :: GeminiError -> GeminiError -> GeminiError
$cmin :: GeminiError -> GeminiError -> GeminiError
min :: GeminiError -> GeminiError -> GeminiError
Ord)

instance FromJSON GeminiError where
    parseJSON :: Value -> Parser GeminiError
parseJSON = String
-> (KeyMap Value -> Parser GeminiError)
-> Value
-> Parser GeminiError
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject String
"GeminiError"
        ((KeyMap Value -> Parser GeminiError)
 -> Value -> Parser GeminiError)
-> (KeyMap Value -> Parser GeminiError)
-> Value
-> Parser GeminiError
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
o -> Text -> Text -> GeminiError
GeminiError (Text -> Text -> GeminiError)
-> Parser Text -> Parser (Text -> GeminiError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"reason" Parser (Text -> GeminiError) -> Parser Text -> Parser GeminiError
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"message"


-- SYMBOL DETAILS

-- | Fetch the details on a supported symbol.
getSymbolDetails :: MonadHttp m => Text -> m SymbolDetails
getSymbolDetails :: forall (m :: * -> *). MonadHttp m => Text -> m SymbolDetails
getSymbolDetails Text
symbol =
    JsonResponse SymbolDetails
-> HttpResponseBody (JsonResponse SymbolDetails)
JsonResponse SymbolDetails -> SymbolDetails
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody
        (JsonResponse SymbolDetails -> SymbolDetails)
-> m (JsonResponse SymbolDetails) -> m SymbolDetails
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET
-> Url 'Https
-> NoReqBody
-> Proxy (JsonResponse SymbolDetails)
-> Option 'Https
-> m (JsonResponse SymbolDetails)
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.gemini.com"
                Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"v1"
                Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"symbols"
                Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"details"
                Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
symbol
                )
                NoReqBody
NoReqBody
                Proxy (JsonResponse SymbolDetails)
forall a. Proxy (JsonResponse a)
jsonResponse
                Option 'Https
forall (scheme :: Scheme). Option scheme
userAgentHeader

-- | Currency & Precision details for a 'Trade' Symbol.
data SymbolDetails = SymbolDetails
    { SymbolDetails -> Text
sdSymbol         :: Text
    , SymbolDetails -> Text
sdBaseCurrency   :: Text
    , SymbolDetails -> Scientific
sdBasePrecision  :: Scientific
    , SymbolDetails -> Text
sdQuoteCurrency  :: Text
    , SymbolDetails -> Scientific
sdQuotePrecision :: Scientific
    }
    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
$cshowsPrec :: Int -> SymbolDetails -> ShowS
showsPrec :: Int -> SymbolDetails -> ShowS
$cshow :: SymbolDetails -> String
show :: SymbolDetails -> String
$cshowList :: [SymbolDetails] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS SymbolDetails
readsPrec :: Int -> ReadS SymbolDetails
$creadList :: ReadS [SymbolDetails]
readList :: ReadS [SymbolDetails]
$creadPrec :: ReadPrec SymbolDetails
readPrec :: ReadPrec SymbolDetails
$creadListPrec :: ReadPrec [SymbolDetails]
readListPrec :: ReadPrec [SymbolDetails]
Read, SymbolDetails -> SymbolDetails -> Bool
(SymbolDetails -> SymbolDetails -> Bool)
-> (SymbolDetails -> SymbolDetails -> Bool) -> Eq SymbolDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SymbolDetails -> SymbolDetails -> Bool
== :: SymbolDetails -> SymbolDetails -> Bool
$c/= :: SymbolDetails -> SymbolDetails -> Bool
/= :: 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
$ccompare :: SymbolDetails -> SymbolDetails -> Ordering
compare :: SymbolDetails -> SymbolDetails -> Ordering
$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
>= :: SymbolDetails -> SymbolDetails -> Bool
$cmax :: SymbolDetails -> SymbolDetails -> SymbolDetails
max :: SymbolDetails -> SymbolDetails -> SymbolDetails
$cmin :: SymbolDetails -> SymbolDetails -> SymbolDetails
min :: SymbolDetails -> SymbolDetails -> SymbolDetails
Ord, (forall x. SymbolDetails -> Rep SymbolDetails x)
-> (forall x. Rep SymbolDetails x -> SymbolDetails)
-> Generic SymbolDetails
forall x. Rep SymbolDetails x -> SymbolDetails
forall x. SymbolDetails -> Rep SymbolDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SymbolDetails -> Rep SymbolDetails x
from :: forall x. SymbolDetails -> Rep SymbolDetails x
$cto :: forall x. Rep SymbolDetails x -> SymbolDetails
to :: forall x. Rep SymbolDetails x -> SymbolDetails
Generic)

instance FromJSON SymbolDetails where
    parseJSON :: Value -> Parser SymbolDetails
parseJSON = String
-> (KeyMap Value -> Parser SymbolDetails)
-> Value
-> Parser SymbolDetails
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject String
"SymbolDetails" ((KeyMap Value -> Parser SymbolDetails)
 -> Value -> Parser SymbolDetails)
-> (KeyMap Value -> Parser SymbolDetails)
-> Value
-> Parser SymbolDetails
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
o -> do
        Text
sdSymbol         <- KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"symbol"
        Text
sdBaseCurrency   <- KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"base_currency"
        Scientific
sdBasePrecision  <- KeyMap Value
o KeyMap Value -> Key -> Parser Scientific
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"tick_size"
        Text
sdQuoteCurrency  <- KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"quote_currency"
        Scientific
sdQuotePrecision <- KeyMap Value
o KeyMap Value -> Key -> Parser Scientific
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"quote_increment"
        SymbolDetails -> Parser SymbolDetails
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return SymbolDetails { Text
Scientific
sdSymbol :: Text
sdBaseCurrency :: Text
sdBasePrecision :: Scientific
sdQuoteCurrency :: Text
sdQuotePrecision :: Scientific
sdSymbol :: Text
sdBaseCurrency :: Text
sdBasePrecision :: Scientific
sdQuoteCurrency :: Text
sdQuotePrecision :: Scientific
.. }


-- TRADE HISTORY

-- | Fetch all my Gemini Trades
getMyTrades
    :: Maybe (UTCTime, UTCTime)
    -- ^ Optional @(start, end)@ ranges for fetching.
    -> GeminiApiM [Trade]
getMyTrades :: Maybe (UTCTime, UTCTime) -> GeminiApiM [Trade]
getMyTrades = (Integer -> GeminiApiM [Trade])
-> (Trade -> POSIXTime)
-> Maybe (UTCTime, UTCTime)
-> GeminiApiM [Trade]
forall a.
(Integer -> GeminiApiM [a])
-> (a -> POSIXTime) -> Maybe (UTCTime, UTCTime) -> GeminiApiM [a]
fetchAllPages Integer -> GeminiApiM [Trade]
getTradeBatch Trade -> POSIXTime
tTimestamp
  where
    getTradeBatch :: Integer -> GeminiApiM [Trade]
    getTradeBatch :: Integer -> GeminiApiM [Trade]
getTradeBatch Integer
timestamp = do
        Integer
nonce <- GeminiApiM Integer
forall (m :: * -> *). MonadIO m => m Integer
makeNonce
        let parameters :: KeyMap Value
parameters = [(Key, Value)] -> KeyMap Value
forall v. [(Key, v)] -> KeyMap v
KM.fromList
                [ (Key
"request"     , Text -> Value
String Text
"/v1/mytrades")
                , (Key
"nonce"       , Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
nonce)
                , (Key
"timestamp"   , Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
timestampToSeconds Integer
timestamp)
                , (Key
"limit_trades", Scientific -> Value
Number Scientific
500)
                ]
        JsonResponse [Trade] -> [Trade]
JsonResponse [Trade] -> HttpResponseBody (JsonResponse [Trade])
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody
            (JsonResponse [Trade] -> [Trade])
-> GeminiApiM (JsonResponse [Trade]) -> GeminiApiM [Trade]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> POST
-> Url 'Https -> KeyMap Value -> GeminiApiM (JsonResponse [Trade])
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody NoReqBody),
 ToJSON body, FromJSON response, MonadReader GeminiConfig m) =>
method -> Url scheme -> body -> m (JsonResponse response)
protectedGeminiRequest
                    POST
POST
                    (Text -> Url 'Https
https Text
"api.gemini.com" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"v1" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"mytrades")
                    KeyMap Value
parameters

-- | A single, completed Trade.
data Trade = Trade
    { Trade -> Integer
tId          :: Integer
    , Trade -> Text
tSymbol      :: Text
    , Trade -> Scientific
tPrice       :: Scientific
    , Trade -> Scientific
tAmount      :: Scientific
    , Trade -> Text
tFeeCurrency :: Text
    , Trade -> Scientific
tFeeAmount   :: Scientific
    , Trade -> Bool
tIsBuy       :: Bool
    , Trade -> Bool
tIsAggressor :: Bool
    , Trade -> POSIXTime
tTimestamp   :: POSIXTime
    , Trade -> Text
tOrderId     :: Text
    }
    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
$cshowsPrec :: Int -> Trade -> ShowS
showsPrec :: Int -> Trade -> ShowS
$cshow :: Trade -> String
show :: Trade -> String
$cshowList :: [Trade] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS Trade
readsPrec :: Int -> ReadS Trade
$creadList :: ReadS [Trade]
readList :: ReadS [Trade]
$creadPrec :: ReadPrec Trade
readPrec :: ReadPrec Trade
$creadListPrec :: ReadPrec [Trade]
readListPrec :: ReadPrec [Trade]
Read, Trade -> Trade -> Bool
(Trade -> Trade -> Bool) -> (Trade -> Trade -> Bool) -> Eq Trade
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Trade -> Trade -> Bool
== :: Trade -> Trade -> Bool
$c/= :: Trade -> Trade -> Bool
/= :: 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
$ccompare :: Trade -> Trade -> Ordering
compare :: Trade -> Trade -> Ordering
$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
>= :: Trade -> Trade -> Bool
$cmax :: Trade -> Trade -> Trade
max :: Trade -> Trade -> Trade
$cmin :: Trade -> Trade -> Trade
min :: Trade -> Trade -> Trade
Ord, (forall x. Trade -> Rep Trade x)
-> (forall x. Rep Trade x -> Trade) -> Generic Trade
forall x. Rep Trade x -> Trade
forall x. Trade -> Rep Trade x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Trade -> Rep Trade x
from :: forall x. Trade -> Rep Trade x
$cto :: forall x. Rep Trade x -> Trade
to :: forall x. Rep Trade x -> Trade
Generic)

instance FromJSON Trade where
    parseJSON :: Value -> Parser Trade
parseJSON = String -> (KeyMap Value -> Parser Trade) -> Value -> Parser Trade
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject String
"Trade" ((KeyMap Value -> Parser Trade) -> Value -> Parser Trade)
-> (KeyMap Value -> Parser Trade) -> Value -> Parser Trade
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
o -> do
        Integer
tId          <- KeyMap Value
o KeyMap Value -> Key -> Parser Integer
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"tid"
        Text
tSymbol      <- KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"symbol"
        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
<$> KeyMap Value
o KeyMap Value -> Key -> Parser String
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"price"
        Scientific
tAmount      <- 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
<$> KeyMap Value
o KeyMap Value -> Key -> Parser String
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"amount"
        Text
tFeeCurrency <- KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"fee_currency"
        Scientific
tFeeAmount   <- 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
<$> KeyMap Value
o KeyMap Value -> Key -> Parser String
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"fee_amount"
        Bool
tIsBuy       <- (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (String
"Buy" :: String)) (String -> Bool) -> Parser String -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap Value
o KeyMap Value -> Key -> Parser String
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"type"
        Bool
tIsAggressor <- KeyMap Value
o KeyMap Value -> Key -> Parser Bool
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"aggressor"
        POSIXTime
tTimestamp   <- (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
<$> KeyMap Value
o KeyMap Value -> Key -> Parser POSIXTime
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"timestampms"
        Text
tOrderId     <- KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"order_id"
        Trade -> Parser Trade
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Trade { Bool
Integer
Text
Scientific
POSIXTime
tTimestamp :: POSIXTime
tId :: Integer
tSymbol :: Text
tPrice :: Scientific
tAmount :: Scientific
tFeeCurrency :: Text
tFeeAmount :: Scientific
tIsBuy :: Bool
tIsAggressor :: Bool
tOrderId :: Text
tId :: Integer
tSymbol :: Text
tPrice :: Scientific
tAmount :: Scientific
tFeeCurrency :: Text
tFeeAmount :: Scientific
tIsBuy :: Bool
tIsAggressor :: Bool
tTimestamp :: POSIXTime
tOrderId :: Text
.. }


-- TRANSFER HISTORY

-- | Fetch all my Gemini Transfers
getMyTransfers
    :: Maybe (UTCTime, UTCTime)
    -- ^ Optional @(start, end)@ ranges for fetching.
    -> GeminiApiM [Transfer]
getMyTransfers :: Maybe (UTCTime, UTCTime) -> GeminiApiM [Transfer]
getMyTransfers = (Integer -> GeminiApiM [Transfer])
-> (Transfer -> POSIXTime)
-> Maybe (UTCTime, UTCTime)
-> GeminiApiM [Transfer]
forall a.
(Integer -> GeminiApiM [a])
-> (a -> POSIXTime) -> Maybe (UTCTime, UTCTime) -> GeminiApiM [a]
fetchAllPages Integer -> GeminiApiM [Transfer]
getTransferBatch Transfer -> POSIXTime
trTimestamp
  where
    getTransferBatch :: Integer -> GeminiApiM [Transfer]
    getTransferBatch :: Integer -> GeminiApiM [Transfer]
getTransferBatch Integer
timestamp = do
        Integer
nonce <- GeminiApiM Integer
forall (m :: * -> *). MonadIO m => m Integer
makeNonce
        let parameters :: KeyMap Value
parameters = [(Key, Value)] -> KeyMap Value
forall v. [(Key, v)] -> KeyMap v
KM.fromList
                [ (Key
"request"        , Text -> Value
String Text
"/v1/transfers")
                , (Key
"nonce"          , Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
nonce)
                , (Key
"timestamp"      , Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
timestampToSeconds Integer
timestamp)
                , (Key
"limit_transfers", Scientific -> Value
Number Scientific
50)
                ]
        JsonResponse [Transfer] -> [Transfer]
JsonResponse [Transfer]
-> HttpResponseBody (JsonResponse [Transfer])
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody
            (JsonResponse [Transfer] -> [Transfer])
-> GeminiApiM (JsonResponse [Transfer]) -> GeminiApiM [Transfer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> POST
-> Url 'Https
-> KeyMap Value
-> GeminiApiM (JsonResponse [Transfer])
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody NoReqBody),
 ToJSON body, FromJSON response, MonadReader GeminiConfig m) =>
method -> Url scheme -> body -> m (JsonResponse response)
protectedGeminiRequest
                    POST
POST
                    (Text -> Url 'Https
https Text
"api.gemini.com" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"v1" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"transfers")
                    KeyMap Value
parameters

-- | A single fiat or cryptocurrency transfer, credit, deposit, or withdrawal.
data Transfer = Transfer
    { Transfer -> Integer
trId        :: Integer
    , Transfer -> Text
trType      :: Text
    , Transfer -> Text
trStatus    :: Text
    , Transfer -> Text
trCurrency  :: Text
    , Transfer -> Scientific
trAmount    :: Scientific
    , Transfer -> Maybe Text
trMethod    :: Maybe Text
    , Transfer -> Maybe Text
trPurpose   :: Maybe Text
    , Transfer -> POSIXTime
trTimestamp :: POSIXTime
    }
    deriving (Int -> Transfer -> ShowS
[Transfer] -> ShowS
Transfer -> String
(Int -> Transfer -> ShowS)
-> (Transfer -> String) -> ([Transfer] -> ShowS) -> Show Transfer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Transfer -> ShowS
showsPrec :: Int -> Transfer -> ShowS
$cshow :: Transfer -> String
show :: Transfer -> String
$cshowList :: [Transfer] -> ShowS
showList :: [Transfer] -> ShowS
Show, ReadPrec [Transfer]
ReadPrec Transfer
Int -> ReadS Transfer
ReadS [Transfer]
(Int -> ReadS Transfer)
-> ReadS [Transfer]
-> ReadPrec Transfer
-> ReadPrec [Transfer]
-> Read Transfer
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Transfer
readsPrec :: Int -> ReadS Transfer
$creadList :: ReadS [Transfer]
readList :: ReadS [Transfer]
$creadPrec :: ReadPrec Transfer
readPrec :: ReadPrec Transfer
$creadListPrec :: ReadPrec [Transfer]
readListPrec :: ReadPrec [Transfer]
Read, Transfer -> Transfer -> Bool
(Transfer -> Transfer -> Bool)
-> (Transfer -> Transfer -> Bool) -> Eq Transfer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Transfer -> Transfer -> Bool
== :: Transfer -> Transfer -> Bool
$c/= :: Transfer -> Transfer -> Bool
/= :: Transfer -> Transfer -> Bool
Eq, Eq Transfer
Eq Transfer =>
(Transfer -> Transfer -> Ordering)
-> (Transfer -> Transfer -> Bool)
-> (Transfer -> Transfer -> Bool)
-> (Transfer -> Transfer -> Bool)
-> (Transfer -> Transfer -> Bool)
-> (Transfer -> Transfer -> Transfer)
-> (Transfer -> Transfer -> Transfer)
-> Ord Transfer
Transfer -> Transfer -> Bool
Transfer -> Transfer -> Ordering
Transfer -> Transfer -> Transfer
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
$ccompare :: Transfer -> Transfer -> Ordering
compare :: Transfer -> Transfer -> Ordering
$c< :: Transfer -> Transfer -> Bool
< :: Transfer -> Transfer -> Bool
$c<= :: Transfer -> Transfer -> Bool
<= :: Transfer -> Transfer -> Bool
$c> :: Transfer -> Transfer -> Bool
> :: Transfer -> Transfer -> Bool
$c>= :: Transfer -> Transfer -> Bool
>= :: Transfer -> Transfer -> Bool
$cmax :: Transfer -> Transfer -> Transfer
max :: Transfer -> Transfer -> Transfer
$cmin :: Transfer -> Transfer -> Transfer
min :: Transfer -> Transfer -> Transfer
Ord, (forall x. Transfer -> Rep Transfer x)
-> (forall x. Rep Transfer x -> Transfer) -> Generic Transfer
forall x. Rep Transfer x -> Transfer
forall x. Transfer -> Rep Transfer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Transfer -> Rep Transfer x
from :: forall x. Transfer -> Rep Transfer x
$cto :: forall x. Rep Transfer x -> Transfer
to :: forall x. Rep Transfer x -> Transfer
Generic)

instance FromJSON Transfer where
    parseJSON :: Value -> Parser Transfer
parseJSON = String
-> (KeyMap Value -> Parser Transfer) -> Value -> Parser Transfer
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject String
"Transfer" ((KeyMap Value -> Parser Transfer) -> Value -> Parser Transfer)
-> (KeyMap Value -> Parser Transfer) -> Value -> Parser Transfer
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
o -> do
        Integer
trId        <- KeyMap Value
o KeyMap Value -> Key -> Parser Integer
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"eid"
        Text
trType      <- KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"type"
        Text
trStatus    <- KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"status"
        Text
trCurrency  <- KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"currency"
        Scientific
trAmount    <- 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
<$> KeyMap Value
o KeyMap Value -> Key -> Parser String
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"amount"
        Maybe Text
trMethod    <- KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Text)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"method"
        Maybe Text
trPurpose   <- KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Text)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"purpose"
        POSIXTime
trTimestamp <- (POSIXTime -> POSIXTime -> POSIXTime
forall a. Fractional a => a -> a -> a
/ POSIXTime
1000) (POSIXTime -> POSIXTime) -> Parser POSIXTime -> Parser POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap Value
o KeyMap Value -> Key -> Parser POSIXTime
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"timestampms"
        Transfer -> Parser Transfer
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Transfer { Integer
Maybe Text
Text
Scientific
POSIXTime
trTimestamp :: POSIXTime
trId :: Integer
trType :: Text
trStatus :: Text
trCurrency :: Text
trAmount :: Scientific
trMethod :: Maybe Text
trPurpose :: Maybe Text
trId :: Integer
trType :: Text
trStatus :: Text
trCurrency :: Text
trAmount :: Scientific
trMethod :: Maybe Text
trPurpose :: Maybe Text
trTimestamp :: POSIXTime
.. }


-- EARN HISTORY

-- | Fetch all my Gemini Earn Transactions
getMyEarnTransactions
    :: Maybe (UTCTime, UTCTime) -> GeminiApiM [EarnTransaction]
getMyEarnTransactions :: Maybe (UTCTime, UTCTime) -> GeminiApiM [EarnTransaction]
getMyEarnTransactions = (Integer -> GeminiApiM [EarnTransaction])
-> (EarnTransaction -> POSIXTime)
-> Maybe (UTCTime, UTCTime)
-> GeminiApiM [EarnTransaction]
forall a.
(Integer -> GeminiApiM [a])
-> (a -> POSIXTime) -> Maybe (UTCTime, UTCTime) -> GeminiApiM [a]
fetchAllPages Integer -> GeminiApiM [EarnTransaction]
getEarnBatch EarnTransaction -> POSIXTime
etTimestamp
  where
    getEarnBatch :: Integer -> GeminiApiM [EarnTransaction]
    getEarnBatch :: Integer -> GeminiApiM [EarnTransaction]
getEarnBatch Integer
timestamp = do
        Integer
nonce <- GeminiApiM Integer
forall (m :: * -> *). MonadIO m => m Integer
makeNonce
        let parameters :: KeyMap Value
parameters = [(Key, Value)] -> KeyMap Value
forall v. [(Key, v)] -> KeyMap v
KM.fromList
                [ (Key
"request", Text -> Value
String Text
"/v1/earn/history")
                , (Key
"nonce"  , Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
nonce)
                , (Key
"since"  , Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
timestamp)
                , (Key
"sortAsc", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
True)
                , (Key
"limit"  , Scientific -> Value
Number Scientific
500)
                ]
        forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap @[] EarnHistory -> [EarnTransaction]
ehTransactions
            ([EarnHistory] -> [EarnTransaction])
-> (JsonResponse [EarnHistory] -> [EarnHistory])
-> JsonResponse [EarnHistory]
-> [EarnTransaction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   JsonResponse [EarnHistory] -> [EarnHistory]
JsonResponse [EarnHistory]
-> HttpResponseBody (JsonResponse [EarnHistory])
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody
            (JsonResponse [EarnHistory] -> [EarnTransaction])
-> GeminiApiM (JsonResponse [EarnHistory])
-> GeminiApiM [EarnTransaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> POST
-> Url 'Https
-> KeyMap Value
-> GeminiApiM (JsonResponse [EarnHistory])
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody NoReqBody),
 ToJSON body, FromJSON response, MonadReader GeminiConfig m) =>
method -> Url scheme -> body -> m (JsonResponse response)
protectedGeminiRequest
                    POST
POST
                    (Text -> Url 'Https
https Text
"api.gemini.com" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"v1" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"earn" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"history")
                    KeyMap Value
parameters

-- | Earn Transactions grouped by a Provider/Borrower.
data EarnHistory = EarnHistory
    { EarnHistory -> Text
ehProviderId   :: Text
    , EarnHistory -> [EarnTransaction]
ehTransactions :: [EarnTransaction]
    }

instance FromJSON EarnHistory where
    parseJSON :: Value -> Parser EarnHistory
parseJSON = String
-> (KeyMap Value -> Parser EarnHistory)
-> Value
-> Parser EarnHistory
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject String
"EarnHistory"
        ((KeyMap Value -> Parser EarnHistory)
 -> Value -> Parser EarnHistory)
-> (KeyMap Value -> Parser EarnHistory)
-> Value
-> Parser EarnHistory
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
o -> Text -> [EarnTransaction] -> EarnHistory
EarnHistory (Text -> [EarnTransaction] -> EarnHistory)
-> Parser Text -> Parser ([EarnTransaction] -> EarnHistory)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"providerId" Parser ([EarnTransaction] -> EarnHistory)
-> Parser [EarnTransaction] -> Parser EarnHistory
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
o KeyMap Value -> Key -> Parser [EarnTransaction]
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"transactions"

-- | A single Earn transaction.
data EarnTransaction = EarnTransaction
    { EarnTransaction -> Text
etId             :: Text
    , EarnTransaction -> Text
etType           :: Text
    , EarnTransaction -> Text
etAmountCurrency :: Text
    , EarnTransaction -> Scientific
etAmount         :: Scientific
    , EarnTransaction -> Maybe Text
etPriceCurrency  :: Maybe Text
    , EarnTransaction -> Maybe Scientific
etPrice          :: Maybe Scientific
    , EarnTransaction -> POSIXTime
etTimestamp      :: POSIXTime
    }
    deriving (Int -> EarnTransaction -> ShowS
[EarnTransaction] -> ShowS
EarnTransaction -> String
(Int -> EarnTransaction -> ShowS)
-> (EarnTransaction -> String)
-> ([EarnTransaction] -> ShowS)
-> Show EarnTransaction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EarnTransaction -> ShowS
showsPrec :: Int -> EarnTransaction -> ShowS
$cshow :: EarnTransaction -> String
show :: EarnTransaction -> String
$cshowList :: [EarnTransaction] -> ShowS
showList :: [EarnTransaction] -> ShowS
Show, ReadPrec [EarnTransaction]
ReadPrec EarnTransaction
Int -> ReadS EarnTransaction
ReadS [EarnTransaction]
(Int -> ReadS EarnTransaction)
-> ReadS [EarnTransaction]
-> ReadPrec EarnTransaction
-> ReadPrec [EarnTransaction]
-> Read EarnTransaction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS EarnTransaction
readsPrec :: Int -> ReadS EarnTransaction
$creadList :: ReadS [EarnTransaction]
readList :: ReadS [EarnTransaction]
$creadPrec :: ReadPrec EarnTransaction
readPrec :: ReadPrec EarnTransaction
$creadListPrec :: ReadPrec [EarnTransaction]
readListPrec :: ReadPrec [EarnTransaction]
Read, EarnTransaction -> EarnTransaction -> Bool
(EarnTransaction -> EarnTransaction -> Bool)
-> (EarnTransaction -> EarnTransaction -> Bool)
-> Eq EarnTransaction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EarnTransaction -> EarnTransaction -> Bool
== :: EarnTransaction -> EarnTransaction -> Bool
$c/= :: EarnTransaction -> EarnTransaction -> Bool
/= :: EarnTransaction -> EarnTransaction -> Bool
Eq, Eq EarnTransaction
Eq EarnTransaction =>
(EarnTransaction -> EarnTransaction -> Ordering)
-> (EarnTransaction -> EarnTransaction -> Bool)
-> (EarnTransaction -> EarnTransaction -> Bool)
-> (EarnTransaction -> EarnTransaction -> Bool)
-> (EarnTransaction -> EarnTransaction -> Bool)
-> (EarnTransaction -> EarnTransaction -> EarnTransaction)
-> (EarnTransaction -> EarnTransaction -> EarnTransaction)
-> Ord EarnTransaction
EarnTransaction -> EarnTransaction -> Bool
EarnTransaction -> EarnTransaction -> Ordering
EarnTransaction -> EarnTransaction -> EarnTransaction
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
$ccompare :: EarnTransaction -> EarnTransaction -> Ordering
compare :: EarnTransaction -> EarnTransaction -> Ordering
$c< :: EarnTransaction -> EarnTransaction -> Bool
< :: EarnTransaction -> EarnTransaction -> Bool
$c<= :: EarnTransaction -> EarnTransaction -> Bool
<= :: EarnTransaction -> EarnTransaction -> Bool
$c> :: EarnTransaction -> EarnTransaction -> Bool
> :: EarnTransaction -> EarnTransaction -> Bool
$c>= :: EarnTransaction -> EarnTransaction -> Bool
>= :: EarnTransaction -> EarnTransaction -> Bool
$cmax :: EarnTransaction -> EarnTransaction -> EarnTransaction
max :: EarnTransaction -> EarnTransaction -> EarnTransaction
$cmin :: EarnTransaction -> EarnTransaction -> EarnTransaction
min :: EarnTransaction -> EarnTransaction -> EarnTransaction
Ord, (forall x. EarnTransaction -> Rep EarnTransaction x)
-> (forall x. Rep EarnTransaction x -> EarnTransaction)
-> Generic EarnTransaction
forall x. Rep EarnTransaction x -> EarnTransaction
forall x. EarnTransaction -> Rep EarnTransaction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EarnTransaction -> Rep EarnTransaction x
from :: forall x. EarnTransaction -> Rep EarnTransaction x
$cto :: forall x. Rep EarnTransaction x -> EarnTransaction
to :: forall x. Rep EarnTransaction x -> EarnTransaction
Generic)

instance FromJSON EarnTransaction where
    parseJSON :: Value -> Parser EarnTransaction
parseJSON = String
-> (KeyMap Value -> Parser EarnTransaction)
-> Value
-> Parser EarnTransaction
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject String
"EarnTransaction" ((KeyMap Value -> Parser EarnTransaction)
 -> Value -> Parser EarnTransaction)
-> (KeyMap Value -> Parser EarnTransaction)
-> Value
-> Parser EarnTransaction
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
o -> do
        Text
etId             <- KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"earnTransactionId"
        Text
etType           <- KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"transactionType"
        Text
etAmountCurrency <- KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"amountCurrency"
        Scientific
etAmount         <- KeyMap Value
o KeyMap Value -> Key -> Parser Scientific
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"amount"
        Maybe Text
etPriceCurrency  <- KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Text)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"priceCurrency"
        Maybe Scientific
etPrice          <- KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Scientific)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"priceAmount"
        POSIXTime
etTimestamp      <- (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
<$> KeyMap Value
o KeyMap Value -> Key -> Parser POSIXTime
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"dateTime"
        EarnTransaction -> Parser EarnTransaction
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return EarnTransaction { Maybe Text
Maybe Scientific
Text
Scientific
POSIXTime
etTimestamp :: POSIXTime
etId :: Text
etType :: Text
etAmountCurrency :: Text
etAmount :: Scientific
etPriceCurrency :: Maybe Text
etPrice :: Maybe Scientific
etId :: Text
etType :: Text
etAmountCurrency :: Text
etAmount :: Scientific
etPriceCurrency :: Maybe Text
etPrice :: Maybe Scientific
etTimestamp :: POSIXTime
.. }


-- UTILS

-- | Run a request that requires authorization against the Gemini API.
protectedGeminiRequest
    :: ( MonadHttp m
       , HttpMethod method
       , HttpBodyAllowed (AllowsBody method) (ProvidesBody NoReqBody)
       , ToJSON body
       , FromJSON response
       , MonadReader GeminiConfig m
       )
    => method
    -> Url scheme
    -> body
    -> m (JsonResponse response)
protectedGeminiRequest :: forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody NoReqBody),
 ToJSON body, FromJSON response, MonadReader GeminiConfig m) =>
method -> Url scheme -> body -> m (JsonResponse response)
protectedGeminiRequest method
method Url scheme
url body
body = do
    GeminiConfig
cfg <- m GeminiConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
    let payload :: ByteString
payload   = Base64 'StdPadded ByteString -> ByteString
forall (k :: Alphabet) a. Base64 k a -> a
extractBase64 (Base64 'StdPadded ByteString -> ByteString)
-> (ByteString -> Base64 'StdPadded ByteString)
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64 'StdPadded ByteString
encodeBase64' (ByteString -> Base64 'StdPadded ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Base64 'StdPadded ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ body -> ByteString
forall a. ToJSON a => a -> ByteString
encode body
body
        signature :: ByteString
signature = GeminiConfig -> ByteString -> ByteString
createSignature GeminiConfig
cfg ByteString
payload
    let authorizedOptions :: Option scheme
authorizedOptions = [Option scheme] -> Option scheme
forall a. Monoid a => [a] -> a
mconcat
            [ ByteString -> ByteString -> Option scheme
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"Content-Type"       ByteString
"text/plain"
            , ByteString -> ByteString -> Option scheme
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"X-GEMINI-APIKEY"    (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ GeminiConfig -> Text
gcApiKey GeminiConfig
cfg)
            , ByteString -> ByteString -> Option scheme
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"X-GEMINI-PAYLOAD"   ByteString
payload
            , ByteString -> ByteString -> Option scheme
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"X-GEMINI-SIGNATURE" ByteString
signature
            , ByteString -> ByteString -> Option scheme
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"Cache-Control"      ByteString
"no-cache"
            , Option scheme
forall (scheme :: Scheme). Option scheme
userAgentHeader
            ]
    method
-> Url scheme
-> NoReqBody
-> Proxy (JsonResponse response)
-> Option scheme
-> m (JsonResponse 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
-> m response
req method
method Url scheme
url NoReqBody
NoReqBody Proxy (JsonResponse response)
forall a. Proxy (JsonResponse a)
jsonResponse Option scheme
forall (scheme :: Scheme). Option scheme
authorizedOptions

-- | Attempt a request & retry if a @429@ @RateLimited@ error is returned.
-- We attempt to parse the retry wait time from the @message@ field but
-- fallback to one second.
retryWithRateLimit :: (MonadHttp m, MonadCatch m) => m a -> m a
retryWithRateLimit :: forall (m :: * -> *) a. (MonadHttp m, MonadCatch m) => m a -> m a
retryWithRateLimit m a
request = m a -> m (Either HttpException a)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try m a
request m (Either HttpException a)
-> (Either HttpException a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    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
429) ByteString
body)))
        -> case ByteString -> Either String GeminiError
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String GeminiError)
-> ByteString -> Either String GeminiError
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.fromStrict ByteString
body of
            Left  String
_ -> HttpException -> m a
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException HttpException
e
            Right GeminiError
r -> if GeminiError -> Text
geReason GeminiError
r Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"RateLimited"
                then
                    let msToWait :: Int
msToWait =
                            Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1000
                                (Maybe Int -> Int) -> (Text -> Maybe Int) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe
                                ([Int] -> Maybe Int) -> (Text -> [Int]) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe Int) -> [Text] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
                                ([Text] -> [Int]) -> (Text -> [Text]) -> Text -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words
                                (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ GeminiError -> Text
geMessage GeminiError
r
                    in  do
                            IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Int -> IO ()) -> Int -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO ()
threadDelay (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int
msToWait Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000
                            m a -> m a
forall (m :: * -> *) a. (MonadHttp m, MonadCatch m) => m a -> m a
retryWithRateLimit m a
request
                else HttpException -> m a
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException HttpException
e
    Left  HttpException
e -> HttpException -> m a
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException HttpException
e
    Right a
r -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

-- | Fetch all pages of a response by calling the API with increasing
-- timestamp fields until it returns an empty response. Takes an optional
-- start & end date to offset the initial fetch & stop fetching early.
fetchAllPages
    :: (Integer -> GeminiApiM [a])
    -- ^ Make a request for items above the given milliseconds @timestamp@
    -> (a -> POSIXTime)
    -- ^ Pull a timestamp from an item
    -> Maybe (UTCTime, UTCTime)
    -- ^ Optional @(start, end)@ range
    -> GeminiApiM [a]
fetchAllPages :: forall a.
(Integer -> GeminiApiM [a])
-> (a -> POSIXTime) -> Maybe (UTCTime, UTCTime) -> GeminiApiM [a]
fetchAllPages Integer -> GeminiApiM [a]
mkRequest a -> POSIXTime
getTimestamp Maybe (UTCTime, UTCTime)
mbRange = do
    let startTimestamp :: Integer
startTimestamp =
            Integer
-> ((UTCTime, UTCTime) -> Integer)
-> Maybe (UTCTime, UTCTime)
-> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 (POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (POSIXTime -> Integer)
-> ((UTCTime, UTCTime) -> POSIXTime)
-> (UTCTime, UTCTime)
-> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POSIXTime
1000 POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
*) (POSIXTime -> POSIXTime)
-> ((UTCTime, UTCTime) -> POSIXTime)
-> (UTCTime, UTCTime)
-> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> POSIXTime)
-> ((UTCTime, UTCTime) -> UTCTime)
-> (UTCTime, UTCTime)
-> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCTime, UTCTime) -> UTCTime
forall a b. (a, b) -> a
fst) Maybe (UTCTime, UTCTime)
mbRange
    [a] -> Integer -> GeminiApiM [a]
fetchAll [] Integer
startTimestamp
  where
    fetchAll :: [a] -> Integer -> GeminiApiM [a]
fetchAll [a]
prevResults Integer
timestamp = do
        [a]
newResults <- GeminiApiM [a] -> GeminiApiM [a]
forall (m :: * -> *) a. (MonadHttp m, MonadCatch m) => m a -> m a
retryWithRateLimit (GeminiApiM [a] -> GeminiApiM [a])
-> GeminiApiM [a] -> GeminiApiM [a]
forall a b. (a -> b) -> a -> b
$ Integer -> GeminiApiM [a]
mkRequest Integer
timestamp
        if [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
newResults
            then [a] -> GeminiApiM [a]
forall a. a -> GeminiApiM a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
prevResults
            else
                let
                    maxTimestamp :: POSIXTime
maxTimestamp  = [POSIXTime] -> POSIXTime
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([POSIXTime] -> POSIXTime) -> [POSIXTime] -> POSIXTime
forall a b. (a -> b) -> a -> b
$ (a -> POSIXTime) -> [a] -> [POSIXTime]
forall a b. (a -> b) -> [a] -> [b]
map a -> POSIXTime
getTimestamp [a]
newResults
                    nextTimestamp :: Integer
nextTimestamp = POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (POSIXTime -> Integer) -> POSIXTime -> Integer
forall a b. (a -> b) -> a -> b
$ POSIXTime
1000 POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
* POSIXTime
maxTimestamp POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ POSIXTime
1
                    continueFetching :: GeminiApiM [a]
continueFetching =
                        [a] -> Integer -> GeminiApiM [a]
fetchAll ([a]
newResults [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
prevResults) Integer
nextTimestamp
                    filteredResults :: POSIXTime -> [a]
filteredResults POSIXTime
end =
                        (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter ((POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
<= POSIXTime
end) (POSIXTime -> Bool) -> (a -> POSIXTime) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> POSIXTime
getTimestamp) [a]
newResults
                in
                    case Maybe (UTCTime, UTCTime)
mbRange of
                        Maybe (UTCTime, UTCTime)
Nothing -> GeminiApiM [a]
continueFetching
                        Just (UTCTime
_, UTCTime -> POSIXTime
utcTimeToPOSIXSeconds -> POSIXTime
end) ->
                            if POSIXTime
maxTimestamp POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
>= POSIXTime
end
                                then [a] -> GeminiApiM [a]
forall a. a -> GeminiApiM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> GeminiApiM [a]) -> [a] -> GeminiApiM [a]
forall a b. (a -> b) -> a -> b
$ POSIXTime -> [a]
filteredResults POSIXTime
end [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
prevResults
                                else GeminiApiM [a]
continueFetching

-- | Given a timestamp in ms, convert it to a timestamp param in seconds by
-- dividing & rounding up.
timestampToSeconds :: Integer -> Integer
timestampToSeconds :: Integer -> Integer
timestampToSeconds = Ratio Integer -> Integer
forall b. Integral b => Ratio Integer -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer -> Integer)
-> (Integer -> Ratio Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
1000)

-- | Generate a 'Crypto.MAC.HMAC.HMAC' 'SHA384' signature for an authorized
-- API request.
createSignature
    :: GeminiConfig
    -- ^ API Credentials
    -> BS.ByteString
    -- ^ Base64-encoded request body.
    -> BS.ByteString
createSignature :: GeminiConfig -> ByteString -> ByteString
createSignature GeminiConfig
cfg ByteString
body =
    let digest :: Digest SHA384
digest =
            forall a. HMAC a -> Digest a
hmacGetDigest @SHA384 (HMAC SHA384 -> Digest SHA384) -> HMAC SHA384 -> Digest SHA384
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> HMAC SHA384
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ GeminiConfig -> Text
gcApiSecret GeminiConfig
cfg) ByteString
body
    in  String -> ByteString
BC.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Digest SHA384 -> String
forall a. Show a => a -> String
show Digest SHA384
digest


-- | Generate a nonce for authorized requests from the current timestamp in
-- milliseconds.
makeNonce :: MonadIO m => m Integer
makeNonce :: forall (m :: * -> *). MonadIO m => m Integer
makeNonce = POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (POSIXTime -> Integer)
-> (POSIXTime -> POSIXTime) -> POSIXTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POSIXTime
1000 POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
*) (POSIXTime -> Integer) -> m POSIXTime -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO POSIXTime -> m POSIXTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime


-- | Generate a @User-Agent@ header with the library's current version.
userAgentHeader :: Option scheme
userAgentHeader :: forall (scheme :: Scheme). Option scheme
userAgentHeader =
    ByteString -> ByteString -> Option scheme
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"User-Agent" (ByteString -> Option scheme)
-> (String -> ByteString) -> String -> Option scheme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BC.pack (String -> Option scheme) -> String -> Option scheme
forall a b. (a -> b) -> a -> b
$ String
"gemini-exports/v" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Version -> String
showVersion Version
version