{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE NoFieldSelectors #-}

module Cardano.Rpc.Server.NodeKernelAccess
  ( NodeKernelAccess (..)
  , mkNodeKernelAccess
  , fetchBlock
  , grabNodeKernelAccess
  , ChainChange (..)
  , ChainFollower (..)
  , withFollower
  )
where

import Cardano.Api
import Cardano.Api.Consensus qualified as Consensus
import Cardano.Rpc.Server.Internal.Monad (MonadRpc, grab)
import Cardano.Rpc.Server.NodeKernelAccess.Type

import RIO (MonadUnliftIO, atomically, bracket, throwIO, withRunInIO)

import Control.Tracer (Tracer, traceWith)
import Data.ByteString (ByteString)
import Data.ByteString.Lazy qualified as BSL
import Data.IORef
import Data.Text (pack)
import Network.GRPC.Spec

-- | Construct 'NodeKernelAccess' from a consensus 'Consensus.NodeKernel'.
-- Returns 'Nothing' and traces the block type for non-Cardano block types.
mkNodeKernelAccess
  :: Monad m
  => Tracer m Text
  -- ^ Tracer for unsupported block type warnings
  -> Consensus.BlockType blk
  -- ^ Block type witness
  -> Consensus.TopLevelConfig blk
  -- ^ Top-level consensus config (for system start, era history and the
  -- security parameter)
  -> Consensus.NodeKernel IO addrNTN addrNTC blk
  -- ^ Consensus node kernel
  -> m (Maybe NodeKernelAccess)
mkNodeKernelAccess :: forall (m :: * -> *) blk addrNTN addrNTC.
Monad m =>
Tracer m Text
-> BlockType blk
-> TopLevelConfig blk
-> NodeKernel IO addrNTN addrNTC blk
-> m (Maybe NodeKernelAccess)
mkNodeKernelAccess Tracer m Text
tracer BlockType blk
blockType TopLevelConfig blk
topLevelConfig NodeKernel IO addrNTN addrNTC blk
kernel = case BlockType blk
blockType of
  BlockType blk
Consensus.CardanoBlockType ->
    Maybe NodeKernelAccess -> m (Maybe NodeKernelAccess)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe NodeKernelAccess -> m (Maybe NodeKernelAccess))
-> Maybe NodeKernelAccess -> m (Maybe NodeKernelAccess)
forall a b. (a -> b) -> a -> b
$ NodeKernelAccess -> Maybe NodeKernelAccess
forall a. a -> Maybe a
Just NodeKernelAccess{ChainDB IO blk
ChainDB IO (HardForkBlock (CardanoEras StandardCrypto))
chainDb :: ChainDB IO blk
chainDb :: ChainDB IO (HardForkBlock (CardanoEras StandardCrypto))
chainDb, SystemStart
systemStart :: SystemStart
systemStart :: SystemStart
systemStart, m EraHistory
forall (m :: * -> *). MonadIO m => m EraHistory
readEraHistory :: forall (m :: * -> *). MonadIO m => m EraHistory
readEraHistory :: forall (m :: * -> *). MonadIO m => m EraHistory
readEraHistory, SecurityParam
securityParam :: SecurityParam
securityParam :: SecurityParam
securityParam}
   where
    chainDb :: ChainDB IO blk
chainDb = NodeKernel IO addrNTN addrNTC blk -> ChainDB IO blk
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> ChainDB m blk
Consensus.getChainDB NodeKernel IO addrNTN addrNTC blk
kernel
    ledgerConfig :: LedgerConfig blk
ledgerConfig = TopLevelConfig blk -> LedgerConfig blk
forall blk. TopLevelConfig blk -> LedgerConfig blk
Consensus.configLedger TopLevelConfig blk
topLevelConfig
    systemStart :: SystemStart
systemStart = TopLevelConfig blk -> SystemStart
forall blk.
ConfigSupportsNode blk =>
TopLevelConfig blk -> SystemStart
Consensus.nodeSystemStart TopLevelConfig blk
topLevelConfig
    securityParam :: SecurityParam
securityParam = TopLevelConfig blk -> SecurityParam
forall blk.
ConsensusProtocol (BlockProtocol blk) =>
TopLevelConfig blk -> SecurityParam
Consensus.configSecurityParam TopLevelConfig blk
topLevelConfig
    -- Read the current ledger state (cheap STM TVar read) and recompute
    -- the era summary on every call - O(number_of_eras).
    -- This is the same approach consensus uses for GetInterpreter queries
    -- (interpretQueryHardFork); neither path caches the summary.
    -- RunWithCachedSummary exists but is private to the blockchain time thread.
    readEraHistory :: MonadIO n => n EraHistory
    readEraHistory :: forall (m :: * -> *). MonadIO m => m EraHistory
readEraHistory = IO EraHistory -> n EraHistory
forall a. IO a -> n a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EraHistory -> n EraHistory) -> IO EraHistory -> n EraHistory
forall a b. (a -> b) -> a -> b
$ do
      extLedger <- STM
  (ExtLedgerState
     (HardForkBlock (CardanoEras StandardCrypto)) EmptyMK)
-> IO
     (ExtLedgerState
        (HardForkBlock (CardanoEras StandardCrypto)) EmptyMK)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM
   (ExtLedgerState
      (HardForkBlock (CardanoEras StandardCrypto)) EmptyMK)
 -> IO
      (ExtLedgerState
         (HardForkBlock (CardanoEras StandardCrypto)) EmptyMK))
-> STM
     (ExtLedgerState
        (HardForkBlock (CardanoEras StandardCrypto)) EmptyMK)
-> IO
     (ExtLedgerState
        (HardForkBlock (CardanoEras StandardCrypto)) EmptyMK)
forall a b. (a -> b) -> a -> b
$ ChainDB IO blk -> STM IO (ExtLedgerState blk EmptyMK)
forall (m :: * -> *) blk.
ChainDB m blk -> STM m (ExtLedgerState blk EmptyMK)
Consensus.getCurrentLedger ChainDB IO blk
chainDb
      pure . EraHistory . Consensus.mkInterpreter $
        Consensus.hardForkSummary ledgerConfig (Consensus.ledgerState extLedger)
  BlockType blk
_ -> do
    -- unsupported block type
    Tracer m Text -> Text -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m Text
tracer (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (BlockType blk -> String
forall a. Show a => a -> String
show BlockType blk
blockType)
    Maybe NodeKernelAccess -> m (Maybe NodeKernelAccess)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NodeKernelAccess
forall a. Maybe a
Nothing

-- | Grab the current 'NodeKernelAccess' from the environment, or throw
-- gRPC UNAVAILABLE if the node kernel has not yet initialised.
grabNodeKernelAccess
  :: MonadRpc e m
  => m NodeKernelAccess
grabNodeKernelAccess :: forall e (m :: * -> *). MonadRpc e m => m NodeKernelAccess
grabNodeKernelAccess =
  m (IORef (Maybe NodeKernelAccess))
forall field env (m :: * -> *).
(Has field env, MonadReader env m) =>
m field
grab m (IORef (Maybe NodeKernelAccess))
-> (IORef (Maybe NodeKernelAccess) -> m (Maybe NodeKernelAccess))
-> m (Maybe NodeKernelAccess)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe NodeKernelAccess) -> m (Maybe NodeKernelAccess)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe NodeKernelAccess) -> m (Maybe NodeKernelAccess))
-> (IORef (Maybe NodeKernelAccess) -> IO (Maybe NodeKernelAccess))
-> IORef (Maybe NodeKernelAccess)
-> m (Maybe NodeKernelAccess)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef (Maybe NodeKernelAccess) -> IO (Maybe NodeKernelAccess)
forall a. IORef a -> IO a
readIORef m (Maybe NodeKernelAccess)
-> (Maybe NodeKernelAccess -> m NodeKernelAccess)
-> m NodeKernelAccess
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe NodeKernelAccess
Nothing ->
      GrpcException -> m NodeKernelAccess
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO
        GrpcException
          { grpcError :: GrpcError
grpcError = GrpcError
GrpcUnavailable
          , grpcErrorMessage :: Maybe Text
grpcErrorMessage = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Node kernel not yet initialised"
          , grpcErrorDetails :: Maybe ByteString
grpcErrorDetails = Maybe ByteString
forall a. Maybe a
Nothing
          , grpcErrorMetadata :: [CustomMetadata]
grpcErrorMetadata = []
          }
    Just NodeKernelAccess
nodeKernelAccess ->
      NodeKernelAccess -> m NodeKernelAccess
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeKernelAccess
nodeKernelAccess

-- | Fetch a raw block and its parsed era-contextualised form from ChainDB
-- by slot and header hash.
fetchBlock
  :: MonadIO m
  => NodeKernelAccess
  -- ^ Node kernel access handle
  -> SlotNo
  -- ^ Block slot number
  -> Hash BlockHeader
  -- ^ Block header hash
  -> m (Maybe (ByteString, BlockInMode))
  -- ^ Raw CBOR bytes and the block in era context, or 'Nothing' if not found
fetchBlock :: forall (m :: * -> *).
MonadIO m =>
NodeKernelAccess
-> SlotNo
-> Hash BlockHeader
-> m (Maybe (ByteString, BlockInMode))
fetchBlock NodeKernelAccess{ChainDB IO (HardForkBlock (CardanoEras StandardCrypto))
chainDb :: NodeKernelAccess
-> ChainDB IO (HardForkBlock (CardanoEras StandardCrypto))
chainDb :: ChainDB IO (HardForkBlock (CardanoEras StandardCrypto))
chainDb} SlotNo
slot (HeaderHash ShortByteString
shortHash) = do
  let point :: RealPoint (HardForkBlock (CardanoEras StandardCrypto))
point = SlotNo
-> HeaderHash (HardForkBlock (CardanoEras StandardCrypto))
-> RealPoint (HardForkBlock (CardanoEras StandardCrypto))
forall blk. SlotNo -> HeaderHash blk -> RealPoint blk
Consensus.RealPoint SlotNo
slot (ShortByteString -> OneEraHash (CardanoEras StandardCrypto)
forall k (xs :: [k]). ShortByteString -> OneEraHash xs
Consensus.OneEraHash ShortByteString
shortHash)
      component :: BlockComponent
  (HardForkBlock (CardanoEras StandardCrypto))
  (ByteString, BlockInMode)
component = (,) (ByteString -> BlockInMode -> (ByteString, BlockInMode))
-> BlockComponent
     (HardForkBlock (CardanoEras StandardCrypto)) ByteString
-> BlockComponent
     (HardForkBlock (CardanoEras StandardCrypto))
     (BlockInMode -> (ByteString, BlockInMode))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> ByteString)
-> BlockComponent
     (HardForkBlock (CardanoEras StandardCrypto)) ByteString
-> BlockComponent
     (HardForkBlock (CardanoEras StandardCrypto)) ByteString
forall a b.
(a -> b)
-> BlockComponent (HardForkBlock (CardanoEras StandardCrypto)) a
-> BlockComponent (HardForkBlock (CardanoEras StandardCrypto)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
BSL.toStrict BlockComponent
  (HardForkBlock (CardanoEras StandardCrypto)) ByteString
forall blk. BlockComponent blk ByteString
Consensus.GetRawBlock BlockComponent
  (HardForkBlock (CardanoEras StandardCrypto))
  (BlockInMode -> (ByteString, BlockInMode))
-> BlockComponent
     (HardForkBlock (CardanoEras StandardCrypto)) BlockInMode
-> BlockComponent
     (HardForkBlock (CardanoEras StandardCrypto))
     (ByteString, BlockInMode)
forall a b.
BlockComponent
  (HardForkBlock (CardanoEras StandardCrypto)) (a -> b)
-> BlockComponent (HardForkBlock (CardanoEras StandardCrypto)) a
-> BlockComponent (HardForkBlock (CardanoEras StandardCrypto)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (HardForkBlock (CardanoEras StandardCrypto) -> BlockInMode)
-> BlockComponent
     (HardForkBlock (CardanoEras StandardCrypto))
     (HardForkBlock (CardanoEras StandardCrypto))
-> BlockComponent
     (HardForkBlock (CardanoEras StandardCrypto)) BlockInMode
forall a b.
(a -> b)
-> BlockComponent (HardForkBlock (CardanoEras StandardCrypto)) a
-> BlockComponent (HardForkBlock (CardanoEras StandardCrypto)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HardForkBlock (CardanoEras StandardCrypto) -> BlockInMode
forall block.
(HardForkBlock (CardanoEras StandardCrypto) ~ block) =>
block -> BlockInMode
fromConsensusBlock BlockComponent
  (HardForkBlock (CardanoEras StandardCrypto))
  (HardForkBlock (CardanoEras StandardCrypto))
forall blk. BlockComponent blk blk
Consensus.GetBlock
  IO (Maybe (ByteString, BlockInMode))
-> m (Maybe (ByteString, BlockInMode))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (ByteString, BlockInMode))
 -> m (Maybe (ByteString, BlockInMode)))
-> IO (Maybe (ByteString, BlockInMode))
-> m (Maybe (ByteString, BlockInMode))
forall a b. (a -> b) -> a -> b
$ ChainDB IO (HardForkBlock (CardanoEras StandardCrypto))
-> forall b.
   BlockComponent (HardForkBlock (CardanoEras StandardCrypto)) b
   -> RealPoint (HardForkBlock (CardanoEras StandardCrypto))
   -> IO (Maybe b)
forall (m :: * -> *) blk.
ChainDB m blk
-> forall b. BlockComponent blk b -> RealPoint blk -> m (Maybe b)
Consensus.getBlockComponent ChainDB IO (HardForkBlock (CardanoEras StandardCrypto))
chainDb BlockComponent
  (HardForkBlock (CardanoEras StandardCrypto))
  (ByteString, BlockInMode)
component RealPoint (HardForkBlock (CardanoEras StandardCrypto))
point

-- | A single instruction produced by a chain follower.
--
-- 'ChainApply' carries the raw CBOR block bytes together with the same block
-- parsed into its era context - exactly the pair 'fetchBlock' returns.
-- Consensus rollbacks are point-only: 'ChainRollBack' never carries the
-- blocks being rolled back, only the point to roll back to.
data ChainChange
  = ChainApply (ByteString, BlockInMode)
  | ChainRollBack ChainPoint

-- | A handle to a running chain follower.
data ChainFollower = ChainFollower
  { ChainFollower -> forall (m :: * -> *). MonadIO m => m ChainChange
nextChange :: forall m. MonadIO m => m ChainChange
  -- ^ Block until the next chain update is available.
  , ChainFollower
-> forall (m :: * -> *).
   MonadIO m =>
   [ChainPoint] -> m (Maybe ChainPoint)
findIntersect :: forall m. MonadIO m => [ChainPoint] -> m (Maybe ChainPoint)
  -- ^ Move the follower to the first of the given points found on the
  -- current chain, returning that point, or 'Nothing' if none of them are
  -- on the chain.
  }

-- | Run an action with a 'ChainFollower' tracking the selected chain.
--
-- The follower and the resource registry backing it are closed on every
-- exit path, including exceptions. The follower itself runs in 'IO',
-- because the ChainDB handle is monomorphic, so the bracket runs there and
-- the action is unlifted into it.
--
-- Creating a follower is cheap: a few in-memory STM operations, nothing
-- proportional to chain length. The costs are steady-state instead. A
-- caught-up follower receives an O(1) notification per adopted block. A
-- follower catching up streams blocks from the ImmutableDB, paying a disk
-- read and a deserialisation per block, with file handles owned by the
-- registry. The node already runs one such follower per connected N2C
-- ChainSync client, so one follower per stream scales the same way.
withFollower
  :: MonadUnliftIO m
  => NodeKernelAccess
  -> (ChainFollower -> m a)
  -> m a
withFollower :: forall (m :: * -> *) a.
MonadUnliftIO m =>
NodeKernelAccess -> (ChainFollower -> m a) -> m a
withFollower NodeKernelAccess{ChainDB IO (HardForkBlock (CardanoEras StandardCrypto))
chainDb :: NodeKernelAccess
-> ChainDB IO (HardForkBlock (CardanoEras StandardCrypto))
chainDb :: ChainDB IO (HardForkBlock (CardanoEras StandardCrypto))
chainDb} ChainFollower -> m a
action =
  ((forall a. m a -> IO a) -> IO a) -> m a
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO ->
    (ResourceRegistry IO -> IO a) -> IO a
forall (m :: * -> *) a.
(MonadSTM m, MonadMask m, MonadThread m, HasCallStack) =>
(ResourceRegistry m -> m a) -> m a
Consensus.withRegistry ((ResourceRegistry IO -> IO a) -> IO a)
-> (ResourceRegistry IO -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ResourceRegistry IO
registry ->
      IO
  (Follower
     IO
     (HardForkBlock (CardanoEras StandardCrypto))
     (ByteString, BlockInMode))
-> (Follower
      IO
      (HardForkBlock (CardanoEras StandardCrypto))
      (ByteString, BlockInMode)
    -> IO ())
-> (Follower
      IO
      (HardForkBlock (CardanoEras StandardCrypto))
      (ByteString, BlockInMode)
    -> IO a)
-> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
        (ChainDB IO (HardForkBlock (CardanoEras StandardCrypto))
-> forall b.
   ResourceRegistry IO
   -> ChainType
   -> BlockComponent (HardForkBlock (CardanoEras StandardCrypto)) b
   -> IO (Follower IO (HardForkBlock (CardanoEras StandardCrypto)) b)
forall (m :: * -> *) blk.
ChainDB m blk
-> forall b.
   ResourceRegistry m
   -> ChainType -> BlockComponent blk b -> m (Follower m blk b)
Consensus.newFollower ChainDB IO (HardForkBlock (CardanoEras StandardCrypto))
chainDb ResourceRegistry IO
registry ChainType
Consensus.SelectedChain BlockComponent
  (HardForkBlock (CardanoEras StandardCrypto))
  (ByteString, BlockInMode)
component)
        Follower
  IO
  (HardForkBlock (CardanoEras StandardCrypto))
  (ByteString, BlockInMode)
-> IO ()
forall (m :: * -> *) blk a. Follower m blk a -> m ()
Consensus.followerClose
        (m a -> IO a
forall a. m a -> IO a
runInIO (m a -> IO a)
-> (Follower
      IO
      (HardForkBlock (CardanoEras StandardCrypto))
      (ByteString, BlockInMode)
    -> m a)
-> Follower
     IO
     (HardForkBlock (CardanoEras StandardCrypto))
     (ByteString, BlockInMode)
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainFollower -> m a
action (ChainFollower -> m a)
-> (Follower
      IO
      (HardForkBlock (CardanoEras StandardCrypto))
      (ByteString, BlockInMode)
    -> ChainFollower)
-> Follower
     IO
     (HardForkBlock (CardanoEras StandardCrypto))
     (ByteString, BlockInMode)
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Follower
  IO
  (HardForkBlock (CardanoEras StandardCrypto))
  (ByteString, BlockInMode)
-> ChainFollower
toChainFollower)
 where
  component
    :: Consensus.BlockComponent
         (Consensus.CardanoBlock Consensus.StandardCrypto)
         (ByteString, BlockInMode)
  component :: BlockComponent
  (HardForkBlock (CardanoEras StandardCrypto))
  (ByteString, BlockInMode)
component =
    (,) (ByteString -> BlockInMode -> (ByteString, BlockInMode))
-> BlockComponent
     (HardForkBlock (CardanoEras StandardCrypto)) ByteString
-> BlockComponent
     (HardForkBlock (CardanoEras StandardCrypto))
     (BlockInMode -> (ByteString, BlockInMode))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> ByteString)
-> BlockComponent
     (HardForkBlock (CardanoEras StandardCrypto)) ByteString
-> BlockComponent
     (HardForkBlock (CardanoEras StandardCrypto)) ByteString
forall a b.
(a -> b)
-> BlockComponent (HardForkBlock (CardanoEras StandardCrypto)) a
-> BlockComponent (HardForkBlock (CardanoEras StandardCrypto)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
BSL.toStrict BlockComponent
  (HardForkBlock (CardanoEras StandardCrypto)) ByteString
forall blk. BlockComponent blk ByteString
Consensus.GetRawBlock BlockComponent
  (HardForkBlock (CardanoEras StandardCrypto))
  (BlockInMode -> (ByteString, BlockInMode))
-> BlockComponent
     (HardForkBlock (CardanoEras StandardCrypto)) BlockInMode
-> BlockComponent
     (HardForkBlock (CardanoEras StandardCrypto))
     (ByteString, BlockInMode)
forall a b.
BlockComponent
  (HardForkBlock (CardanoEras StandardCrypto)) (a -> b)
-> BlockComponent (HardForkBlock (CardanoEras StandardCrypto)) a
-> BlockComponent (HardForkBlock (CardanoEras StandardCrypto)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (HardForkBlock (CardanoEras StandardCrypto) -> BlockInMode)
-> BlockComponent
     (HardForkBlock (CardanoEras StandardCrypto))
     (HardForkBlock (CardanoEras StandardCrypto))
-> BlockComponent
     (HardForkBlock (CardanoEras StandardCrypto)) BlockInMode
forall a b.
(a -> b)
-> BlockComponent (HardForkBlock (CardanoEras StandardCrypto)) a
-> BlockComponent (HardForkBlock (CardanoEras StandardCrypto)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HardForkBlock (CardanoEras StandardCrypto) -> BlockInMode
forall block.
(HardForkBlock (CardanoEras StandardCrypto) ~ block) =>
block -> BlockInMode
fromConsensusBlock BlockComponent
  (HardForkBlock (CardanoEras StandardCrypto))
  (HardForkBlock (CardanoEras StandardCrypto))
forall blk. BlockComponent blk blk
Consensus.GetBlock

  toChainFollower
    :: Consensus.Follower
         IO
         (Consensus.CardanoBlock Consensus.StandardCrypto)
         (ByteString, BlockInMode)
    -> ChainFollower
  toChainFollower :: Follower
  IO
  (HardForkBlock (CardanoEras StandardCrypto))
  (ByteString, BlockInMode)
-> ChainFollower
toChainFollower Follower
  IO
  (HardForkBlock (CardanoEras StandardCrypto))
  (ByteString, BlockInMode)
follower =
    ChainFollower
      { nextChange :: forall (m :: * -> *). MonadIO m => m ChainChange
nextChange = IO ChainChange -> m ChainChange
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChainChange -> m ChainChange)
-> IO ChainChange -> m ChainChange
forall a b. (a -> b) -> a -> b
$ ChainUpdate
  (HardForkBlock (CardanoEras StandardCrypto))
  (ByteString, BlockInMode)
-> ChainChange
toChainChange (ChainUpdate
   (HardForkBlock (CardanoEras StandardCrypto))
   (ByteString, BlockInMode)
 -> ChainChange)
-> IO
     (ChainUpdate
        (HardForkBlock (CardanoEras StandardCrypto))
        (ByteString, BlockInMode))
-> IO ChainChange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Follower
  IO
  (HardForkBlock (CardanoEras StandardCrypto))
  (ByteString, BlockInMode)
-> IO
     (ChainUpdate
        (HardForkBlock (CardanoEras StandardCrypto))
        (ByteString, BlockInMode))
forall (m :: * -> *) blk a.
Follower m blk a -> m (ChainUpdate blk a)
Consensus.followerInstructionBlocking Follower
  IO
  (HardForkBlock (CardanoEras StandardCrypto))
  (ByteString, BlockInMode)
follower
      , findIntersect :: forall (m :: * -> *).
MonadIO m =>
[ChainPoint] -> m (Maybe ChainPoint)
findIntersect = \[ChainPoint]
points ->
          IO (Maybe ChainPoint) -> m (Maybe ChainPoint)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ChainPoint) -> m (Maybe ChainPoint))
-> IO (Maybe ChainPoint) -> m (Maybe ChainPoint)
forall a b. (a -> b) -> a -> b
$
            (Point (HardForkBlock (CardanoEras StandardCrypto)) -> ChainPoint)
-> Maybe (Point (HardForkBlock (CardanoEras StandardCrypto)))
-> Maybe ChainPoint
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point (HardForkBlock (CardanoEras StandardCrypto)) -> ChainPoint
forall block (xs :: [*]).
(HeaderHash block ~ OneEraHash xs) =>
Point block -> ChainPoint
fromConsensusPointHF
              (Maybe (Point (HardForkBlock (CardanoEras StandardCrypto)))
 -> Maybe ChainPoint)
-> IO (Maybe (Point (HardForkBlock (CardanoEras StandardCrypto))))
-> IO (Maybe ChainPoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Follower
  IO
  (HardForkBlock (CardanoEras StandardCrypto))
  (ByteString, BlockInMode)
-> [Point (HardForkBlock (CardanoEras StandardCrypto))]
-> IO (Maybe (Point (HardForkBlock (CardanoEras StandardCrypto))))
forall (m :: * -> *) blk a.
Follower m blk a -> [Point blk] -> m (Maybe (Point blk))
Consensus.followerForward Follower
  IO
  (HardForkBlock (CardanoEras StandardCrypto))
  (ByteString, BlockInMode)
follower ((ChainPoint -> Point (HardForkBlock (CardanoEras StandardCrypto)))
-> [ChainPoint]
-> [Point (HardForkBlock (CardanoEras StandardCrypto))]
forall a b. (a -> b) -> [a] -> [b]
map ChainPoint -> Point (HardForkBlock (CardanoEras StandardCrypto))
forall block (xs :: [*]).
(HeaderHash block ~ OneEraHash xs) =>
ChainPoint -> Point block
toConsensusPointHF [ChainPoint]
points)
      }

  toChainChange
    :: Consensus.ChainUpdate
         (Consensus.CardanoBlock Consensus.StandardCrypto)
         (ByteString, BlockInMode)
    -> ChainChange
  toChainChange :: ChainUpdate
  (HardForkBlock (CardanoEras StandardCrypto))
  (ByteString, BlockInMode)
-> ChainChange
toChainChange = \case
    Consensus.AddBlock (ByteString, BlockInMode)
rawBlock -> (ByteString, BlockInMode) -> ChainChange
ChainApply (ByteString, BlockInMode)
rawBlock
    Consensus.RollBack Point (HardForkBlock (CardanoEras StandardCrypto))
point -> ChainPoint -> ChainChange
ChainRollBack (Point (HardForkBlock (CardanoEras StandardCrypto)) -> ChainPoint
forall block (xs :: [*]).
(HeaderHash block ~ OneEraHash xs) =>
Point block -> ChainPoint
fromConsensusPointHF Point (HardForkBlock (CardanoEras StandardCrypto))
point)