{-# 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.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
showList :: [GeminiConfig] -> ShowS
$cshowList :: [GeminiConfig] -> ShowS
show :: GeminiConfig -> String
$cshow :: GeminiConfig -> String
showsPrec :: Int -> GeminiConfig -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [GeminiConfig]
$creadListPrec :: ReadPrec [GeminiConfig]
readPrec :: ReadPrec GeminiConfig
$creadPrec :: ReadPrec GeminiConfig
readList :: ReadS [GeminiConfig]
$creadList :: ReadS [GeminiConfig]
readsPrec :: Int -> ReadS GeminiConfig
$creadsPrec :: Int -> ReadS GeminiConfig
Read, GeminiConfig -> GeminiConfig -> Bool
(GeminiConfig -> GeminiConfig -> Bool)
-> (GeminiConfig -> GeminiConfig -> Bool) -> Eq GeminiConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GeminiConfig -> GeminiConfig -> Bool
$c/= :: GeminiConfig -> GeminiConfig -> Bool
== :: GeminiConfig -> GeminiConfig -> Bool
$c== :: 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
min :: GeminiConfig -> GeminiConfig -> GeminiConfig
$cmin :: GeminiConfig -> GeminiConfig -> GeminiConfig
max :: GeminiConfig -> GeminiConfig -> GeminiConfig
$cmax :: GeminiConfig -> GeminiConfig -> GeminiConfig
>= :: GeminiConfig -> GeminiConfig -> Bool
$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
compare :: GeminiConfig -> GeminiConfig -> Ordering
$ccompare :: GeminiConfig -> GeminiConfig -> Ordering
$cp1Ord :: Eq GeminiConfig
Ord)

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

-- | Run a series of API requests with the given Config.
runApi :: GeminiConfig -> GeminiApiM a -> IO a
runApi :: 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 :: 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 (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 (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
showList :: [GeminiError] -> ShowS
$cshowList :: [GeminiError] -> ShowS
show :: GeminiError -> String
$cshow :: GeminiError -> String
showsPrec :: Int -> GeminiError -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [GeminiError]
$creadListPrec :: ReadPrec [GeminiError]
readPrec :: ReadPrec GeminiError
$creadPrec :: ReadPrec GeminiError
readList :: ReadS [GeminiError]
$creadList :: ReadS [GeminiError]
readsPrec :: Int -> ReadS GeminiError
$creadsPrec :: Int -> ReadS GeminiError
Read, GeminiError -> GeminiError -> Bool
(GeminiError -> GeminiError -> Bool)
-> (GeminiError -> GeminiError -> Bool) -> Eq GeminiError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GeminiError -> GeminiError -> Bool
$c/= :: GeminiError -> GeminiError -> Bool
== :: GeminiError -> GeminiError -> Bool
$c== :: 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
min :: GeminiError -> GeminiError -> GeminiError
$cmin :: GeminiError -> GeminiError -> GeminiError
max :: GeminiError -> GeminiError -> GeminiError
$cmax :: GeminiError -> GeminiError -> GeminiError
>= :: GeminiError -> GeminiError -> Bool
$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
compare :: GeminiError -> GeminiError -> Ordering
$ccompare :: GeminiError -> GeminiError -> Ordering
$cp1Ord :: Eq GeminiError
Ord)

instance FromJSON GeminiError where
    parseJSON :: Value -> Parser GeminiError
parseJSON = String
-> (Object -> Parser GeminiError) -> Value -> Parser GeminiError
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GeminiError"
        ((Object -> Parser GeminiError) -> Value -> Parser GeminiError)
-> (Object -> Parser GeminiError) -> Value -> Parser GeminiError
forall a b. (a -> b) -> a -> b
$ \Object
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
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reason" Parser (Text -> GeminiError) -> Parser Text -> Parser GeminiError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"


-- SYMBOL DETAILS

-- | Fetch the details on a supported symbol.
getSymbolDetails :: MonadHttp m => Text -> m SymbolDetails
getSymbolDetails :: Text -> m SymbolDetails
getSymbolDetails Text
symbol =
    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
showList :: [SymbolDetails] -> ShowS
$cshowList :: [SymbolDetails] -> ShowS
show :: SymbolDetails -> String
$cshow :: SymbolDetails -> String
showsPrec :: Int -> SymbolDetails -> ShowS
$cshowsPrec :: Int -> SymbolDetails -> ShowS
Show, ReadPrec [SymbolDetails]
ReadPrec SymbolDetails
Int -> ReadS SymbolDetails
ReadS [SymbolDetails]
(Int -> ReadS SymbolDetails)
-> ReadS [SymbolDetails]
-> ReadPrec SymbolDetails
-> ReadPrec [SymbolDetails]
-> Read SymbolDetails
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SymbolDetails]
$creadListPrec :: ReadPrec [SymbolDetails]
readPrec :: ReadPrec SymbolDetails
$creadPrec :: ReadPrec SymbolDetails
readList :: ReadS [SymbolDetails]
$creadList :: ReadS [SymbolDetails]
readsPrec :: Int -> ReadS SymbolDetails
$creadsPrec :: Int -> ReadS SymbolDetails
Read, SymbolDetails -> SymbolDetails -> Bool
(SymbolDetails -> SymbolDetails -> Bool)
-> (SymbolDetails -> SymbolDetails -> Bool) -> Eq SymbolDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SymbolDetails -> SymbolDetails -> Bool
$c/= :: SymbolDetails -> SymbolDetails -> Bool
== :: SymbolDetails -> SymbolDetails -> Bool
$c== :: SymbolDetails -> SymbolDetails -> Bool
Eq, Eq SymbolDetails
Eq SymbolDetails
-> (SymbolDetails -> SymbolDetails -> Ordering)
-> (SymbolDetails -> SymbolDetails -> Bool)
-> (SymbolDetails -> SymbolDetails -> Bool)
-> (SymbolDetails -> SymbolDetails -> Bool)
-> (SymbolDetails -> SymbolDetails -> Bool)
-> (SymbolDetails -> SymbolDetails -> SymbolDetails)
-> (SymbolDetails -> SymbolDetails -> SymbolDetails)
-> Ord SymbolDetails
SymbolDetails -> SymbolDetails -> Bool
SymbolDetails -> SymbolDetails -> Ordering
SymbolDetails -> SymbolDetails -> SymbolDetails
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SymbolDetails -> SymbolDetails -> SymbolDetails
$cmin :: SymbolDetails -> SymbolDetails -> SymbolDetails
max :: SymbolDetails -> SymbolDetails -> SymbolDetails
$cmax :: SymbolDetails -> SymbolDetails -> SymbolDetails
>= :: SymbolDetails -> SymbolDetails -> Bool
$c>= :: SymbolDetails -> SymbolDetails -> Bool
> :: SymbolDetails -> SymbolDetails -> Bool
$c> :: SymbolDetails -> SymbolDetails -> Bool
<= :: SymbolDetails -> SymbolDetails -> Bool
$c<= :: SymbolDetails -> SymbolDetails -> Bool
< :: SymbolDetails -> SymbolDetails -> Bool
$c< :: SymbolDetails -> SymbolDetails -> Bool
compare :: SymbolDetails -> SymbolDetails -> Ordering
$ccompare :: SymbolDetails -> SymbolDetails -> Ordering
$cp1Ord :: Eq SymbolDetails
Ord, (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
$cto :: forall x. Rep SymbolDetails x -> SymbolDetails
$cfrom :: forall x. SymbolDetails -> Rep SymbolDetails x
Generic)

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


-- 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 :: Object
parameters = [(Key, Value)] -> Object
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]
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 -> Object -> 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")
                    Object
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
showList :: [Trade] -> ShowS
$cshowList :: [Trade] -> ShowS
show :: Trade -> String
$cshow :: Trade -> String
showsPrec :: Int -> Trade -> ShowS
$cshowsPrec :: Int -> Trade -> ShowS
Show, ReadPrec [Trade]
ReadPrec Trade
Int -> ReadS Trade
ReadS [Trade]
(Int -> ReadS Trade)
-> ReadS [Trade]
-> ReadPrec Trade
-> ReadPrec [Trade]
-> Read Trade
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Trade]
$creadListPrec :: ReadPrec [Trade]
readPrec :: ReadPrec Trade
$creadPrec :: ReadPrec Trade
readList :: ReadS [Trade]
$creadList :: ReadS [Trade]
readsPrec :: Int -> ReadS Trade
$creadsPrec :: Int -> ReadS Trade
Read, Trade -> Trade -> Bool
(Trade -> Trade -> Bool) -> (Trade -> Trade -> Bool) -> Eq Trade
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Trade -> Trade -> Bool
$c/= :: Trade -> Trade -> Bool
== :: Trade -> Trade -> Bool
$c== :: Trade -> Trade -> Bool
Eq, Eq Trade
Eq Trade
-> (Trade -> Trade -> Ordering)
-> (Trade -> Trade -> Bool)
-> (Trade -> Trade -> Bool)
-> (Trade -> Trade -> Bool)
-> (Trade -> Trade -> Bool)
-> (Trade -> Trade -> Trade)
-> (Trade -> Trade -> Trade)
-> Ord Trade
Trade -> Trade -> Bool
Trade -> Trade -> Ordering
Trade -> Trade -> Trade
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Trade -> Trade -> Trade
$cmin :: Trade -> Trade -> Trade
max :: Trade -> Trade -> Trade
$cmax :: Trade -> Trade -> Trade
>= :: Trade -> Trade -> Bool
$c>= :: Trade -> Trade -> Bool
> :: Trade -> Trade -> Bool
$c> :: Trade -> Trade -> Bool
<= :: Trade -> Trade -> Bool
$c<= :: Trade -> Trade -> Bool
< :: Trade -> Trade -> Bool
$c< :: Trade -> Trade -> Bool
compare :: Trade -> Trade -> Ordering
$ccompare :: Trade -> Trade -> Ordering
$cp1Ord :: Eq Trade
Ord, (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
$cto :: forall x. Rep Trade x -> Trade
$cfrom :: forall x. Trade -> Rep Trade x
Generic)

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


-- 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 :: Object
parameters = [(Key, Value)] -> Object
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]
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 -> Object -> 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")
                    Object
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
showList :: [Transfer] -> ShowS
$cshowList :: [Transfer] -> ShowS
show :: Transfer -> String
$cshow :: Transfer -> String
showsPrec :: Int -> Transfer -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [Transfer]
$creadListPrec :: ReadPrec [Transfer]
readPrec :: ReadPrec Transfer
$creadPrec :: ReadPrec Transfer
readList :: ReadS [Transfer]
$creadList :: ReadS [Transfer]
readsPrec :: Int -> ReadS Transfer
$creadsPrec :: Int -> ReadS Transfer
Read, Transfer -> Transfer -> Bool
(Transfer -> Transfer -> Bool)
-> (Transfer -> Transfer -> Bool) -> Eq Transfer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Transfer -> Transfer -> Bool
$c/= :: Transfer -> Transfer -> Bool
== :: Transfer -> Transfer -> Bool
$c== :: 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
min :: Transfer -> Transfer -> Transfer
$cmin :: Transfer -> Transfer -> Transfer
max :: Transfer -> Transfer -> Transfer
$cmax :: Transfer -> Transfer -> Transfer
>= :: Transfer -> Transfer -> Bool
$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
compare :: Transfer -> Transfer -> Ordering
$ccompare :: Transfer -> Transfer -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep Transfer x -> Transfer
$cfrom :: forall x. Transfer -> Rep Transfer x
Generic)

instance FromJSON Transfer where
    parseJSON :: Value -> Parser Transfer
parseJSON = String -> (Object -> Parser Transfer) -> Value -> Parser Transfer
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Transfer" ((Object -> Parser Transfer) -> Value -> Parser Transfer)
-> (Object -> Parser Transfer) -> Value -> Parser Transfer
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Integer
trId        <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"eid"
        Text
trType      <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
        Text
trStatus    <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
        Text
trCurrency  <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> 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
<$> Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"amount"
        Maybe Text
trMethod    <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"method"
        Maybe Text
trPurpose   <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> 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
<$> Object
o Object -> Key -> Parser POSIXTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timestampms"
        Transfer -> Parser Transfer
forall (m :: * -> *) a. Monad m => a -> m a
return Transfer :: Integer
-> Text
-> Text
-> Text
-> Scientific
-> Maybe Text
-> Maybe Text
-> POSIXTime
-> Transfer
Transfer { Integer
Maybe Text
Scientific
Text
POSIXTime
trTimestamp :: POSIXTime
trPurpose :: Maybe Text
trMethod :: Maybe Text
trAmount :: Scientific
trCurrency :: Text
trStatus :: Text
trType :: Text
trId :: Integer
trPurpose :: Maybe Text
trMethod :: Maybe Text
trAmount :: Scientific
trCurrency :: Text
trStatus :: Text
trType :: Text
trId :: Integer
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 :: Object
parameters = [(Key, Value)] -> Object
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)
                ]
        (EarnHistory -> [EarnTransaction])
-> [EarnHistory] -> [EarnTransaction]
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]
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 -> Object -> 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")
                    Object
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
-> (Object -> Parser EarnHistory) -> Value -> Parser EarnHistory
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"EarnHistory"
        ((Object -> Parser EarnHistory) -> Value -> Parser EarnHistory)
-> (Object -> Parser EarnHistory) -> Value -> Parser EarnHistory
forall a b. (a -> b) -> a -> b
$ \Object
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
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"providerId" Parser ([EarnTransaction] -> EarnHistory)
-> Parser [EarnTransaction] -> Parser EarnHistory
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [EarnTransaction]
forall a. FromJSON a => Object -> 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
showList :: [EarnTransaction] -> ShowS
$cshowList :: [EarnTransaction] -> ShowS
show :: EarnTransaction -> String
$cshow :: EarnTransaction -> String
showsPrec :: Int -> EarnTransaction -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [EarnTransaction]
$creadListPrec :: ReadPrec [EarnTransaction]
readPrec :: ReadPrec EarnTransaction
$creadPrec :: ReadPrec EarnTransaction
readList :: ReadS [EarnTransaction]
$creadList :: ReadS [EarnTransaction]
readsPrec :: Int -> ReadS EarnTransaction
$creadsPrec :: Int -> ReadS EarnTransaction
Read, EarnTransaction -> EarnTransaction -> Bool
(EarnTransaction -> EarnTransaction -> Bool)
-> (EarnTransaction -> EarnTransaction -> Bool)
-> Eq EarnTransaction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EarnTransaction -> EarnTransaction -> Bool
$c/= :: EarnTransaction -> EarnTransaction -> Bool
== :: EarnTransaction -> EarnTransaction -> Bool
$c== :: 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
min :: EarnTransaction -> EarnTransaction -> EarnTransaction
$cmin :: EarnTransaction -> EarnTransaction -> EarnTransaction
max :: EarnTransaction -> EarnTransaction -> EarnTransaction
$cmax :: EarnTransaction -> EarnTransaction -> EarnTransaction
>= :: EarnTransaction -> EarnTransaction -> Bool
$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
compare :: EarnTransaction -> EarnTransaction -> Ordering
$ccompare :: EarnTransaction -> EarnTransaction -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep EarnTransaction x -> EarnTransaction
$cfrom :: forall x. EarnTransaction -> Rep EarnTransaction x
Generic)

instance FromJSON EarnTransaction where
    parseJSON :: Value -> Parser EarnTransaction
parseJSON = String
-> (Object -> Parser EarnTransaction)
-> Value
-> Parser EarnTransaction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"EarnTransaction" ((Object -> Parser EarnTransaction)
 -> Value -> Parser EarnTransaction)
-> (Object -> Parser EarnTransaction)
-> Value
-> Parser EarnTransaction
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
etId             <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"earnTransactionId"
        Text
etType           <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"transactionType"
        Text
etAmountCurrency <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"amountCurrency"
        Scientific
etAmount         <- Object
o Object -> Key -> Parser Scientific
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"amount"
        Maybe Text
etPriceCurrency  <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"priceCurrency"
        Maybe Scientific
etPrice          <- Object
o Object -> Key -> Parser (Maybe Scientific)
forall a. FromJSON a => Object -> 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
<$> Object
o Object -> Key -> Parser POSIXTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"dateTime"
        EarnTransaction -> Parser EarnTransaction
forall (m :: * -> *) a. Monad m => a -> m a
return EarnTransaction :: Text
-> Text
-> Text
-> Scientific
-> Maybe Text
-> Maybe Scientific
-> POSIXTime
-> EarnTransaction
EarnTransaction { Maybe Scientific
Maybe Text
Scientific
Text
POSIXTime
etTimestamp :: POSIXTime
etPrice :: Maybe Scientific
etPriceCurrency :: Maybe Text
etAmount :: Scientific
etAmountCurrency :: Text
etType :: Text
etId :: Text
etPrice :: Maybe Scientific
etPriceCurrency :: Maybe Text
etAmount :: Scientific
etAmountCurrency :: Text
etType :: Text
etId :: Text
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 :: 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   = Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> (ByteString -> Text) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeBase64 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
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 :: m a -> m a
retryWithRateLimit m a
request = m a -> m (Either HttpException a)
forall (m :: * -> *) e a.
(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 (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 (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 (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 (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException HttpException
e
    Left  HttpException
e -> HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException HttpException
e
    Right a
r -> 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 :: (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 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 (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
newResults
            then [a] -> GeminiApiM [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
prevResults
            else
                let
                    maxTimestamp :: POSIXTime
maxTimestamp  = [POSIXTime] -> POSIXTime
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 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 (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 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 =
            HMAC SHA384 -> Digest SHA384
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 :: m Integer
makeNonce = POSIXTime -> Integer
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 (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 :: 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