{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Node.Queries
  ( ConvertTxId (..)
  -- * KES
  , MaxKESEvolutions (..)
  , OperationalCertStartKESPeriod (..)
  , GetKESInfo(..)
  , HasKESInfo(..)
  , KESMetricsData (..)
  , HasKESMetricsData (..)
  -- * General ledger
  , LedgerQueries(..)
  -- * Node kernel
  , NodeKernelData(..)
  , nkQueryChain
  , nkQueryLedger
  , mapNodeKernelDataIO
  , setNodeKernel
  , mkNodeKernelData
  -- * Re-exports
  , NodeKernel (..)
  , LocalConnectionId
  , RemoteConnectionId
  , StrictMaybe(..)
  , fromSMaybe
  ) where

import           Cardano.Prelude hiding (All, (:.:))

import           Data.IORef (IORef, newIORef, readIORef, writeIORef)
import qualified Data.Map.Strict as Map
import           Data.SOP.Strict
import qualified Data.UMap as UM

import qualified Cardano.Chain.Block as Byron
import qualified Cardano.Chain.UTxO as Byron
import qualified Cardano.Crypto.Hash as Crypto
import qualified Cardano.Crypto.Hashing as Byron.Crypto
import           Cardano.Crypto.KES.Class (Period)
import           Cardano.Protocol.TPraos.OCert (KESPeriod (..))

import           Cardano.Ledger.BaseTypes (StrictMaybe (..), fromSMaybe)
import qualified Cardano.Ledger.SafeHash as Ledger
import qualified Cardano.Ledger.Shelley.LedgerState as Shelley
import qualified Cardano.Ledger.Shelley.UTxO as Shelley
import qualified Cardano.Ledger.TxIn as Ledger

import           Ouroboros.Consensus.Block (ForgeStateInfo, ForgeStateUpdateError)
import           Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock)
import qualified Ouroboros.Consensus.Byron.Ledger.Block as Byron
import qualified Ouroboros.Consensus.Byron.Ledger.Ledger as Byron
import           Ouroboros.Consensus.Byron.Ledger.Mempool (TxId (..))
import qualified Ouroboros.Consensus.Cardano as Cardano
import qualified Ouroboros.Consensus.Cardano.Block as Cardano
import           Ouroboros.Consensus.HardFork.Combinator
import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras (OneEraForgeStateInfo (..),
                   OneEraForgeStateUpdateError (..))
import           Ouroboros.Consensus.HardFork.Combinator.Embed.Unary
import           Ouroboros.Consensus.Ledger.Abstract (IsLedger)
import           Ouroboros.Consensus.Ledger.Extended (ExtLedgerState)
import           Ouroboros.Consensus.Node (NodeKernel (..))
import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey
import qualified Ouroboros.Consensus.Shelley.Ledger as Shelley
import           Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock)
import           Ouroboros.Consensus.Shelley.Ledger.Mempool (TxId (..))
import           Ouroboros.Consensus.Shelley.Node ()
import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
import           Ouroboros.Consensus.TypeFamilyWrappers
import           Ouroboros.Consensus.Util.Orphans ()

import qualified Ouroboros.Network.AnchoredFragment as AF
import           Ouroboros.Network.NodeToClient (LocalConnectionId)
import           Ouroboros.Network.NodeToNode (RemoteConnectionId)

--
-- * TxId -> ByteString projection
--
-- | Convert a transaction ID to raw bytes.
class ConvertTxId blk where
  txIdToRawBytes :: TxId (GenTx blk) -> ByteString

instance ConvertTxId ByronBlock where
  txIdToRawBytes :: TxId (GenTx ByronBlock) -> ByteString
txIdToRawBytes (ByronTxId txId) = AbstractHash Blake2b_256 Tx -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Byron.Crypto.abstractHashToBytes AbstractHash Blake2b_256 Tx
txId
  txIdToRawBytes (ByronDlgId dlgId) = AbstractHash Blake2b_256 Certificate -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Byron.Crypto.abstractHashToBytes AbstractHash Blake2b_256 Certificate
dlgId
  txIdToRawBytes (ByronUpdateProposalId upId) =
    AbstractHash Blake2b_256 Proposal -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Byron.Crypto.abstractHashToBytes AbstractHash Blake2b_256 Proposal
upId
  txIdToRawBytes (ByronUpdateVoteId voteId) =
    AbstractHash Blake2b_256 Vote -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Byron.Crypto.abstractHashToBytes AbstractHash Blake2b_256 Vote
voteId

instance ConvertTxId (ShelleyBlock protocol c) where
  txIdToRawBytes :: TxId (GenTx (ShelleyBlock protocol c)) -> ByteString
txIdToRawBytes (ShelleyTxId txId) =
    Hash (HASH (Crypto c)) EraIndependentTxBody -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes (Hash (HASH (Crypto c)) EraIndependentTxBody -> ByteString)
-> (TxId (Crypto c) -> Hash (HASH (Crypto c)) EraIndependentTxBody)
-> TxId (Crypto c)
-> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SafeHash (Crypto c) EraIndependentTxBody
-> Hash (HASH (Crypto c)) EraIndependentTxBody
forall crypto i. SafeHash crypto i -> Hash (HASH crypto) i
Ledger.extractHash (SafeHash (Crypto c) EraIndependentTxBody
 -> Hash (HASH (Crypto c)) EraIndependentTxBody)
-> (TxId (Crypto c) -> SafeHash (Crypto c) EraIndependentTxBody)
-> TxId (Crypto c)
-> Hash (HASH (Crypto c)) EraIndependentTxBody
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TxId (Crypto c) -> SafeHash (Crypto c) EraIndependentTxBody
forall crypto. TxId crypto -> SafeHash crypto EraIndependentTxBody
Ledger._unTxId (TxId (Crypto c) -> ByteString) -> TxId (Crypto c) -> ByteString
forall a b. (a -> b) -> a -> b
$ TxId (Crypto c)
txId

instance All ConvertTxId xs
      => ConvertTxId (HardForkBlock xs) where
  txIdToRawBytes :: TxId (GenTx (HardForkBlock xs)) -> ByteString
txIdToRawBytes =
    NS (K ByteString) xs -> ByteString
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
      (NS (K ByteString) xs -> ByteString)
-> (TxId (GenTx (HardForkBlock xs)) -> NS (K ByteString) xs)
-> TxId (GenTx (HardForkBlock xs))
-> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy ConvertTxId
-> (forall a. ConvertTxId a => WrapGenTxId a -> K ByteString a)
-> NS WrapGenTxId xs
-> NS (K ByteString) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (Proxy ConvertTxId
forall k (t :: k). Proxy t
Proxy @ConvertTxId) (ByteString -> K ByteString a
forall k a (b :: k). a -> K a b
K (ByteString -> K ByteString a)
-> (WrapGenTxId a -> ByteString) -> WrapGenTxId a -> K ByteString a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TxId (GenTx a) -> ByteString
forall blk. ConvertTxId blk => TxId (GenTx blk) -> ByteString
txIdToRawBytes (TxId (GenTx a) -> ByteString)
-> (WrapGenTxId a -> TxId (GenTx a)) -> WrapGenTxId a -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. WrapGenTxId a -> TxId (GenTx a)
forall blk. WrapGenTxId blk -> GenTxId blk
unwrapGenTxId)
      (NS WrapGenTxId xs -> NS (K ByteString) xs)
-> (TxId (GenTx (HardForkBlock xs)) -> NS WrapGenTxId xs)
-> TxId (GenTx (HardForkBlock xs))
-> NS (K ByteString) xs
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. OneEraGenTxId xs -> NS WrapGenTxId xs
forall (xs :: [*]). OneEraGenTxId xs -> NS WrapGenTxId xs
getOneEraGenTxId
      (OneEraGenTxId xs -> NS WrapGenTxId xs)
-> (TxId (GenTx (HardForkBlock xs)) -> OneEraGenTxId xs)
-> TxId (GenTx (HardForkBlock xs))
-> NS WrapGenTxId xs
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TxId (GenTx (HardForkBlock xs)) -> OneEraGenTxId xs
forall (xs :: [*]).
TxId (GenTx (HardForkBlock xs)) -> OneEraGenTxId xs
getHardForkGenTxId

--
-- * KES
--
-- | The maximum number of evolutions that a KES key can undergo before it is
-- considered expired.
newtype MaxKESEvolutions = MaxKESEvolutions Word64

-- | The start KES period of the configured operational certificate.
newtype OperationalCertStartKESPeriod = OperationalCertStartKESPeriod Period

--
-- * HasKESInfo
--
class HasKESInfo blk where
  getKESInfo :: Proxy blk -> ForgeStateUpdateError blk -> Maybe HotKey.KESInfo
  getKESInfo Proxy blk
_ ForgeStateUpdateError blk
_ = Maybe KESInfo
forall a. Maybe a
Nothing

instance HasKESInfo (ShelleyBlock protocol era) where
  getKESInfo :: Proxy (ShelleyBlock protocol era)
-> ForgeStateUpdateError (ShelleyBlock protocol era)
-> Maybe KESInfo
getKESInfo Proxy (ShelleyBlock protocol era)
_ (HotKey.KESCouldNotEvolve ki _) = KESInfo -> Maybe KESInfo
forall a. a -> Maybe a
Just KESInfo
ki
  getKESInfo Proxy (ShelleyBlock protocol era)
_ (HotKey.KESKeyAlreadyPoisoned ki _) = KESInfo -> Maybe KESInfo
forall a. a -> Maybe a
Just KESInfo
ki

instance HasKESInfo ByronBlock

instance All HasKESInfo xs => HasKESInfo (HardForkBlock xs) where
  getKESInfo :: Proxy (HardForkBlock xs)
-> ForgeStateUpdateError (HardForkBlock xs) -> Maybe KESInfo
getKESInfo Proxy (HardForkBlock xs)
_ =
      NS (K (Maybe KESInfo)) xs -> Maybe KESInfo
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
    (NS (K (Maybe KESInfo)) xs -> Maybe KESInfo)
-> (OneEraForgeStateUpdateError xs -> NS (K (Maybe KESInfo)) xs)
-> OneEraForgeStateUpdateError xs
-> Maybe KESInfo
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy HasKESInfo
-> (forall a.
    HasKESInfo a =>
    WrapForgeStateUpdateError a -> K (Maybe KESInfo) a)
-> NS WrapForgeStateUpdateError xs
-> NS (K (Maybe KESInfo)) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (Proxy HasKESInfo
forall k (t :: k). Proxy t
Proxy @HasKESInfo) forall a.
HasKESInfo a =>
WrapForgeStateUpdateError a -> K (Maybe KESInfo) a
getOne
    (NS WrapForgeStateUpdateError xs -> NS (K (Maybe KESInfo)) xs)
-> (OneEraForgeStateUpdateError xs
    -> NS WrapForgeStateUpdateError xs)
-> OneEraForgeStateUpdateError xs
-> NS (K (Maybe KESInfo)) xs
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. OneEraForgeStateUpdateError xs -> NS WrapForgeStateUpdateError xs
forall (xs :: [*]).
OneEraForgeStateUpdateError xs -> NS WrapForgeStateUpdateError xs
getOneEraForgeStateUpdateError
   where
    getOne :: forall blk. HasKESInfo blk
           => WrapForgeStateUpdateError blk
           -> K (Maybe HotKey.KESInfo) blk
    getOne :: WrapForgeStateUpdateError blk -> K (Maybe KESInfo) blk
getOne = Maybe KESInfo -> K (Maybe KESInfo) blk
forall k a (b :: k). a -> K a b
K (Maybe KESInfo -> K (Maybe KESInfo) blk)
-> (WrapForgeStateUpdateError blk -> Maybe KESInfo)
-> WrapForgeStateUpdateError blk
-> K (Maybe KESInfo) blk
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy blk -> ForgeStateUpdateError blk -> Maybe KESInfo
forall blk.
HasKESInfo blk =>
Proxy blk -> ForgeStateUpdateError blk -> Maybe KESInfo
getKESInfo (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) (ForgeStateUpdateError blk -> Maybe KESInfo)
-> (WrapForgeStateUpdateError blk -> ForgeStateUpdateError blk)
-> WrapForgeStateUpdateError blk
-> Maybe KESInfo
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. WrapForgeStateUpdateError blk -> ForgeStateUpdateError blk
forall blk.
WrapForgeStateUpdateError blk -> ForgeStateUpdateError blk
unwrapForgeStateUpdateError

--
-- * KESMetricsData
--
-- | KES-related data to be traced as metrics.
data KESMetricsData
  = NoKESMetricsData
  -- ^ The current protocol does not support KES.
  | TPraosKESMetricsData
      !Period
      -- ^ The current KES period of the hot key, relative to the start KES
      -- period of the operational certificate.
      !MaxKESEvolutions
      -- ^ The configured max KES evolutions.
      !OperationalCertStartKESPeriod
      -- ^ The start KES period of the configured operational certificate.

class HasKESMetricsData blk where
  -- Because 'ForgeStateInfo' is a type family, we need a Proxy argument to
  -- disambiguate.
  getKESMetricsData :: Proxy blk -> ForgeStateInfo blk -> KESMetricsData

  -- Default to 'NoKESMetricsData'
  getKESMetricsData Proxy blk
_ ForgeStateInfo blk
_ = KESMetricsData
NoKESMetricsData

instance HasKESMetricsData (ShelleyBlock protocol c) where
  getKESMetricsData :: Proxy (ShelleyBlock protocol c)
-> ForgeStateInfo (ShelleyBlock protocol c) -> KESMetricsData
getKESMetricsData Proxy (ShelleyBlock protocol c)
_ ForgeStateInfo (ShelleyBlock protocol c)
forgeStateInfo =
      Period
-> MaxKESEvolutions
-> OperationalCertStartKESPeriod
-> KESMetricsData
TPraosKESMetricsData Period
currKesPeriod MaxKESEvolutions
maxKesEvos OperationalCertStartKESPeriod
oCertStartKesPeriod
    where
      HotKey.KESInfo
        { kesStartPeriod :: KESInfo -> KESPeriod
kesStartPeriod = KESPeriod Period
startKesPeriod
        , kesEvolution :: KESInfo -> Period
kesEvolution = Period
currKesPeriod
        , kesEndPeriod :: KESInfo -> KESPeriod
kesEndPeriod = KESPeriod Period
endKesPeriod
        } = ForgeStateInfo (ShelleyBlock protocol c)
KESInfo
forgeStateInfo

      maxKesEvos :: MaxKESEvolutions
maxKesEvos = Word64 -> MaxKESEvolutions
MaxKESEvolutions (Word64 -> MaxKESEvolutions) -> Word64 -> MaxKESEvolutions
forall a b. (a -> b) -> a -> b
$
          Period -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Period -> Word64) -> Period -> Word64
forall a b. (a -> b) -> a -> b
$ Period
endKesPeriod Period -> Period -> Period
forall a. Num a => a -> a -> a
- Period
startKesPeriod

      oCertStartKesPeriod :: OperationalCertStartKESPeriod
oCertStartKesPeriod = Period -> OperationalCertStartKESPeriod
OperationalCertStartKESPeriod Period
startKesPeriod

instance HasKESMetricsData ByronBlock where

instance All HasKESMetricsData xs => HasKESMetricsData (HardForkBlock xs) where
  getKESMetricsData :: Proxy (HardForkBlock xs)
-> ForgeStateInfo (HardForkBlock xs) -> KESMetricsData
getKESMetricsData Proxy (HardForkBlock xs)
_ ForgeStateInfo (HardForkBlock xs)
forgeStateInfo =
      case ForgeStateInfo (HardForkBlock xs)
forgeStateInfo of
        CurrentEraLacksBlockForging _ -> KESMetricsData
NoKESMetricsData
        CurrentEraForgeStateUpdated currentEraForgeStateInfo ->
            NS (K KESMetricsData) xs -> KESMetricsData
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
          (NS (K KESMetricsData) xs -> KESMetricsData)
-> (OneEraForgeStateInfo xs -> NS (K KESMetricsData) xs)
-> OneEraForgeStateInfo xs
-> KESMetricsData
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy HasKESMetricsData
-> (forall a.
    HasKESMetricsData a =>
    WrapForgeStateInfo a -> K KESMetricsData a)
-> NS WrapForgeStateInfo xs
-> NS (K KESMetricsData) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (Proxy HasKESMetricsData
forall k (t :: k). Proxy t
Proxy @HasKESMetricsData) forall a.
HasKESMetricsData a =>
WrapForgeStateInfo a -> K KESMetricsData a
getOne
          (NS WrapForgeStateInfo xs -> NS (K KESMetricsData) xs)
-> (OneEraForgeStateInfo xs -> NS WrapForgeStateInfo xs)
-> OneEraForgeStateInfo xs
-> NS (K KESMetricsData) xs
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. OneEraForgeStateInfo xs -> NS WrapForgeStateInfo xs
forall (xs :: [*]).
OneEraForgeStateInfo xs -> NS WrapForgeStateInfo xs
getOneEraForgeStateInfo
          (OneEraForgeStateInfo xs -> KESMetricsData)
-> OneEraForgeStateInfo xs -> KESMetricsData
forall a b. (a -> b) -> a -> b
$ OneEraForgeStateInfo xs
currentEraForgeStateInfo
    where
      getOne :: forall blk. HasKESMetricsData blk
             => WrapForgeStateInfo blk
             -> K KESMetricsData blk
      getOne :: WrapForgeStateInfo blk -> K KESMetricsData blk
getOne = KESMetricsData -> K KESMetricsData blk
forall k a (b :: k). a -> K a b
K (KESMetricsData -> K KESMetricsData blk)
-> (WrapForgeStateInfo blk -> KESMetricsData)
-> WrapForgeStateInfo blk
-> K KESMetricsData blk
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy blk -> ForgeStateInfo blk -> KESMetricsData
forall blk.
HasKESMetricsData blk =>
Proxy blk -> ForgeStateInfo blk -> KESMetricsData
getKESMetricsData (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) (ForgeStateInfo blk -> KESMetricsData)
-> (WrapForgeStateInfo blk -> ForgeStateInfo blk)
-> WrapForgeStateInfo blk
-> KESMetricsData
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. WrapForgeStateInfo blk -> ForgeStateInfo blk
forall blk. WrapForgeStateInfo blk -> ForgeStateInfo blk
unwrapForgeStateInfo

--
-- * GetKESInfo
--
class GetKESInfo blk where
  getKESInfoFromStateInfo :: Proxy blk -> ForgeStateInfo blk -> Maybe HotKey.KESInfo
  getKESInfoFromStateInfo Proxy blk
_ ForgeStateInfo blk
_ = Maybe KESInfo
forall a. Maybe a
Nothing

instance GetKESInfo (ShelleyBlock protocol era) where
  getKESInfoFromStateInfo :: Proxy (ShelleyBlock protocol era)
-> ForgeStateInfo (ShelleyBlock protocol era) -> Maybe KESInfo
getKESInfoFromStateInfo Proxy (ShelleyBlock protocol era)
_ = ForgeStateInfo (ShelleyBlock protocol era) -> Maybe KESInfo
forall a. a -> Maybe a
Just

instance GetKESInfo ByronBlock

instance All GetKESInfo xs => GetKESInfo (HardForkBlock xs) where
  getKESInfoFromStateInfo :: Proxy (HardForkBlock xs)
-> ForgeStateInfo (HardForkBlock xs) -> Maybe KESInfo
getKESInfoFromStateInfo Proxy (HardForkBlock xs)
_ ForgeStateInfo (HardForkBlock xs)
forgeStateInfo =
      case ForgeStateInfo (HardForkBlock xs)
forgeStateInfo of
        CurrentEraLacksBlockForging _ -> Maybe KESInfo
forall a. Maybe a
Nothing
        CurrentEraForgeStateUpdated currentEraForgeStateInfo ->
            NS (K (Maybe KESInfo)) xs -> Maybe KESInfo
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
          (NS (K (Maybe KESInfo)) xs -> Maybe KESInfo)
-> (OneEraForgeStateInfo xs -> NS (K (Maybe KESInfo)) xs)
-> OneEraForgeStateInfo xs
-> Maybe KESInfo
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy GetKESInfo
-> (forall a.
    GetKESInfo a =>
    WrapForgeStateInfo a -> K (Maybe KESInfo) a)
-> NS WrapForgeStateInfo xs
-> NS (K (Maybe KESInfo)) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (Proxy GetKESInfo
forall k (t :: k). Proxy t
Proxy @GetKESInfo) forall a.
GetKESInfo a =>
WrapForgeStateInfo a -> K (Maybe KESInfo) a
getOne
          (NS WrapForgeStateInfo xs -> NS (K (Maybe KESInfo)) xs)
-> (OneEraForgeStateInfo xs -> NS WrapForgeStateInfo xs)
-> OneEraForgeStateInfo xs
-> NS (K (Maybe KESInfo)) xs
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. OneEraForgeStateInfo xs -> NS WrapForgeStateInfo xs
forall (xs :: [*]).
OneEraForgeStateInfo xs -> NS WrapForgeStateInfo xs
getOneEraForgeStateInfo
          (OneEraForgeStateInfo xs -> Maybe KESInfo)
-> OneEraForgeStateInfo xs -> Maybe KESInfo
forall a b. (a -> b) -> a -> b
$ OneEraForgeStateInfo xs
currentEraForgeStateInfo
    where
      getOne :: forall blk. GetKESInfo blk
             => WrapForgeStateInfo blk
             -> K (Maybe HotKey.KESInfo) blk
      getOne :: WrapForgeStateInfo blk -> K (Maybe KESInfo) blk
getOne = Maybe KESInfo -> K (Maybe KESInfo) blk
forall k a (b :: k). a -> K a b
K (Maybe KESInfo -> K (Maybe KESInfo) blk)
-> (WrapForgeStateInfo blk -> Maybe KESInfo)
-> WrapForgeStateInfo blk
-> K (Maybe KESInfo) blk
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy blk -> ForgeStateInfo blk -> Maybe KESInfo
forall blk.
GetKESInfo blk =>
Proxy blk -> ForgeStateInfo blk -> Maybe KESInfo
getKESInfoFromStateInfo (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) (ForgeStateInfo blk -> Maybe KESInfo)
-> (WrapForgeStateInfo blk -> ForgeStateInfo blk)
-> WrapForgeStateInfo blk
-> Maybe KESInfo
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. WrapForgeStateInfo blk -> ForgeStateInfo blk
forall blk. WrapForgeStateInfo blk -> ForgeStateInfo blk
unwrapForgeStateInfo

--
-- * General ledger
--
class LedgerQueries blk where
  ledgerUtxoSize     :: LedgerState blk -> Int
  ledgerDelegMapSize :: LedgerState blk -> Int

instance LedgerQueries Byron.ByronBlock where
  ledgerUtxoSize :: LedgerState ByronBlock -> Int
ledgerUtxoSize = Map CompactTxIn CompactTxOut -> Int
forall k a. Map k a -> Int
Map.size (Map CompactTxIn CompactTxOut -> Int)
-> (LedgerState ByronBlock -> Map CompactTxIn CompactTxOut)
-> LedgerState ByronBlock
-> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTxO -> Map CompactTxIn CompactTxOut
Byron.unUTxO (UTxO -> Map CompactTxIn CompactTxOut)
-> (LedgerState ByronBlock -> UTxO)
-> LedgerState ByronBlock
-> Map CompactTxIn CompactTxOut
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ChainValidationState -> UTxO
Byron.cvsUtxo (ChainValidationState -> UTxO)
-> (LedgerState ByronBlock -> ChainValidationState)
-> LedgerState ByronBlock
-> UTxO
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LedgerState ByronBlock -> ChainValidationState
Byron.byronLedgerState
  ledgerDelegMapSize :: LedgerState ByronBlock -> Int
ledgerDelegMapSize LedgerState ByronBlock
_ = Int
0

instance LedgerQueries (Shelley.ShelleyBlock protocol era) where
  ledgerUtxoSize :: LedgerState (ShelleyBlock protocol era) -> Int
ledgerUtxoSize =
      (\(Shelley.UTxO Map (TxIn (Crypto era)) (TxOut era)
xs)-> Map (TxIn (Crypto era)) (TxOut era) -> Int
forall k a. Map k a -> Int
Map.size Map (TxIn (Crypto era)) (TxOut era)
xs)
    (UTxO era -> Int)
-> (LedgerState (ShelleyBlock protocol era) -> UTxO era)
-> LedgerState (ShelleyBlock protocol era)
-> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
Shelley._utxo
    (UTxOState era -> UTxO era)
-> (LedgerState (ShelleyBlock protocol era) -> UTxOState era)
-> LedgerState (ShelleyBlock protocol era)
-> UTxO era
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
Shelley.lsUTxOState
    (LedgerState era -> UTxOState era)
-> (LedgerState (ShelleyBlock protocol era) -> LedgerState era)
-> LedgerState (ShelleyBlock protocol era)
-> UTxOState era
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
Shelley.esLState
    (EpochState era -> LedgerState era)
-> (LedgerState (ShelleyBlock protocol era) -> EpochState era)
-> LedgerState (ShelleyBlock protocol era)
-> LedgerState era
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
Shelley.nesEs
    (NewEpochState era -> EpochState era)
-> (LedgerState (ShelleyBlock protocol era) -> NewEpochState era)
-> LedgerState (ShelleyBlock protocol era)
-> EpochState era
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LedgerState (ShelleyBlock protocol era) -> NewEpochState era
forall proto era.
LedgerState (ShelleyBlock proto era) -> NewEpochState era
Shelley.shelleyLedgerState
  ledgerDelegMapSize :: LedgerState (ShelleyBlock protocol era) -> Int
ledgerDelegMapSize =
      View
  Coin
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
  Ptr
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
-> Int
forall coin cred pool ptr k a. View coin cred pool ptr k a -> Int
UM.size
    (View
   Coin
   (Credential 'Staking (Crypto era))
   (KeyHash 'StakePool (Crypto era))
   Ptr
   (Credential 'Staking (Crypto era))
   (KeyHash 'StakePool (Crypto era))
 -> Int)
-> (LedgerState (ShelleyBlock protocol era)
    -> View
         Coin
         (Credential 'Staking (Crypto era))
         (KeyHash 'StakePool (Crypto era))
         Ptr
         (Credential 'Staking (Crypto era))
         (KeyHash 'StakePool (Crypto era)))
-> LedgerState (ShelleyBlock protocol era)
-> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UMap
  Coin
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
  Ptr
-> View
     Coin
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
     Ptr
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
forall coin cr pl ptr.
UMap coin cr pl ptr -> View coin cr pl ptr cr pl
UM.Delegations
    (UMap
   Coin
   (Credential 'Staking (Crypto era))
   (KeyHash 'StakePool (Crypto era))
   Ptr
 -> View
      Coin
      (Credential 'Staking (Crypto era))
      (KeyHash 'StakePool (Crypto era))
      Ptr
      (Credential 'Staking (Crypto era))
      (KeyHash 'StakePool (Crypto era)))
-> (LedgerState (ShelleyBlock protocol era)
    -> UMap
         Coin
         (Credential 'Staking (Crypto era))
         (KeyHash 'StakePool (Crypto era))
         Ptr)
-> LedgerState (ShelleyBlock protocol era)
-> View
     Coin
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
     Ptr
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. DState (Crypto era)
-> UMap
     Coin
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
     Ptr
forall crypto. DState crypto -> UnifiedMap crypto
Shelley._unified
    (DState (Crypto era)
 -> UMap
      Coin
      (Credential 'Staking (Crypto era))
      (KeyHash 'StakePool (Crypto era))
      Ptr)
-> (LedgerState (ShelleyBlock protocol era) -> DState (Crypto era))
-> LedgerState (ShelleyBlock protocol era)
-> UMap
     Coin
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
     Ptr
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. DPState (Crypto era) -> DState (Crypto era)
forall crypto. DPState crypto -> DState crypto
Shelley.dpsDState
    (DPState (Crypto era) -> DState (Crypto era))
-> (LedgerState (ShelleyBlock protocol era)
    -> DPState (Crypto era))
-> LedgerState (ShelleyBlock protocol era)
-> DState (Crypto era)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LedgerState era -> DPState (Crypto era)
forall era. LedgerState era -> DPState (Crypto era)
Shelley.lsDPState
    (LedgerState era -> DPState (Crypto era))
-> (LedgerState (ShelleyBlock protocol era) -> LedgerState era)
-> LedgerState (ShelleyBlock protocol era)
-> DPState (Crypto era)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
Shelley.esLState
    (EpochState era -> LedgerState era)
-> (LedgerState (ShelleyBlock protocol era) -> EpochState era)
-> LedgerState (ShelleyBlock protocol era)
-> LedgerState era
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
Shelley.nesEs
    (NewEpochState era -> EpochState era)
-> (LedgerState (ShelleyBlock protocol era) -> NewEpochState era)
-> LedgerState (ShelleyBlock protocol era)
-> EpochState era
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LedgerState (ShelleyBlock protocol era) -> NewEpochState era
forall proto era.
LedgerState (ShelleyBlock proto era) -> NewEpochState era
Shelley.shelleyLedgerState

instance (LedgerQueries x, NoHardForks x)
      => LedgerQueries (HardForkBlock '[x]) where
  ledgerUtxoSize :: LedgerState (HardForkBlock '[x]) -> Int
ledgerUtxoSize = LedgerState x -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerUtxoSize (LedgerState x -> Int)
-> (LedgerState (HardForkBlock '[x]) -> LedgerState x)
-> LedgerState (HardForkBlock '[x])
-> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LedgerState (HardForkBlock '[x]) -> LedgerState x
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project
  ledgerDelegMapSize :: LedgerState (HardForkBlock '[x]) -> Int
ledgerDelegMapSize = LedgerState x -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerDelegMapSize (LedgerState x -> Int)
-> (LedgerState (HardForkBlock '[x]) -> LedgerState x)
-> LedgerState (HardForkBlock '[x])
-> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LedgerState (HardForkBlock '[x]) -> LedgerState x
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project

instance LedgerQueries (Cardano.CardanoBlock c) where
  ledgerUtxoSize :: LedgerState (CardanoBlock c) -> Int
ledgerUtxoSize = \case
    Cardano.LedgerStateByron   LedgerState ByronBlock
ledgerByron   -> LedgerState ByronBlock -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerUtxoSize LedgerState ByronBlock
ledgerByron
    Cardano.LedgerStateShelley LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))
ledgerShelley -> LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerUtxoSize LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))
ledgerShelley
    Cardano.LedgerStateAllegra LedgerState (ShelleyBlock (TPraos c) (AllegraEra c))
ledgerAllegra -> LedgerState (ShelleyBlock (TPraos c) (AllegraEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerUtxoSize LedgerState (ShelleyBlock (TPraos c) (AllegraEra c))
ledgerAllegra
    Cardano.LedgerStateMary    LedgerState (ShelleyBlock (TPraos c) (MaryEra c))
ledgerMary    -> LedgerState (ShelleyBlock (TPraos c) (MaryEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerUtxoSize LedgerState (ShelleyBlock (TPraos c) (MaryEra c))
ledgerMary
    Cardano.LedgerStateAlonzo  LedgerState (ShelleyBlock (TPraos c) (AlonzoEra c))
ledgerAlonzo  -> LedgerState (ShelleyBlock (TPraos c) (AlonzoEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerUtxoSize LedgerState (ShelleyBlock (TPraos c) (AlonzoEra c))
ledgerAlonzo
    Cardano.LedgerStateBabbage LedgerState (ShelleyBlock (Praos c) (BabbageEra c))
ledgerBabbage -> LedgerState (ShelleyBlock (Praos c) (BabbageEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerUtxoSize LedgerState (ShelleyBlock (Praos c) (BabbageEra c))
ledgerBabbage
  ledgerDelegMapSize :: LedgerState (CardanoBlock c) -> Int
ledgerDelegMapSize = \case
    Cardano.LedgerStateByron   LedgerState ByronBlock
ledgerByron   -> LedgerState ByronBlock -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerDelegMapSize LedgerState ByronBlock
ledgerByron
    Cardano.LedgerStateShelley LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))
ledgerShelley -> LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerDelegMapSize LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))
ledgerShelley
    Cardano.LedgerStateAllegra LedgerState (ShelleyBlock (TPraos c) (AllegraEra c))
ledgerAllegra -> LedgerState (ShelleyBlock (TPraos c) (AllegraEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerDelegMapSize LedgerState (ShelleyBlock (TPraos c) (AllegraEra c))
ledgerAllegra
    Cardano.LedgerStateMary    LedgerState (ShelleyBlock (TPraos c) (MaryEra c))
ledgerMary    -> LedgerState (ShelleyBlock (TPraos c) (MaryEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerDelegMapSize LedgerState (ShelleyBlock (TPraos c) (MaryEra c))
ledgerMary
    Cardano.LedgerStateAlonzo  LedgerState (ShelleyBlock (TPraos c) (AlonzoEra c))
ledgerAlonzo  -> LedgerState (ShelleyBlock (TPraos c) (AlonzoEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerDelegMapSize LedgerState (ShelleyBlock (TPraos c) (AlonzoEra c))
ledgerAlonzo
    Cardano.LedgerStateBabbage LedgerState (ShelleyBlock (Praos c) (BabbageEra c))
ledgerBabbage -> LedgerState (ShelleyBlock (Praos c) (BabbageEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerDelegMapSize LedgerState (ShelleyBlock (Praos c) (BabbageEra c))
ledgerBabbage
--
-- * Node kernel
--
newtype NodeKernelData blk =
  NodeKernelData
  { NodeKernelData blk
-> IORef
     (StrictMaybe
        (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
unNodeKernelData :: IORef (StrictMaybe (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
  }

mkNodeKernelData :: IO (NodeKernelData blk)
mkNodeKernelData :: IO (NodeKernelData blk)
mkNodeKernelData = IORef
  (StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
-> NodeKernelData blk
forall blk.
IORef
  (StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
-> NodeKernelData blk
NodeKernelData (IORef
   (StrictMaybe
      (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
 -> NodeKernelData blk)
-> IO
     (IORef
        (StrictMaybe
           (NodeKernel IO RemoteConnectionId LocalConnectionId blk)))
-> IO (NodeKernelData blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe
  (NodeKernel IO RemoteConnectionId LocalConnectionId blk)
-> IO
     (IORef
        (StrictMaybe
           (NodeKernel IO RemoteConnectionId LocalConnectionId blk)))
forall a. a -> IO (IORef a)
newIORef StrictMaybe
  (NodeKernel IO RemoteConnectionId LocalConnectionId blk)
forall a. StrictMaybe a
SNothing

setNodeKernel :: NodeKernelData blk
              -> NodeKernel IO RemoteConnectionId LocalConnectionId blk
              -> IO ()
setNodeKernel :: NodeKernelData blk
-> NodeKernel IO RemoteConnectionId LocalConnectionId blk -> IO ()
setNodeKernel (NodeKernelData IORef
  (StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
ref) NodeKernel IO RemoteConnectionId LocalConnectionId blk
nodeKern =
  IORef
  (StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
-> StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk)
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
  (StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
ref (StrictMaybe
   (NodeKernel IO RemoteConnectionId LocalConnectionId blk)
 -> IO ())
-> StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk)
-> IO ()
forall a b. (a -> b) -> a -> b
$ NodeKernel IO RemoteConnectionId LocalConnectionId blk
-> StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk)
forall a. a -> StrictMaybe a
SJust NodeKernel IO RemoteConnectionId LocalConnectionId blk
nodeKern

mapNodeKernelDataIO ::
  (NodeKernel IO RemoteConnectionId LocalConnectionId blk -> IO a)
  -> NodeKernelData blk
  -> IO (StrictMaybe a)
mapNodeKernelDataIO :: (NodeKernel IO RemoteConnectionId LocalConnectionId blk -> IO a)
-> NodeKernelData blk -> IO (StrictMaybe a)
mapNodeKernelDataIO NodeKernel IO RemoteConnectionId LocalConnectionId blk -> IO a
f (NodeKernelData IORef
  (StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
ref) =
  IORef
  (StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
-> IO
     (StrictMaybe
        (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
forall a. IORef a -> IO a
readIORef IORef
  (StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
ref IO
  (StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
-> (StrictMaybe
      (NodeKernel IO RemoteConnectionId LocalConnectionId blk)
    -> IO (StrictMaybe a))
-> IO (StrictMaybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (NodeKernel IO RemoteConnectionId LocalConnectionId blk -> IO a)
-> StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk)
-> IO (StrictMaybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse NodeKernel IO RemoteConnectionId LocalConnectionId blk -> IO a
f

nkQueryLedger ::
     IsLedger (LedgerState blk)
  => (ExtLedgerState blk -> a)
  -> NodeKernel IO RemoteConnectionId LocalConnectionId blk
  -> IO a
nkQueryLedger :: (ExtLedgerState blk -> a)
-> NodeKernel IO RemoteConnectionId LocalConnectionId blk -> IO a
nkQueryLedger ExtLedgerState blk -> a
f NodeKernel{ChainDB IO blk
$sel:getChainDB:NodeKernel :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk -> ChainDB m blk
getChainDB :: ChainDB IO blk
getChainDB} =
  ExtLedgerState blk -> a
f (ExtLedgerState blk -> a) -> IO (ExtLedgerState blk) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM (ExtLedgerState blk) -> IO (ExtLedgerState blk)
forall a. STM a -> IO a
atomically (ChainDB IO blk -> STM IO (ExtLedgerState blk)
forall (m :: * -> *) blk.
(Monad (STM m), IsLedger (LedgerState blk)) =>
ChainDB m blk -> STM m (ExtLedgerState blk)
ChainDB.getCurrentLedger ChainDB IO blk
getChainDB)

nkQueryChain ::
     (AF.AnchoredFragment (Header blk) -> a)
  -> NodeKernel IO RemoteConnectionId LocalConnectionId blk
  -> IO a
nkQueryChain :: (AnchoredFragment (Header blk) -> a)
-> NodeKernel IO RemoteConnectionId LocalConnectionId blk -> IO a
nkQueryChain AnchoredFragment (Header blk) -> a
f NodeKernel{ChainDB IO blk
getChainDB :: ChainDB IO blk
$sel:getChainDB:NodeKernel :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk -> ChainDB m blk
getChainDB} =
  AnchoredFragment (Header blk) -> a
f (AnchoredFragment (Header blk) -> a)
-> IO (AnchoredFragment (Header blk)) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM (AnchoredFragment (Header blk))
-> IO (AnchoredFragment (Header blk))
forall a. STM a -> IO a
atomically (ChainDB IO blk -> STM IO (AnchoredFragment (Header blk))
forall (m :: * -> *) blk.
ChainDB m blk -> STM m (AnchoredFragment (Header blk))
ChainDB.getCurrentChain ChainDB IO blk
getChainDB)