-- | Epoch queries

module Blockfrost.Client.Cardano.Epochs
  ( getLatestEpoch
  , getLatestEpochProtocolParams
  , getEpoch
  , getNextEpochs
  , getNextEpochs'
  , getPreviousEpochs
  , getPreviousEpochs'
  , getEpochStake
  , getEpochStake'
  , getEpochStakeByPool
  , getEpochStakeByPool'
  , getEpochBlocks
  , getEpochBlocks'
  , getEpochBlocksByPool
  , getEpochBlocksByPool'
  , getEpochProtocolParams
  ) where

import Blockfrost.API
import Blockfrost.Client.Types
import Blockfrost.Types


epochsClient :: MonadBlockfrost m => Project -> EpochsAPI (AsClientT m)
epochsClient :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> EpochsAPI (AsClientT m)
epochsClient = forall (routes :: * -> *) mode.
GenericServant routes mode =>
ToServant routes mode -> routes mode
fromServant forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall route.
CardanoAPI route
-> route
   :- ("epochs"
       :> (Tag "Cardano \187 Epochs" :> ToServantApi EpochsAPI))
_epochs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockfrost m =>
Project -> CardanoAPI (AsClientT m)
cardanoClient

getLatestEpoch_ :: MonadBlockfrost m => Project -> m EpochInfo
getLatestEpoch_ :: forall (m :: * -> *). MonadBlockfrost m => Project -> m EpochInfo
getLatestEpoch_ = forall route.
EpochsAPI route
-> route
   :- (Summary "Latest epoch"
       :> (Description
             "Return the information about the latest, therefore current, epoch."
           :> ("latest" :> Get '[JSON] EpochInfo)))
_latestEpoch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockfrost m =>
Project -> EpochsAPI (AsClientT m)
epochsClient

-- | Get the information about the latest, therefore current, epoch.
getLatestEpoch :: MonadBlockfrost m => m EpochInfo
getLatestEpoch :: forall (m :: * -> *). MonadBlockfrost m => m EpochInfo
getLatestEpoch = forall (m :: * -> *) a.
MonadBlockfrost m =>
(Project -> m a) -> m a
go forall (m :: * -> *). MonadBlockfrost m => Project -> m EpochInfo
getLatestEpoch_

getLatestEpochProtocolParams_ :: MonadBlockfrost m => Project -> m ProtocolParams
getLatestEpochProtocolParams_ :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> m ProtocolParams
getLatestEpochProtocolParams_ = forall route.
EpochsAPI route
-> route
   :- (Summary "Latest epoch protocol parameters"
       :> (Description
             "Return the protocol parameters for the latest epoch."
           :> ("latest" :> ("parameters" :> Get '[JSON] ProtocolParams))))
_latestEpochProtocolParams forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockfrost m =>
Project -> EpochsAPI (AsClientT m)
epochsClient

-- | Get the protocol parameters for the latest epoch.
getLatestEpochProtocolParams :: MonadBlockfrost m => m ProtocolParams
getLatestEpochProtocolParams :: forall (m :: * -> *). MonadBlockfrost m => m ProtocolParams
getLatestEpochProtocolParams = forall (m :: * -> *) a.
MonadBlockfrost m =>
(Project -> m a) -> m a
go forall (m :: * -> *).
MonadBlockfrost m =>
Project -> m ProtocolParams
getLatestEpochProtocolParams_

getEpoch_ :: MonadBlockfrost m => Project -> Epoch -> m EpochInfo
getEpoch_ :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> Epoch -> m EpochInfo
getEpoch_ = forall route.
EpochsAPI route
-> route
   :- (Summary "Specific epoch"
       :> (Description "Return the content of the requested epoch."
           :> (Capture "epoch_number" Epoch :> Get '[JSON] EpochInfo)))
_getEpoch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockfrost m =>
Project -> EpochsAPI (AsClientT m)
epochsClient

-- | Get the information about specific epoch.
getEpoch :: MonadBlockfrost m => Epoch -> m EpochInfo
getEpoch :: forall (m :: * -> *). MonadBlockfrost m => Epoch -> m EpochInfo
getEpoch Epoch
e = forall (m :: * -> *) a.
MonadBlockfrost m =>
(Project -> m a) -> m a
go (forall (m :: * -> *).
MonadBlockfrost m =>
Project -> Epoch -> m EpochInfo
`getEpoch_` Epoch
e)

getNextEpochs_ :: MonadBlockfrost m => Project -> Epoch -> Paged -> m [EpochInfo]
getNextEpochs_ :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> Epoch -> Paged -> m [EpochInfo]
getNextEpochs_ = forall route.
EpochsAPI route
-> route
   :- (Summary "List of next epochs"
       :> (Description
             "Return the list of epochs following a specific epoch."
           :> (Capture "epoch_number" Epoch
               :> ("next" :> (Pagination :> Get '[JSON] [EpochInfo])))))
_getNextEpochs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockfrost m =>
Project -> EpochsAPI (AsClientT m)
epochsClient

-- | Return the list of epochs following a specific epoch.
-- Allows custom paging using 'Paged'.
getNextEpochs' :: MonadBlockfrost m => Epoch -> Paged -> m [EpochInfo]
getNextEpochs' :: forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> Paged -> m [EpochInfo]
getNextEpochs' Epoch
e Paged
pg = forall (m :: * -> *) a.
MonadBlockfrost m =>
(Project -> m a) -> m a
go (\Project
p -> forall (m :: * -> *).
MonadBlockfrost m =>
Project -> Epoch -> Paged -> m [EpochInfo]
getNextEpochs_ Project
p Epoch
e Paged
pg)

-- | Return the list of epochs following a specific epoch.
--
-- Queries 100 entries. To query all entries use 'Blockfrost.Client.Core.allPages'
-- with principled variant of this function (suffixed with @'@)
-- that accepts 'Paged' argument.
getNextEpochs :: MonadBlockfrost m => Epoch -> m [EpochInfo]
getNextEpochs :: forall (m :: * -> *). MonadBlockfrost m => Epoch -> m [EpochInfo]
getNextEpochs Epoch
e = forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> Paged -> m [EpochInfo]
getNextEpochs' Epoch
e forall a. Default a => a
def

getPreviousEpochs_ :: MonadBlockfrost m => Project -> Epoch -> Paged -> m [EpochInfo]
getPreviousEpochs_ :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> Epoch -> Paged -> m [EpochInfo]
getPreviousEpochs_ = forall route.
EpochsAPI route
-> route
   :- (Summary "List of previous epochs"
       :> (Description
             "Return the list of epochs preceding a specific epoch."
           :> (Capture "epoch_number" Epoch
               :> ("previous" :> (Pagination :> Get '[JSON] [EpochInfo])))))
_getPreviousEpochs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockfrost m =>
Project -> EpochsAPI (AsClientT m)
epochsClient

-- | Return the list of epochs preceding a specific epoch.
-- Allows custom paging using 'Paged'.
getPreviousEpochs' :: MonadBlockfrost m => Epoch -> Paged -> m [EpochInfo]
getPreviousEpochs' :: forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> Paged -> m [EpochInfo]
getPreviousEpochs' Epoch
e Paged
pg = forall (m :: * -> *) a.
MonadBlockfrost m =>
(Project -> m a) -> m a
go (\Project
p -> forall (m :: * -> *).
MonadBlockfrost m =>
Project -> Epoch -> Paged -> m [EpochInfo]
getPreviousEpochs_ Project
p Epoch
e Paged
pg)

-- | Return the list of epochs preceding a specific epoch.
--
-- Queries 100 entries. To query all entries use 'Blockfrost.Client.Core.allPages'
-- with principled variant of this function (suffixed with @'@)
-- that accepts 'Paged' argument.
getPreviousEpochs :: MonadBlockfrost m => Epoch -> m [EpochInfo]
getPreviousEpochs :: forall (m :: * -> *). MonadBlockfrost m => Epoch -> m [EpochInfo]
getPreviousEpochs Epoch
e = forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> Paged -> m [EpochInfo]
getPreviousEpochs' Epoch
e forall a. Default a => a
def

getEpochStake_ :: MonadBlockfrost m => Project -> Epoch -> Paged -> m [StakeDistribution]
getEpochStake_ :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> Epoch -> Paged -> m [StakeDistribution]
getEpochStake_ = forall route.
EpochsAPI route
-> route
   :- (Summary "Stake distribution"
       :> (Description
             "Return the active stake distribution for the specified epoch."
           :> (Capture "epoch_number" Epoch
               :> ("stakes" :> (Pagination :> Get '[JSON] [StakeDistribution])))))
_getEpochStake forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockfrost m =>
Project -> EpochsAPI (AsClientT m)
epochsClient

-- | Return the active stake distribution for the specified epoch.
-- Allows custom paging using 'Paged'.
getEpochStake' :: MonadBlockfrost m => Epoch -> Paged -> m [StakeDistribution]
getEpochStake' :: forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> Paged -> m [StakeDistribution]
getEpochStake' Epoch
e Paged
pg = forall (m :: * -> *) a.
MonadBlockfrost m =>
(Project -> m a) -> m a
go (\Project
p -> forall (m :: * -> *).
MonadBlockfrost m =>
Project -> Epoch -> Paged -> m [StakeDistribution]
getEpochStake_ Project
p Epoch
e Paged
pg)

-- | Return the active stake distribution for the specified epoch.
--
-- Queries 100 entries. To query all entries use 'Blockfrost.Client.Core.allPages'
-- with principled variant of this function (suffixed with @'@)
-- that accepts 'Paged' argument.
getEpochStake :: MonadBlockfrost m => Epoch -> m [StakeDistribution]
getEpochStake :: forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> m [StakeDistribution]
getEpochStake Epoch
e = forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> Paged -> m [StakeDistribution]
getEpochStake' Epoch
e forall a. Default a => a
def

getEpochStakeByPool_ :: MonadBlockfrost m => Project -> Epoch -> PoolId -> Paged -> m [PoolStakeDistribution]
getEpochStakeByPool_ :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> Epoch -> PoolId -> Paged -> m [PoolStakeDistribution]
getEpochStakeByPool_ = forall route.
EpochsAPI route
-> route
   :- (Summary "Stake distribution by pool"
       :> (Description
             "Return the active stake distribution for the epoch specified by stake pool."
           :> (Capture "epoch_number" Epoch
               :> ("stakes"
                   :> (Capture "pool_id" PoolId
                       :> (Pagination :> Get '[JSON] [PoolStakeDistribution]))))))
_getEpochStakeByPool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockfrost m =>
Project -> EpochsAPI (AsClientT m)
epochsClient

-- | Return the active stake distribution for the epoch specified by stake pool.
-- Allows custom paging using 'Paged'.
getEpochStakeByPool' :: MonadBlockfrost m => Epoch -> PoolId -> Paged -> m [PoolStakeDistribution]
getEpochStakeByPool' :: forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> PoolId -> Paged -> m [PoolStakeDistribution]
getEpochStakeByPool' Epoch
e PoolId
i Paged
pg = forall (m :: * -> *) a.
MonadBlockfrost m =>
(Project -> m a) -> m a
go (\Project
p -> forall (m :: * -> *).
MonadBlockfrost m =>
Project -> Epoch -> PoolId -> Paged -> m [PoolStakeDistribution]
getEpochStakeByPool_ Project
p Epoch
e PoolId
i Paged
pg)

-- | Return the active stake distribution for the epoch specified by stake pool.
--
-- Queries 100 entries. To query all entries use 'Blockfrost.Client.Core.allPages'
-- with principled variant of this function (suffixed with @'@)
-- that accepts 'Paged' argument.
getEpochStakeByPool :: MonadBlockfrost m => Epoch -> PoolId -> m [PoolStakeDistribution]
getEpochStakeByPool :: forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> PoolId -> m [PoolStakeDistribution]
getEpochStakeByPool Epoch
e PoolId
i = forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> PoolId -> Paged -> m [PoolStakeDistribution]
getEpochStakeByPool' Epoch
e PoolId
i forall a. Default a => a
def

getEpochBlocks_ :: MonadBlockfrost m => Project -> Epoch -> Paged -> SortOrder -> m [BlockHash]
getEpochBlocks_ :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> Epoch -> Paged -> SortOrder -> m [BlockHash]
getEpochBlocks_ = forall route.
EpochsAPI route
-> route
   :- (Summary "Block distribution"
       :> (Description "Return the blocks minted for the epoch specified."
           :> (Capture "epoch_number" Epoch
               :> ("blocks"
                   :> (Pagination :> (Sorting :> Get '[JSON] [BlockHash]))))))
_getEpochBlocks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockfrost m =>
Project -> EpochsAPI (AsClientT m)
epochsClient

-- | Return the blocks minted for the specified epoch.
-- Allows custom paging and ordering using 'Paged' and 'SortOrder'.
getEpochBlocks' :: MonadBlockfrost m => Epoch -> Paged -> SortOrder -> m [BlockHash]
getEpochBlocks' :: forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> Paged -> SortOrder -> m [BlockHash]
getEpochBlocks' Epoch
e Paged
pg SortOrder
s = forall (m :: * -> *) a.
MonadBlockfrost m =>
(Project -> m a) -> m a
go (\Project
p -> forall (m :: * -> *).
MonadBlockfrost m =>
Project -> Epoch -> Paged -> SortOrder -> m [BlockHash]
getEpochBlocks_ Project
p Epoch
e Paged
pg SortOrder
s)

-- | Return the blocks minted for the specified epoch.
--
-- Queries 100 entries. To query all entries use 'Blockfrost.Client.Core.allPages'
-- with principled variant of this function (suffixed with @'@)
-- that accepts 'Paged' argument.
getEpochBlocks :: MonadBlockfrost m => Epoch -> m [BlockHash]
getEpochBlocks :: forall (m :: * -> *). MonadBlockfrost m => Epoch -> m [BlockHash]
getEpochBlocks Epoch
e = forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> Paged -> SortOrder -> m [BlockHash]
getEpochBlocks' Epoch
e forall a. Default a => a
def forall a. Default a => a
def

getEpochBlocksByPool_ :: MonadBlockfrost m => Project -> Epoch -> PoolId -> Paged -> SortOrder -> m [BlockHash]
getEpochBlocksByPool_ :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> Epoch -> PoolId -> Paged -> SortOrder -> m [BlockHash]
getEpochBlocksByPool_ = forall route.
EpochsAPI route
-> route
   :- (Summary "Block distribution by pool"
       :> (Description
             "Return the block minted for the epoch specified by stake pool."
           :> (Capture "epoch_number" Epoch
               :> ("blocks"
                   :> (Capture "pool_id" PoolId
                       :> (Pagination :> (Sorting :> Get '[JSON] [BlockHash])))))))
_getEpochBlocksByPool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockfrost m =>
Project -> EpochsAPI (AsClientT m)
epochsClient

-- | Return the block minted for the epoch specified by stake pool.
-- Allows custom paging and ordering using 'Paged' and 'SortOrder'.
getEpochBlocksByPool' :: MonadBlockfrost m => Epoch -> PoolId -> Paged -> SortOrder -> m [BlockHash]
getEpochBlocksByPool' :: forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> PoolId -> Paged -> SortOrder -> m [BlockHash]
getEpochBlocksByPool' Epoch
e PoolId
i Paged
pg SortOrder
s = forall (m :: * -> *) a.
MonadBlockfrost m =>
(Project -> m a) -> m a
go (\Project
p -> forall (m :: * -> *).
MonadBlockfrost m =>
Project -> Epoch -> PoolId -> Paged -> SortOrder -> m [BlockHash]
getEpochBlocksByPool_ Project
p Epoch
e PoolId
i Paged
pg SortOrder
s)

-- | Return the block minted for the epoch specified by stake pool.
--
-- Queries 100 entries. To query all entries use 'Blockfrost.Client.Core.allPages'
-- with principled variant of this function (suffixed with @'@)
-- that accepts 'Paged' argument.
getEpochBlocksByPool :: MonadBlockfrost m => Epoch -> PoolId -> m [BlockHash]
getEpochBlocksByPool :: forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> PoolId -> m [BlockHash]
getEpochBlocksByPool Epoch
e PoolId
i = forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> PoolId -> Paged -> SortOrder -> m [BlockHash]
getEpochBlocksByPool' Epoch
e PoolId
i forall a. Default a => a
def forall a. Default a => a
def

getEpochProtocolParams_ :: MonadBlockfrost m => Project -> Epoch -> m ProtocolParams
getEpochProtocolParams_ :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> Epoch -> m ProtocolParams
getEpochProtocolParams_ = forall route.
EpochsAPI route
-> route
   :- (Summary "Protocol parameters"
       :> (Description
             "Return the protocol parameters for the specified epoch."
           :> (Capture "epoch_number" Epoch
               :> ("parameters" :> Get '[JSON] ProtocolParams))))
_getEpochProtocolParams forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockfrost m =>
Project -> EpochsAPI (AsClientT m)
epochsClient

-- | Return the protocol parameters for the specified epoch.
getEpochProtocolParams :: MonadBlockfrost m => Epoch -> m ProtocolParams
getEpochProtocolParams :: forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> m ProtocolParams
getEpochProtocolParams Epoch
e = forall (m :: * -> *) a.
MonadBlockfrost m =>
(Project -> m a) -> m a
go (forall (m :: * -> *).
MonadBlockfrost m =>
Project -> Epoch -> m ProtocolParams
`getEpochProtocolParams_` Epoch
e)