-- | Ledger queries

module Blockfrost.Client.Cardano.Ledger
  ( getLedgerGenesis
  ) where

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

ledgerClient :: MonadBlockfrost m => Project -> LedgerAPI (AsClientT m)
ledgerClient :: Project -> LedgerAPI (AsClientT m)
ledgerClient = m Genesis -> LedgerAPI (AsClientT m)
forall (routes :: * -> *) mode.
GenericServant routes mode =>
ToServant routes mode -> routes mode
fromServant (m Genesis -> LedgerAPI (AsClientT m))
-> (Project -> m Genesis) -> Project -> LedgerAPI (AsClientT m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoAPI (AsClientT m) -> m Genesis
forall route.
CardanoAPI route
-> route
   :- ("genesis"
       :> (Tag "Cardano \187 Ledger" :> ToServantApi LedgerAPI))
_ledger (CardanoAPI (AsClientT m) -> m Genesis)
-> (Project -> CardanoAPI (AsClientT m)) -> Project -> m Genesis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> CardanoAPI (AsClientT m)
forall (m :: * -> *).
MonadBlockfrost m =>
Project -> CardanoAPI (AsClientT m)
cardanoClient

getLedgerGenesis_ :: MonadBlockfrost m => Project -> m Genesis
getLedgerGenesis_ :: Project -> m Genesis
getLedgerGenesis_ = LedgerAPI (AsClientT m) -> m Genesis
forall route.
LedgerAPI route
-> route
   :- (Summary "Blockchain genesis"
       :> (Description "Return the information about blockchain genesis."
           :> Get '[JSON] Genesis))
_genesis (LedgerAPI (AsClientT m) -> m Genesis)
-> (Project -> LedgerAPI (AsClientT m)) -> Project -> m Genesis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> LedgerAPI (AsClientT m)
forall (m :: * -> *).
MonadBlockfrost m =>
Project -> LedgerAPI (AsClientT m)
ledgerClient

-- | Get the information about blockchain genesis.
getLedgerGenesis :: MonadBlockfrost m => m Genesis
getLedgerGenesis :: m Genesis
getLedgerGenesis = (Project -> m Genesis) -> m Genesis
forall (m :: * -> *) a.
MonadBlockfrost m =>
(Project -> m a) -> m a
go Project -> m Genesis
forall (m :: * -> *). MonadBlockfrost m => Project -> m Genesis
getLedgerGenesis_