{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Console.SolanaStaking.Api
(
Config (..)
, mkConfig
, APIResponse (..)
, APIError (..)
, runApi
, raiseAPIError
, getAccountStakes
, StakingAccounts (..)
, StakingAccount (..)
, getAllStakeRewards
, getYearsStakeRewards
, getStakeRewards
, StakeReward (..)
, getBlock
, Block (..)
, Lamports (..)
, renderLamports
, scientificLamports
, StakingPubKey (..)
) where
import Control.Concurrent (threadDelay)
import Control.Exception (throwIO)
import Control.Monad ((>=>))
import Control.Monad.Catch (MonadCatch, try)
import Control.Monad.Except (MonadError (throwError), runExceptT)
import Control.Monad.Reader (MonadIO, MonadReader, asks, liftIO)
import Data.Aeson
( FromJSON (parseJSON)
, Value (Object)
, eitherDecode
, withObject
, (.:)
, (.:?)
)
import Data.Bifunctor (second)
import Data.Scientific (FPFormat (Fixed), Scientific, formatScientific)
import Data.Text.Encoding (encodeUtf8)
import Data.Time (toGregorian, utctDay)
import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime)
import GHC.Generics (Generic)
import Network.HTTP.Client
( HttpException (..)
, HttpExceptionContent (..)
, responseStatus
)
import Network.HTTP.Req
( GET (GET)
, HttpException (..)
, HttpResponse
, HttpResponseBody
, NoReqBody (NoReqBody)
, Option
, Scheme (Https)
, Url
, defaultHttpConfig
, header
, https
, jsonResponse
, queryParam
, renderUrl
, req
, responseBody
, runReq
, (/:)
, (/~)
)
import Network.HTTP.Types (statusCode)
import System.IO (hPutStrLn, stderr)
import Text.Read (readMaybe)
import Data.ByteString.Lazy qualified as LBS
import Data.Text qualified as T
data Config = Config
{ Config -> Text
cApiKey :: T.Text
, Config -> Text
cAccountPubKey :: T.Text
}
deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Config -> ShowS
showsPrec :: Int -> Config -> ShowS
$cshow :: Config -> String
show :: Config -> String
$cshowList :: [Config] -> ShowS
showList :: [Config] -> ShowS
Show, ReadPrec [Config]
ReadPrec Config
Int -> ReadS Config
ReadS [Config]
(Int -> ReadS Config)
-> ReadS [Config]
-> ReadPrec Config
-> ReadPrec [Config]
-> Read Config
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Config
readsPrec :: Int -> ReadS Config
$creadList :: ReadS [Config]
readList :: ReadS [Config]
$creadPrec :: ReadPrec Config
readPrec :: ReadPrec Config
$creadListPrec :: ReadPrec [Config]
readListPrec :: ReadPrec [Config]
Read, Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
/= :: Config -> Config -> Bool
Eq)
mkConfig :: String -> String -> Config
mkConfig :: String -> String -> Config
mkConfig (String -> Text
T.pack -> Text
cApiKey) (String -> Text
T.pack -> Text
cAccountPubKey) = Config {Text
cApiKey :: Text
cAccountPubKey :: Text
cApiKey :: Text
cAccountPubKey :: Text
..}
baseUrl :: Url 'Https
baseUrl :: Url 'Https
baseUrl = Text -> Url 'Https
https Text
"api.solanabeach.io" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"v1"
getAccountStakes
:: (MonadReader Config m, MonadCatch m, MonadIO m)
=> m (APIResponse StakingAccounts)
getAccountStakes :: forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
m (APIResponse StakingAccounts)
getAccountStakes = do
Text
pubkey <- (Config -> Text) -> m Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Text
cAccountPubKey
Url 'Https -> Option 'Https -> m (APIResponse StakingAccounts)
forall (m :: * -> *) a.
(MonadReader Config m, FromJSON a, MonadIO m, MonadCatch m) =>
Url 'Https -> Option 'Https -> m (APIResponse a)
getReq (Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"account" Url 'Https -> Text -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ Text
pubkey Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"stakes") Option 'Https
forall a. Monoid a => a
mempty
data StakingAccounts = StakingAccounts
{ StakingAccounts -> [StakingAccount]
saResults :: [StakingAccount]
, StakingAccounts -> Integer
saTotalPages :: Integer
}
deriving (Int -> StakingAccounts -> ShowS
[StakingAccounts] -> ShowS
StakingAccounts -> String
(Int -> StakingAccounts -> ShowS)
-> (StakingAccounts -> String)
-> ([StakingAccounts] -> ShowS)
-> Show StakingAccounts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StakingAccounts -> ShowS
showsPrec :: Int -> StakingAccounts -> ShowS
$cshow :: StakingAccounts -> String
show :: StakingAccounts -> String
$cshowList :: [StakingAccounts] -> ShowS
showList :: [StakingAccounts] -> ShowS
Show, ReadPrec [StakingAccounts]
ReadPrec StakingAccounts
Int -> ReadS StakingAccounts
ReadS [StakingAccounts]
(Int -> ReadS StakingAccounts)
-> ReadS [StakingAccounts]
-> ReadPrec StakingAccounts
-> ReadPrec [StakingAccounts]
-> Read StakingAccounts
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StakingAccounts
readsPrec :: Int -> ReadS StakingAccounts
$creadList :: ReadS [StakingAccounts]
readList :: ReadS [StakingAccounts]
$creadPrec :: ReadPrec StakingAccounts
readPrec :: ReadPrec StakingAccounts
$creadListPrec :: ReadPrec [StakingAccounts]
readListPrec :: ReadPrec [StakingAccounts]
Read, StakingAccounts -> StakingAccounts -> Bool
(StakingAccounts -> StakingAccounts -> Bool)
-> (StakingAccounts -> StakingAccounts -> Bool)
-> Eq StakingAccounts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakingAccounts -> StakingAccounts -> Bool
== :: StakingAccounts -> StakingAccounts -> Bool
$c/= :: StakingAccounts -> StakingAccounts -> Bool
/= :: StakingAccounts -> StakingAccounts -> Bool
Eq, (forall x. StakingAccounts -> Rep StakingAccounts x)
-> (forall x. Rep StakingAccounts x -> StakingAccounts)
-> Generic StakingAccounts
forall x. Rep StakingAccounts x -> StakingAccounts
forall x. StakingAccounts -> Rep StakingAccounts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StakingAccounts -> Rep StakingAccounts x
from :: forall x. StakingAccounts -> Rep StakingAccounts x
$cto :: forall x. Rep StakingAccounts x -> StakingAccounts
to :: forall x. Rep StakingAccounts x -> StakingAccounts
Generic)
instance FromJSON StakingAccounts where
parseJSON :: Value -> Parser StakingAccounts
parseJSON = String
-> (Object -> Parser StakingAccounts)
-> Value
-> Parser StakingAccounts
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"StakingAccounts" ((Object -> Parser StakingAccounts)
-> Value -> Parser StakingAccounts)
-> (Object -> Parser StakingAccounts)
-> Value
-> Parser StakingAccounts
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
[StakingAccount]
saResults <- Object
o Object -> Key -> Parser [StakingAccount]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
Integer
saTotalPages <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"totalPages"
StakingAccounts -> Parser StakingAccounts
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return StakingAccounts {Integer
[StakingAccount]
saResults :: [StakingAccount]
saTotalPages :: Integer
saResults :: [StakingAccount]
saTotalPages :: Integer
..}
data StakingAccount = StakingAccount
{ StakingAccount -> StakingPubKey
saPubKey :: StakingPubKey
, StakingAccount -> Lamports
saLamports :: Lamports
, StakingAccount -> Text
saValidatorName :: T.Text
}
deriving (Int -> StakingAccount -> ShowS
[StakingAccount] -> ShowS
StakingAccount -> String
(Int -> StakingAccount -> ShowS)
-> (StakingAccount -> String)
-> ([StakingAccount] -> ShowS)
-> Show StakingAccount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StakingAccount -> ShowS
showsPrec :: Int -> StakingAccount -> ShowS
$cshow :: StakingAccount -> String
show :: StakingAccount -> String
$cshowList :: [StakingAccount] -> ShowS
showList :: [StakingAccount] -> ShowS
Show, ReadPrec [StakingAccount]
ReadPrec StakingAccount
Int -> ReadS StakingAccount
ReadS [StakingAccount]
(Int -> ReadS StakingAccount)
-> ReadS [StakingAccount]
-> ReadPrec StakingAccount
-> ReadPrec [StakingAccount]
-> Read StakingAccount
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StakingAccount
readsPrec :: Int -> ReadS StakingAccount
$creadList :: ReadS [StakingAccount]
readList :: ReadS [StakingAccount]
$creadPrec :: ReadPrec StakingAccount
readPrec :: ReadPrec StakingAccount
$creadListPrec :: ReadPrec [StakingAccount]
readListPrec :: ReadPrec [StakingAccount]
Read, StakingAccount -> StakingAccount -> Bool
(StakingAccount -> StakingAccount -> Bool)
-> (StakingAccount -> StakingAccount -> Bool) -> Eq StakingAccount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakingAccount -> StakingAccount -> Bool
== :: StakingAccount -> StakingAccount -> Bool
$c/= :: StakingAccount -> StakingAccount -> Bool
/= :: StakingAccount -> StakingAccount -> Bool
Eq, (forall x. StakingAccount -> Rep StakingAccount x)
-> (forall x. Rep StakingAccount x -> StakingAccount)
-> Generic StakingAccount
forall x. Rep StakingAccount x -> StakingAccount
forall x. StakingAccount -> Rep StakingAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StakingAccount -> Rep StakingAccount x
from :: forall x. StakingAccount -> Rep StakingAccount x
$cto :: forall x. Rep StakingAccount x -> StakingAccount
to :: forall x. Rep StakingAccount x -> StakingAccount
Generic)
instance FromJSON StakingAccount where
parseJSON :: Value -> Parser StakingAccount
parseJSON = String
-> (Object -> Parser StakingAccount)
-> Value
-> Parser StakingAccount
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"StakingAccount" ((Object -> Parser StakingAccount)
-> Value -> Parser StakingAccount)
-> (Object -> Parser StakingAccount)
-> Value
-> Parser StakingAccount
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
StakingPubKey
saPubKey <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pubkey" Parser Object
-> (Object -> Parser StakingPubKey) -> Parser StakingPubKey
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser StakingPubKey
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address")
Lamports
saLamports <- Object
o Object -> Key -> Parser Lamports
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lamports"
Text
saValidatorName <-
Object
o
Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
Parser Object -> (Object -> Parser Object) -> Parser Object
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stake")
Parser Object -> (Object -> Parser Object) -> Parser Object
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"delegation")
Parser Object -> (Object -> Parser Object) -> Parser Object
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"validatorInfo")
Parser Object -> (Object -> Parser Text) -> Parser Text
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name")
StakingAccount -> Parser StakingAccount
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return StakingAccount {Text
Lamports
StakingPubKey
saPubKey :: StakingPubKey
saLamports :: Lamports
saValidatorName :: Text
saPubKey :: StakingPubKey
saLamports :: Lamports
saValidatorName :: Text
..}
newtype StakingPubKey = StakingPubKey {StakingPubKey -> Text
fromStakingPubKey :: T.Text}
deriving (Int -> StakingPubKey -> ShowS
[StakingPubKey] -> ShowS
StakingPubKey -> String
(Int -> StakingPubKey -> ShowS)
-> (StakingPubKey -> String)
-> ([StakingPubKey] -> ShowS)
-> Show StakingPubKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StakingPubKey -> ShowS
showsPrec :: Int -> StakingPubKey -> ShowS
$cshow :: StakingPubKey -> String
show :: StakingPubKey -> String
$cshowList :: [StakingPubKey] -> ShowS
showList :: [StakingPubKey] -> ShowS
Show, ReadPrec [StakingPubKey]
ReadPrec StakingPubKey
Int -> ReadS StakingPubKey
ReadS [StakingPubKey]
(Int -> ReadS StakingPubKey)
-> ReadS [StakingPubKey]
-> ReadPrec StakingPubKey
-> ReadPrec [StakingPubKey]
-> Read StakingPubKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StakingPubKey
readsPrec :: Int -> ReadS StakingPubKey
$creadList :: ReadS [StakingPubKey]
readList :: ReadS [StakingPubKey]
$creadPrec :: ReadPrec StakingPubKey
readPrec :: ReadPrec StakingPubKey
$creadListPrec :: ReadPrec [StakingPubKey]
readListPrec :: ReadPrec [StakingPubKey]
Read, StakingPubKey -> StakingPubKey -> Bool
(StakingPubKey -> StakingPubKey -> Bool)
-> (StakingPubKey -> StakingPubKey -> Bool) -> Eq StakingPubKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakingPubKey -> StakingPubKey -> Bool
== :: StakingPubKey -> StakingPubKey -> Bool
$c/= :: StakingPubKey -> StakingPubKey -> Bool
/= :: StakingPubKey -> StakingPubKey -> Bool
Eq, (forall x. StakingPubKey -> Rep StakingPubKey x)
-> (forall x. Rep StakingPubKey x -> StakingPubKey)
-> Generic StakingPubKey
forall x. Rep StakingPubKey x -> StakingPubKey
forall x. StakingPubKey -> Rep StakingPubKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StakingPubKey -> Rep StakingPubKey x
from :: forall x. StakingPubKey -> Rep StakingPubKey x
$cto :: forall x. Rep StakingPubKey x -> StakingPubKey
to :: forall x. Rep StakingPubKey x -> StakingPubKey
Generic, Maybe StakingPubKey
Value -> Parser [StakingPubKey]
Value -> Parser StakingPubKey
(Value -> Parser StakingPubKey)
-> (Value -> Parser [StakingPubKey])
-> Maybe StakingPubKey
-> FromJSON StakingPubKey
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser StakingPubKey
parseJSON :: Value -> Parser StakingPubKey
$cparseJSONList :: Value -> Parser [StakingPubKey]
parseJSONList :: Value -> Parser [StakingPubKey]
$comittedField :: Maybe StakingPubKey
omittedField :: Maybe StakingPubKey
FromJSON)
newtype Lamports = Lamports {Lamports -> Integer
fromLamports :: Integer}
deriving (Int -> Lamports -> ShowS
[Lamports] -> ShowS
Lamports -> String
(Int -> Lamports -> ShowS)
-> (Lamports -> String) -> ([Lamports] -> ShowS) -> Show Lamports
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lamports -> ShowS
showsPrec :: Int -> Lamports -> ShowS
$cshow :: Lamports -> String
show :: Lamports -> String
$cshowList :: [Lamports] -> ShowS
showList :: [Lamports] -> ShowS
Show, ReadPrec [Lamports]
ReadPrec Lamports
Int -> ReadS Lamports
ReadS [Lamports]
(Int -> ReadS Lamports)
-> ReadS [Lamports]
-> ReadPrec Lamports
-> ReadPrec [Lamports]
-> Read Lamports
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Lamports
readsPrec :: Int -> ReadS Lamports
$creadList :: ReadS [Lamports]
readList :: ReadS [Lamports]
$creadPrec :: ReadPrec Lamports
readPrec :: ReadPrec Lamports
$creadListPrec :: ReadPrec [Lamports]
readListPrec :: ReadPrec [Lamports]
Read, Lamports -> Lamports -> Bool
(Lamports -> Lamports -> Bool)
-> (Lamports -> Lamports -> Bool) -> Eq Lamports
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lamports -> Lamports -> Bool
== :: Lamports -> Lamports -> Bool
$c/= :: Lamports -> Lamports -> Bool
/= :: Lamports -> Lamports -> Bool
Eq, Integer -> Lamports
Lamports -> Lamports
Lamports -> Lamports -> Lamports
(Lamports -> Lamports -> Lamports)
-> (Lamports -> Lamports -> Lamports)
-> (Lamports -> Lamports -> Lamports)
-> (Lamports -> Lamports)
-> (Lamports -> Lamports)
-> (Lamports -> Lamports)
-> (Integer -> Lamports)
-> Num Lamports
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Lamports -> Lamports -> Lamports
+ :: Lamports -> Lamports -> Lamports
$c- :: Lamports -> Lamports -> Lamports
- :: Lamports -> Lamports -> Lamports
$c* :: Lamports -> Lamports -> Lamports
* :: Lamports -> Lamports -> Lamports
$cnegate :: Lamports -> Lamports
negate :: Lamports -> Lamports
$cabs :: Lamports -> Lamports
abs :: Lamports -> Lamports
$csignum :: Lamports -> Lamports
signum :: Lamports -> Lamports
$cfromInteger :: Integer -> Lamports
fromInteger :: Integer -> Lamports
Num, (forall x. Lamports -> Rep Lamports x)
-> (forall x. Rep Lamports x -> Lamports) -> Generic Lamports
forall x. Rep Lamports x -> Lamports
forall x. Lamports -> Rep Lamports x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Lamports -> Rep Lamports x
from :: forall x. Lamports -> Rep Lamports x
$cto :: forall x. Rep Lamports x -> Lamports
to :: forall x. Rep Lamports x -> Lamports
Generic, Maybe Lamports
Value -> Parser [Lamports]
Value -> Parser Lamports
(Value -> Parser Lamports)
-> (Value -> Parser [Lamports])
-> Maybe Lamports
-> FromJSON Lamports
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Lamports
parseJSON :: Value -> Parser Lamports
$cparseJSONList :: Value -> Parser [Lamports]
parseJSONList :: Value -> Parser [Lamports]
$comittedField :: Maybe Lamports
omittedField :: Maybe Lamports
FromJSON)
renderLamports :: Lamports -> T.Text
renderLamports :: Lamports -> Text
renderLamports = String -> Text
T.pack (String -> Text) -> (Lamports -> String) -> Lamports -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Fixed (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
9) (Scientific -> String)
-> (Lamports -> Scientific) -> Lamports -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lamports -> Scientific
scientificLamports
scientificLamports :: Lamports -> Scientific
scientificLamports :: Lamports -> Scientific
scientificLamports = (Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
* Scientific
0.000000001) (Scientific -> Scientific)
-> (Lamports -> Scientific) -> Lamports -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger (Integer -> Scientific)
-> (Lamports -> Integer) -> Lamports -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lamports -> Integer
fromLamports
getStakeRewards
:: (MonadReader Config m, MonadCatch m, MonadIO m)
=> StakingPubKey
-> Maybe Integer
-> m (APIResponse [StakeReward])
getStakeRewards :: forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey -> Maybe Integer -> m (APIResponse [StakeReward])
getStakeRewards (StakingPubKey Text
stakeAccountPubkey) Maybe Integer
mbEpochCursor = do
Url 'Https -> Option 'Https -> m (APIResponse [StakeReward])
forall (m :: * -> *) a.
(MonadReader Config m, FromJSON a, MonadIO m, MonadCatch m) =>
Url 'Https -> Option 'Https -> m (APIResponse a)
getReq
(Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"account" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
stakeAccountPubkey Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"stake-rewards")
(Text -> Maybe Integer -> Option 'Https
forall a. ToHttpApiData a => Text -> Maybe a -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> Maybe a -> param
queryParam Text
"cursor" Maybe Integer
mbEpochCursor)
getAllStakeRewards
:: (MonadReader Config m, MonadCatch m, MonadIO m)
=> StakingPubKey
-> m ([APIError], [StakeReward])
getAllStakeRewards :: forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey -> m ([APIError], [StakeReward])
getAllStakeRewards StakingPubKey
pubkey =
StakingPubKey -> Maybe Integer -> m (APIResponse [StakeReward])
forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey -> Maybe Integer -> m (APIResponse [StakeReward])
getStakeRewards StakingPubKey
pubkey Maybe Integer
forall a. Maybe a
Nothing
m (APIResponse [StakeReward])
-> (APIResponse [StakeReward] -> m (Either APIError [StakeReward]))
-> m (Either APIError [StakeReward])
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= APIResponse [StakeReward] -> m (Either APIError [StakeReward])
forall (m :: * -> *) a.
Monad m =>
APIResponse a -> m (Either APIError a)
runApi
m (Either APIError [StakeReward])
-> (Either APIError [StakeReward] -> m ([APIError], [StakeReward]))
-> m ([APIError], [StakeReward])
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StakingPubKey
-> ([StakeReward] -> Bool)
-> ([APIError], [StakeReward])
-> Either APIError [StakeReward]
-> m ([APIError], [StakeReward])
forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey
-> ([StakeReward] -> Bool)
-> ([APIError], [StakeReward])
-> Either APIError [StakeReward]
-> m ([APIError], [StakeReward])
getStakeRewardsUntil
StakingPubKey
pubkey
(Bool -> [StakeReward] -> Bool
forall a b. a -> b -> a
const Bool
True)
([], [])
getYearsStakeRewards
:: (MonadReader Config m, MonadCatch m, MonadIO m)
=> StakingPubKey
-> Integer
-> m ([APIError], [StakeReward])
StakingPubKey
pubkey Integer
year =
(([APIError], [StakeReward]) -> ([APIError], [StakeReward]))
-> m ([APIError], [StakeReward]) -> m ([APIError], [StakeReward])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([StakeReward] -> [StakeReward])
-> ([APIError], [StakeReward]) -> ([APIError], [StakeReward])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (([StakeReward] -> [StakeReward])
-> ([APIError], [StakeReward]) -> ([APIError], [StakeReward]))
-> ([StakeReward] -> [StakeReward])
-> ([APIError], [StakeReward])
-> ([APIError], [StakeReward])
forall a b. (a -> b) -> a -> b
$ (StakeReward -> Bool) -> [StakeReward] -> [StakeReward]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
year) (Integer -> Bool)
-> (StakeReward -> Integer) -> StakeReward -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeReward -> Integer
rewardYear)) (m ([APIError], [StakeReward]) -> m ([APIError], [StakeReward]))
-> m ([APIError], [StakeReward]) -> m ([APIError], [StakeReward])
forall a b. (a -> b) -> a -> b
$
StakingPubKey -> Maybe Integer -> m (APIResponse [StakeReward])
forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey -> Maybe Integer -> m (APIResponse [StakeReward])
getStakeRewards StakingPubKey
pubkey Maybe Integer
forall a. Maybe a
Nothing
m (APIResponse [StakeReward])
-> (APIResponse [StakeReward] -> m (Either APIError [StakeReward]))
-> m (Either APIError [StakeReward])
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= APIResponse [StakeReward] -> m (Either APIError [StakeReward])
forall (m :: * -> *) a.
Monad m =>
APIResponse a -> m (Either APIError a)
runApi
m (Either APIError [StakeReward])
-> (Either APIError [StakeReward] -> m ([APIError], [StakeReward]))
-> m ([APIError], [StakeReward])
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StakingPubKey
-> ([StakeReward] -> Bool)
-> ([APIError], [StakeReward])
-> Either APIError [StakeReward]
-> m ([APIError], [StakeReward])
forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey
-> ([StakeReward] -> Bool)
-> ([APIError], [StakeReward])
-> Either APIError [StakeReward]
-> m ([APIError], [StakeReward])
getStakeRewardsUntil StakingPubKey
pubkey [StakeReward] -> Bool
stopAfterYear ([], [])
where
rewardYear :: StakeReward -> Integer
rewardYear :: StakeReward -> Integer
rewardYear =
(\(Integer
y, Int
_, Int
_) -> Integer
y)
((Integer, Int, Int) -> Integer)
-> (StakeReward -> (Integer, Int, Int)) -> StakeReward -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, Int, Int)
toGregorian
(Day -> (Integer, Int, Int))
-> (StakeReward -> Day) -> StakeReward -> (Integer, Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Day
utctDay
(UTCTime -> Day) -> (StakeReward -> UTCTime) -> StakeReward -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime
(POSIXTime -> UTCTime)
-> (StakeReward -> POSIXTime) -> StakeReward -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeReward -> POSIXTime
srTimestamp
stopAfterYear :: [StakeReward] -> Bool
stopAfterYear :: [StakeReward] -> Bool
stopAfterYear [StakeReward]
rewards =
let years :: [Integer]
years = (StakeReward -> Integer) -> [StakeReward] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map StakeReward -> Integer
rewardYear [StakeReward]
rewards in (Integer -> Bool) -> [Integer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
year) [Integer]
years
getStakeRewardsUntil
:: (MonadReader Config m, MonadCatch m, MonadIO m)
=> StakingPubKey
-> ([StakeReward] -> Bool)
-> ([APIError], [StakeReward])
-> Either APIError [StakeReward]
-> m ([APIError], [StakeReward])
getStakeRewardsUntil :: forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey
-> ([StakeReward] -> Bool)
-> ([APIError], [StakeReward])
-> Either APIError [StakeReward]
-> m ([APIError], [StakeReward])
getStakeRewardsUntil StakingPubKey
pubkey [StakeReward] -> Bool
cond ([APIError]
errs, [StakeReward]
rws) = \case
Left APIError
err -> ([APIError], [StakeReward]) -> m ([APIError], [StakeReward])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (APIError
err APIError -> [APIError] -> [APIError]
forall a. a -> [a] -> [a]
: [APIError]
errs, [StakeReward]
rws)
Right [StakeReward]
rewards ->
if [StakeReward] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [StakeReward]
rewards Bool -> Bool -> Bool
|| [StakeReward] -> Bool
cond [StakeReward]
rewards
then ([APIError], [StakeReward]) -> m ([APIError], [StakeReward])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([APIError]
errs, [StakeReward]
rewards [StakeReward] -> [StakeReward] -> [StakeReward]
forall a. Semigroup a => a -> a -> a
<> [StakeReward]
rws)
else
let minEpoch :: Integer
minEpoch = [Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (StakeReward -> Integer) -> [StakeReward] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map StakeReward -> Integer
srEpoch [StakeReward]
rewards
in StakingPubKey -> Maybe Integer -> m (APIResponse [StakeReward])
forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey -> Maybe Integer -> m (APIResponse [StakeReward])
getStakeRewards StakingPubKey
pubkey (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
minEpoch)
m (APIResponse [StakeReward])
-> (APIResponse [StakeReward] -> m (Either APIError [StakeReward]))
-> m (Either APIError [StakeReward])
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= APIResponse [StakeReward] -> m (Either APIError [StakeReward])
forall (m :: * -> *) a.
Monad m =>
APIResponse a -> m (Either APIError a)
runApi
m (Either APIError [StakeReward])
-> (Either APIError [StakeReward] -> m ([APIError], [StakeReward]))
-> m ([APIError], [StakeReward])
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StakingPubKey
-> ([StakeReward] -> Bool)
-> ([APIError], [StakeReward])
-> Either APIError [StakeReward]
-> m ([APIError], [StakeReward])
forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey
-> ([StakeReward] -> Bool)
-> ([APIError], [StakeReward])
-> Either APIError [StakeReward]
-> m ([APIError], [StakeReward])
getStakeRewardsUntil StakingPubKey
pubkey [StakeReward] -> Bool
cond ([APIError]
errs, [StakeReward]
rewards [StakeReward] -> [StakeReward] -> [StakeReward]
forall a. Semigroup a => a -> a -> a
<> [StakeReward]
rws)
data StakeReward = StakeReward
{ StakeReward -> Integer
srEpoch :: Integer
, StakeReward -> Integer
srSlot :: Integer
, StakeReward -> Lamports
srAmount :: Lamports
, StakeReward -> POSIXTime
srTimestamp :: POSIXTime
}
deriving (Int -> StakeReward -> ShowS
[StakeReward] -> ShowS
StakeReward -> String
(Int -> StakeReward -> ShowS)
-> (StakeReward -> String)
-> ([StakeReward] -> ShowS)
-> Show StakeReward
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StakeReward -> ShowS
showsPrec :: Int -> StakeReward -> ShowS
$cshow :: StakeReward -> String
show :: StakeReward -> String
$cshowList :: [StakeReward] -> ShowS
showList :: [StakeReward] -> ShowS
Show, ReadPrec [StakeReward]
ReadPrec StakeReward
Int -> ReadS StakeReward
ReadS [StakeReward]
(Int -> ReadS StakeReward)
-> ReadS [StakeReward]
-> ReadPrec StakeReward
-> ReadPrec [StakeReward]
-> Read StakeReward
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StakeReward
readsPrec :: Int -> ReadS StakeReward
$creadList :: ReadS [StakeReward]
readList :: ReadS [StakeReward]
$creadPrec :: ReadPrec StakeReward
readPrec :: ReadPrec StakeReward
$creadListPrec :: ReadPrec [StakeReward]
readListPrec :: ReadPrec [StakeReward]
Read, StakeReward -> StakeReward -> Bool
(StakeReward -> StakeReward -> Bool)
-> (StakeReward -> StakeReward -> Bool) -> Eq StakeReward
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakeReward -> StakeReward -> Bool
== :: StakeReward -> StakeReward -> Bool
$c/= :: StakeReward -> StakeReward -> Bool
/= :: StakeReward -> StakeReward -> Bool
Eq, (forall x. StakeReward -> Rep StakeReward x)
-> (forall x. Rep StakeReward x -> StakeReward)
-> Generic StakeReward
forall x. Rep StakeReward x -> StakeReward
forall x. StakeReward -> Rep StakeReward x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StakeReward -> Rep StakeReward x
from :: forall x. StakeReward -> Rep StakeReward x
$cto :: forall x. Rep StakeReward x -> StakeReward
to :: forall x. Rep StakeReward x -> StakeReward
Generic)
instance FromJSON StakeReward where
parseJSON :: Value -> Parser StakeReward
parseJSON = String
-> (Object -> Parser StakeReward) -> Value -> Parser StakeReward
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"StakeReward" ((Object -> Parser StakeReward) -> Value -> Parser StakeReward)
-> (Object -> Parser StakeReward) -> Value -> Parser StakeReward
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Integer
srEpoch <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"epoch"
Integer
srSlot <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"effectiveSlot"
Lamports
srAmount <- Object
o Object -> Key -> Parser Lamports
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"amount"
POSIXTime
srTimestamp <- Object
o Object -> Key -> Parser POSIXTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timestamp"
StakeReward -> Parser StakeReward
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return StakeReward {Integer
POSIXTime
Lamports
srTimestamp :: POSIXTime
srEpoch :: Integer
srSlot :: Integer
srAmount :: Lamports
srEpoch :: Integer
srSlot :: Integer
srAmount :: Lamports
srTimestamp :: POSIXTime
..}
getBlock
:: (MonadReader Config m, MonadCatch m, MonadIO m)
=> Integer
-> m (APIResponse Block)
getBlock :: forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
Integer -> m (APIResponse Block)
getBlock Integer
blockNum = do
Url 'Https -> Option 'Https -> m (APIResponse Block)
forall (m :: * -> *) a.
(MonadReader Config m, FromJSON a, MonadIO m, MonadCatch m) =>
Url 'Https -> Option 'Https -> m (APIResponse a)
getReq (Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"block" Url 'Https -> Integer -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ Integer
blockNum) Option 'Https
forall a. Monoid a => a
mempty
data Block = Block
{ Block -> Integer
bNumber :: Integer
, Block -> POSIXTime
bBlockTime :: POSIXTime
}
deriving (Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Block -> ShowS
showsPrec :: Int -> Block -> ShowS
$cshow :: Block -> String
show :: Block -> String
$cshowList :: [Block] -> ShowS
showList :: [Block] -> ShowS
Show, ReadPrec [Block]
ReadPrec Block
Int -> ReadS Block
ReadS [Block]
(Int -> ReadS Block)
-> ReadS [Block]
-> ReadPrec Block
-> ReadPrec [Block]
-> Read Block
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Block
readsPrec :: Int -> ReadS Block
$creadList :: ReadS [Block]
readList :: ReadS [Block]
$creadPrec :: ReadPrec Block
readPrec :: ReadPrec Block
$creadListPrec :: ReadPrec [Block]
readListPrec :: ReadPrec [Block]
Read, Block -> Block -> Bool
(Block -> Block -> Bool) -> (Block -> Block -> Bool) -> Eq Block
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
/= :: Block -> Block -> Bool
Eq, (forall x. Block -> Rep Block x)
-> (forall x. Rep Block x -> Block) -> Generic Block
forall x. Rep Block x -> Block
forall x. Block -> Rep Block x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Block -> Rep Block x
from :: forall x. Block -> Rep Block x
$cto :: forall x. Rep Block x -> Block
to :: forall x. Rep Block x -> Block
Generic)
instance FromJSON Block where
parseJSON :: Value -> Parser Block
parseJSON = String -> (Object -> Parser Block) -> Value -> Parser Block
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Block" ((Object -> Parser Block) -> Value -> Parser Block)
-> (Object -> Parser Block) -> Value -> Parser Block
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Integer
bNumber <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"blocknumber"
POSIXTime
bBlockTime <-
(Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"blocktime")
Parser Object -> (Object -> Parser POSIXTime) -> Parser POSIXTime
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Scientific -> POSIXTime) -> Parser Scientific -> Parser POSIXTime
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> POSIXTime
forall a. Num a => Integer -> a
fromInteger (Integer -> POSIXTime)
-> (Scientific -> Integer) -> Scientific -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (RealFrac a, Integral b) => a -> b
truncate @Scientific))
(Parser Scientific -> Parser POSIXTime)
-> (Object -> Parser Scientific) -> Object -> Parser POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Key -> Parser Scientific
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"absolute")
Block -> Parser Block
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Block {Integer
POSIXTime
bNumber :: Integer
bBlockTime :: POSIXTime
bNumber :: Integer
bBlockTime :: POSIXTime
..}
getReq
:: forall m a
. (MonadReader Config m, FromJSON a, MonadIO m, MonadCatch m)
=> Url 'Https
-> Option 'Https
-> m (APIResponse a)
getReq :: forall (m :: * -> *) a.
(MonadReader Config m, FromJSON a, MonadIO m, MonadCatch m) =>
Url 'Https -> Option 'Https -> m (APIResponse a)
getReq Url 'Https
endpoint Option 'Https
options = Integer -> m (APIResponse a)
fetchWithRetries Integer
0
where
maxRetries :: Integer
maxRetries :: Integer
maxRetries = Integer
5
fetchWithRetries :: Integer -> m (APIResponse a)
fetchWithRetries :: Integer -> m (APIResponse a)
fetchWithRetries Integer
retryCount =
if Integer
retryCount Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
maxRetries
then APIResponse a -> m (APIResponse a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (APIResponse a -> m (APIResponse a))
-> APIResponse a -> m (APIResponse a)
forall a b. (a -> b) -> a -> b
$ APIError -> APIResponse a
forall a. APIError -> APIResponse a
ErrorResponse (APIError -> APIResponse a) -> APIError -> APIResponse a
forall a b. (a -> b) -> a -> b
$ Text -> APIError
RetriesExceeded (Text -> APIError) -> Text -> APIError
forall a b. (a -> b) -> a -> b
$ Url 'Https -> Text
forall (scheme :: Scheme). Url scheme -> Text
renderUrl Url 'Https
endpoint
else do
Text
apikey <- (Config -> Text) -> m Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Text
cApiKey
let authHeader :: Option scheme
authHeader =
ByteString -> ByteString -> Option scheme
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"Authorization" (ByteString -> Option scheme) -> ByteString -> Option scheme
forall a b. (a -> b) -> a -> b
$ ByteString
"Bearer: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 Text
apikey
APIResponse a
respBody <-
m (JsonResponse (APIResponse a))
-> m (HttpResponseBody (JsonResponse (APIResponse a)))
forall b.
(FromJSON (HttpResponseBody b), HttpResponse b) =>
m b -> m (HttpResponseBody b)
catchRateLimitError (m (JsonResponse (APIResponse a))
-> m (HttpResponseBody (JsonResponse (APIResponse a))))
-> m (JsonResponse (APIResponse a))
-> m (HttpResponseBody (JsonResponse (APIResponse a)))
forall a b. (a -> b) -> a -> b
$
HttpConfig
-> Req (JsonResponse (APIResponse a))
-> m (JsonResponse (APIResponse a))
forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq
HttpConfig
defaultHttpConfig
( GET
-> Url 'Https
-> NoReqBody
-> Proxy (JsonResponse (APIResponse a))
-> Option 'Https
-> Req (JsonResponse (APIResponse a))
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 Url 'Https
endpoint NoReqBody
NoReqBody Proxy (JsonResponse (APIResponse a))
forall a. Proxy (JsonResponse a)
jsonResponse (Option 'Https -> Req (JsonResponse (APIResponse a)))
-> Option 'Https -> Req (JsonResponse (APIResponse a))
forall a b. (a -> b) -> a -> b
$ Option 'Https
forall {scheme :: Scheme}. Option scheme
authHeader Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> Option 'Https
options
)
case APIResponse a
respBody of
APIResponse a
ProcessingResponse -> do
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
Handle -> String -> IO ()
hPutStrLn
Handle
stderr
String
"Waiting for API to finish processing request..."
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000
Integer -> m (APIResponse a)
fetchWithRetries (Integer
retryCount Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
RateLimitResponse Int
wait -> do
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"Exceeded rate limit, waiting "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
wait
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" seconds before retrying..."
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
wait Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000
Integer -> m (APIResponse a)
fetchWithRetries Integer
retryCount
APIResponse a
_ -> APIResponse a -> m (APIResponse a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return APIResponse a
respBody
catchRateLimitError
:: (FromJSON (HttpResponseBody b))
=> (HttpResponse b)
=> m b
-> m (HttpResponseBody b)
catchRateLimitError :: forall b.
(FromJSON (HttpResponseBody b), HttpResponse b) =>
m b -> m (HttpResponseBody b)
catchRateLimitError =
m b -> m (Either HttpException b)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (m b -> m (Either HttpException b))
-> (Either HttpException b -> m (HttpResponseBody b))
-> m b
-> m (HttpResponseBody b)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
Left e :: HttpException
e@(VanillaHttpException (HttpExceptionRequest Request
_ (StatusCodeException Response ()
resp ByteString
body))) ->
if Status -> Int
statusCode (Response () -> Status
forall body. Response body -> Status
responseStatus Response ()
resp) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
429
then
(String -> m (HttpResponseBody b))
-> (HttpResponseBody b -> m (HttpResponseBody b))
-> Either String (HttpResponseBody b)
-> m (HttpResponseBody b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IO (HttpResponseBody b) -> m (HttpResponseBody b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HttpResponseBody b) -> m (HttpResponseBody b))
-> (String -> IO (HttpResponseBody b))
-> String
-> m (HttpResponseBody b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> IO (HttpResponseBody b)
forall e a. Exception e => e -> IO a
throwIO (HttpException -> IO (HttpResponseBody b))
-> (String -> HttpException) -> String -> IO (HttpResponseBody b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HttpException
JsonHttpException) HttpResponseBody b -> m (HttpResponseBody b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (HttpResponseBody b) -> m (HttpResponseBody b))
-> Either String (HttpResponseBody b) -> m (HttpResponseBody b)
forall a b. (a -> b) -> a -> b
$
ByteString -> Either String (HttpResponseBody b)
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String (HttpResponseBody b))
-> ByteString -> Either String (HttpResponseBody b)
forall a b. (a -> b) -> a -> b
$
ByteString -> ByteString
LBS.fromStrict ByteString
body
else IO (HttpResponseBody b) -> m (HttpResponseBody b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HttpResponseBody b) -> m (HttpResponseBody b))
-> IO (HttpResponseBody b) -> m (HttpResponseBody b)
forall a b. (a -> b) -> a -> b
$ HttpException -> IO (HttpResponseBody b)
forall e a. Exception e => e -> IO a
throwIO HttpException
e
Left HttpException
e -> IO (HttpResponseBody b) -> m (HttpResponseBody b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HttpResponseBody b) -> m (HttpResponseBody b))
-> IO (HttpResponseBody b) -> m (HttpResponseBody b)
forall a b. (a -> b) -> a -> b
$ HttpException -> IO (HttpResponseBody b)
forall e a. Exception e => e -> IO a
throwIO HttpException
e
Right b
r -> HttpResponseBody b -> m (HttpResponseBody b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpResponseBody b -> m (HttpResponseBody b))
-> HttpResponseBody b -> m (HttpResponseBody b)
forall a b. (a -> b) -> a -> b
$ b -> HttpResponseBody b
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody b
r
data APIResponse a
= SuccessfulReponse a
| ProcessingResponse
| RateLimitResponse Int
| ErrorResponse APIError
deriving (Int -> APIResponse a -> ShowS
[APIResponse a] -> ShowS
APIResponse a -> String
(Int -> APIResponse a -> ShowS)
-> (APIResponse a -> String)
-> ([APIResponse a] -> ShowS)
-> Show (APIResponse a)
forall a. Show a => Int -> APIResponse a -> ShowS
forall a. Show a => [APIResponse a] -> ShowS
forall a. Show a => APIResponse a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> APIResponse a -> ShowS
showsPrec :: Int -> APIResponse a -> ShowS
$cshow :: forall a. Show a => APIResponse a -> String
show :: APIResponse a -> String
$cshowList :: forall a. Show a => [APIResponse a] -> ShowS
showList :: [APIResponse a] -> ShowS
Show, ReadPrec [APIResponse a]
ReadPrec (APIResponse a)
Int -> ReadS (APIResponse a)
ReadS [APIResponse a]
(Int -> ReadS (APIResponse a))
-> ReadS [APIResponse a]
-> ReadPrec (APIResponse a)
-> ReadPrec [APIResponse a]
-> Read (APIResponse a)
forall a. Read a => ReadPrec [APIResponse a]
forall a. Read a => ReadPrec (APIResponse a)
forall a. Read a => Int -> ReadS (APIResponse a)
forall a. Read a => ReadS [APIResponse a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (APIResponse a)
readsPrec :: Int -> ReadS (APIResponse a)
$creadList :: forall a. Read a => ReadS [APIResponse a]
readList :: ReadS [APIResponse a]
$creadPrec :: forall a. Read a => ReadPrec (APIResponse a)
readPrec :: ReadPrec (APIResponse a)
$creadListPrec :: forall a. Read a => ReadPrec [APIResponse a]
readListPrec :: ReadPrec [APIResponse a]
Read, APIResponse a -> APIResponse a -> Bool
(APIResponse a -> APIResponse a -> Bool)
-> (APIResponse a -> APIResponse a -> Bool) -> Eq (APIResponse a)
forall a. Eq a => APIResponse a -> APIResponse a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => APIResponse a -> APIResponse a -> Bool
== :: APIResponse a -> APIResponse a -> Bool
$c/= :: forall a. Eq a => APIResponse a -> APIResponse a -> Bool
/= :: APIResponse a -> APIResponse a -> Bool
Eq)
instance (FromJSON a) => FromJSON (APIResponse a) where
parseJSON :: Value -> Parser (APIResponse a)
parseJSON Value
v = case Value
v of
Object Object
o -> do
Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"err" Parser (Maybe Text)
-> (Maybe Text -> Parser (APIResponse a)) -> Parser (APIResponse a)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just Text
errMsg ->
Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"processing" Parser (Maybe Bool)
-> (Maybe Bool -> Parser (APIResponse a)) -> Parser (APIResponse a)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Bool
Nothing ->
Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"retry" Parser (Maybe String)
-> (Maybe String -> Parser (APIResponse a))
-> Parser (APIResponse a)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe -> Just Int
i) ->
APIResponse a -> Parser (APIResponse a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (APIResponse a -> Parser (APIResponse a))
-> APIResponse a -> Parser (APIResponse a)
forall a b. (a -> b) -> a -> b
$ Int -> APIResponse a
forall a. Int -> APIResponse a
RateLimitResponse Int
i
Maybe String
_ -> APIResponse a -> Parser (APIResponse a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (APIResponse a -> Parser (APIResponse a))
-> APIResponse a -> Parser (APIResponse a)
forall a b. (a -> b) -> a -> b
$ APIError -> APIResponse a
forall a. APIError -> APIResponse a
ErrorResponse (APIError -> APIResponse a) -> APIError -> APIResponse a
forall a b. (a -> b) -> a -> b
$ Text -> APIError
APIError Text
errMsg
Just (Bool
_ :: Bool) -> APIResponse a -> Parser (APIResponse a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return APIResponse a
forall a. APIResponse a
ProcessingResponse
Maybe Text
Nothing -> (a -> APIResponse a) -> Parser a -> Parser (APIResponse a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> APIResponse a
forall a. a -> APIResponse a
SuccessfulReponse (Parser a -> Parser (APIResponse a))
-> (Value -> Parser a) -> Value -> Parser (APIResponse a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser (APIResponse a))
-> Value -> Parser (APIResponse a)
forall a b. (a -> b) -> a -> b
$ Object -> Value
Object Object
o
Value
_ -> a -> APIResponse a
forall a. a -> APIResponse a
SuccessfulReponse (a -> APIResponse a) -> Parser a -> Parser (APIResponse a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
runApi :: (Monad m) => APIResponse a -> m (Either APIError a)
runApi :: forall (m :: * -> *) a.
Monad m =>
APIResponse a -> m (Either APIError a)
runApi = ExceptT APIError m a -> m (Either APIError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT APIError m a -> m (Either APIError a))
-> (APIResponse a -> ExceptT APIError m a)
-> APIResponse a
-> m (Either APIError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APIResponse a -> ExceptT APIError m a
forall (m :: * -> *) a.
MonadError APIError m =>
APIResponse a -> m a
raiseAPIError
raiseAPIError :: (MonadError APIError m) => APIResponse a -> m a
raiseAPIError :: forall (m :: * -> *) a.
MonadError APIError m =>
APIResponse a -> m a
raiseAPIError = \case
SuccessfulReponse a
v -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
APIResponse a
ProcessingResponse ->
APIError -> m a
forall a. APIError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (APIError -> m a) -> APIError -> m a
forall a b. (a -> b) -> a -> b
$ Text -> APIError
APIError Text
"Request cancelled during processing wait."
RateLimitResponse Int
i -> APIError -> m a
forall a. APIError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (APIError -> m a) -> APIError -> m a
forall a b. (a -> b) -> a -> b
$ Int -> APIError
RateLimitError Int
i
ErrorResponse APIError
err -> APIError -> m a
forall a. APIError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError APIError
err
data APIError
=
APIError T.Text
|
RetriesExceeded T.Text
|
RateLimitError Int
deriving (Int -> APIError -> ShowS
[APIError] -> ShowS
APIError -> String
(Int -> APIError -> ShowS)
-> (APIError -> String) -> ([APIError] -> ShowS) -> Show APIError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> APIError -> ShowS
showsPrec :: Int -> APIError -> ShowS
$cshow :: APIError -> String
show :: APIError -> String
$cshowList :: [APIError] -> ShowS
showList :: [APIError] -> ShowS
Show, ReadPrec [APIError]
ReadPrec APIError
Int -> ReadS APIError
ReadS [APIError]
(Int -> ReadS APIError)
-> ReadS [APIError]
-> ReadPrec APIError
-> ReadPrec [APIError]
-> Read APIError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS APIError
readsPrec :: Int -> ReadS APIError
$creadList :: ReadS [APIError]
readList :: ReadS [APIError]
$creadPrec :: ReadPrec APIError
readPrec :: ReadPrec APIError
$creadListPrec :: ReadPrec [APIError]
readListPrec :: ReadPrec [APIError]
Read, APIError -> APIError -> Bool
(APIError -> APIError -> Bool)
-> (APIError -> APIError -> Bool) -> Eq APIError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: APIError -> APIError -> Bool
== :: APIError -> APIError -> Bool
$c/= :: APIError -> APIError -> Bool
/= :: APIError -> APIError -> Bool
Eq, (forall x. APIError -> Rep APIError x)
-> (forall x. Rep APIError x -> APIError) -> Generic APIError
forall x. Rep APIError x -> APIError
forall x. APIError -> Rep APIError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. APIError -> Rep APIError x
from :: forall x. APIError -> Rep APIError x
$cto :: forall x. Rep APIError x -> APIError
to :: forall x. Rep APIError x -> APIError
Generic)