-- | Ledger queries

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

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

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

getLedgerGenesis_ :: Project -> BlockfrostClient Genesis
getLedgerGenesis_ :: Project
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Genesis
getLedgerGenesis_ = LedgerAPI (AsClientT BlockfrostClient)
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Genesis
forall route.
LedgerAPI route
-> route
   :- (Summary "Blockchain genesis"
       :> (Description "Return the information about blockchain genesis."
           :> Get '[JSON] Genesis))
_genesis (LedgerAPI (AsClientT BlockfrostClient)
 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Genesis)
-> (Project -> LedgerAPI (AsClientT BlockfrostClient))
-> Project
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Genesis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> LedgerAPI (AsClientT BlockfrostClient)
ledgerClient

-- | Get the information about blockchain genesis.
getLedgerGenesis:: BlockfrostClient Genesis
getLedgerGenesis :: ExceptT BlockfrostError (ReaderT ClientConfig IO) Genesis
getLedgerGenesis = (Project
 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Genesis)
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Genesis
forall a. (Project -> BlockfrostClient a) -> BlockfrostClient a
go Project
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Genesis
getLedgerGenesis_