{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE TypeOperators       #-}

{-| Let's start with the big picture...

@
Key:  ┏━━━━━━━━━━━━┓  ╔═════════════╗  ┏━━━━━━━━━━━━━━┓   ╔════════════╗
      ┃ STM-based  ┃  ║active thread║  ┃state instance┃┓  ║ one thread ║╗
      ┃shared state┃  ║             ║  ┃   per peer   ┃┃  ║  per peer  ║║
      ┗━━━━━━━━━━━━┛  ╚═════════════╝  ┗━━━━━━━━━━━━━━┛┃  ╚════════════╝║
                                        ┗━━━━━━━━━━━━━━┛   ╚════════════╝
@

@
  ╔═════════════╗     ┏━━━━━━━━━━━━━┓
  ║ Chain sync  ║╗    ┃   Ledger    ┃
  ║  protocol   ║║◀───┨   state     ┃◀───────────╮
  ║(client side)║║    ┃             ┃            │
  ╚══════╤══════╝║    ┗━━━━━━━━━━━━━┛            │
   ╚═════╪═══════╝                               │
         ▼                                       │
  ┏━━━━━━━━━━━━━┓     ┏━━━━━━━━━━━━━┓     ╔══════╧══════╗
  ┃  Candidate  ┃     ┃   Set of    ┃     ║  Chain and  ║
  ┃  chains     ┃     ┃  downloaded ┠────▶║   ledger    ║
  ┃  (headers)  ┃     ┃   blocks    ┃     ║  validation ║
  ┗━━━━━┯━━━━━━━┛     ┗━━━━━┯━━━━━━━┛     ╚══════╤══════╝
        │                   │ ▲                  │
        │ ╭─────────────────╯ │                  │
░░░░░░░░▼░▼░░░░░░░░           │                  ▼
░░╔═════════════╗░░           │           ┏━━━━━━━━━━━━━┓     ╔═════════════╗
░░║    Block    ║░░           │           ┃   Current   ┃     ║ Block fetch ║╗
░░╢    fetch    ║◀────────────┼───────────┨    chain    ┠────▶║ protocol    ║║
░░║    logic    ║░░           │           ┃  (blocks)   ┃     ║(server side)║║
░░╚═════════════╝░░           │           ┠─────────────┨     ╚═════════════╝║
░░░░░░░░░▲░░░░░░░░░           │           ┃  Tentative  ┃      ╚═════════════╝
░░░░░░░░░▼░░░░░░░░░░░░░░░░░░░░│░░░░░░░░   ┃    chain    ┠──╮
░░┏━━━━━━━━━━━━━┓░░░░░╔═══════╧═════╗░░   ┃  (headers)  ┃  │  ╔═════════════╗
░░┃ Block fetch ┃┓░░░░║ block fetch ║╗░   ┗━━━━━━━━━━━━━┛  │  ║ Chain sync  ║╗
░░┃  state and  ┃┃◀──▶║  protocol   ║║░                    ╰─▶║ protocol    ║║
░░┃  requests   ┃┃░░░░║(client side)║║░                       ║(server side)║║
░░┗━━━━━━━━━━━━━┛┃░░░░╚═════════════╝║░                       ╚═════════════╝║
░░░┗━━━━━━━━━━━━━┛░░░░░╚═════════════╝░                        ╚═════════════╝
░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░
@
Notes:

 * Thread communication is via STM based state.
 * Outbound: threads update STM state.
 * Inbound: threads wait on STM state changing (using retry).
 * These are no queues: there is only the current state, not all change events.

We consider the block fetch logic and the policy for the block fetch protocol
client together as one unit of functionality. This is the shaded area in the
diagram.

Looking at the diagram we see that these two threads interact with each other
and other threads via the following shared state

+-----------------------------+----------------+--------------------+
|  State                      |  Interactions  | Internal\/External |
+=============================+================+====================+
|  Candidate chains (headers) |  Read          |  External          |
+-----------------------------+----------------+--------------------+
|  Current chain (blocks)     |  Read          |  External          |
+-----------------------------+----------------+--------------------+
|  Set of downloaded blocks   |  Read & Write  |  External          |
+-----------------------------+----------------+--------------------+
|  Block fetch requests       |  Read & Write  |  Internal          |
+-----------------------------+----------------+--------------------+

The block fetch requests state is private between the block fetch logic
and the block fetch protocol client, so it is implemented here.

The other state is managed by the consensus layer and is considered external
here. So here we define interfaces for interacting with the external state.
These have to be provided when instantiating the block fetch logic.

-}
module Ouroboros.Network.BlockFetch
  ( blockFetchLogic
  , BlockFetchConfiguration (..)
  , BlockFetchConsensusInterface (..)
  , GenesisBlockFetchConfiguration (..)
    -- ** Tracer types
  , FetchDecision
  , TraceFetchClientState (..)
  , TraceLabelPeer (..)
    -- * The 'FetchClientRegistry'
  , FetchClientRegistry
  , newFetchClientRegistry
  , bracketFetchClient
  , bracketSyncWithFetchClient
    -- * The 'KeepAliveRegistry'
  , KeepAliveRegistry
  , newKeepAliveRegistry
  , bracketKeepAliveClient
    -- * Re-export types used by 'BlockFetchConsensusInterface'
  , PraosFetchMode (..)
  , FetchMode (..)
  , ChainComparison (..)
  , SizeInBytes
  ) where

import Data.Void

import Control.Monad.Class.MonadSTM
import Control.Monad.Class.MonadTime.SI
import Control.Monad.Class.MonadTimer.SI
import Control.Tracer (Tracer)

import GHC.Generics (Generic)

import Ouroboros.Network.Block
import Ouroboros.Network.Hashable
import Ouroboros.Network.SizeInBytes (SizeInBytes)

import Ouroboros.Network.BlockFetch.ClientRegistry (FetchClientPolicy (..),
           FetchClientRegistry, KeepAliveRegistry, bracketFetchClient,
           bracketKeepAliveClient, bracketSyncWithFetchClient,
           newFetchClientRegistry, newKeepAliveRegistry,
           readFetchClientsStateVars, readFetchClientsStatus, readPeerGSVs,
           setFetchClientContext)
import Ouroboros.Network.BlockFetch.ConsensusInterface
           (BlockFetchConsensusInterface (..), ChainComparison (..))
import Ouroboros.Network.BlockFetch.Decision.Trace (TraceDecisionEvent)
import Ouroboros.Network.BlockFetch.State


-- | Configuration for FetchDecisionPolicy.
-- Should be determined by external local node config.
data BlockFetchConfiguration =
     BlockFetchConfiguration {
         -- | Maximum concurrent downloads during bulk syncing.
         BlockFetchConfiguration -> Word
bfcMaxConcurrencyBulkSync      :: !Word,

         -- | Maximum concurrent downloads during deadline syncing.
         BlockFetchConfiguration -> Word
bfcMaxConcurrencyDeadline      :: !Word,

         -- | Maximum requests in flight per each peer.
         BlockFetchConfiguration -> Word
bfcMaxRequestsInflight         :: !Word,

         -- | Desired interval between calls to fetchLogicIteration
         -- in Genesis fetch mode
         BlockFetchConfiguration -> DiffTime
bfcDecisionLoopIntervalGenesis :: !DiffTime,

         -- | Desired interval between calls to fetchLogicIteration
         -- in Praos fetch modes
         BlockFetchConfiguration -> DiffTime
bfcDecisionLoopIntervalPraos   :: !DiffTime,

         -- | Salt used when comparing peers
         BlockFetchConfiguration -> Salt
bfcSalt                        :: !Salt,

         -- | Genesis-specific parameters
         BlockFetchConfiguration -> GenesisBlockFetchConfiguration
bfcGenesisBFConfig             :: !GenesisBlockFetchConfiguration
     }
     deriving (Int -> BlockFetchConfiguration -> ShowS
[BlockFetchConfiguration] -> ShowS
BlockFetchConfiguration -> String
(Int -> BlockFetchConfiguration -> ShowS)
-> (BlockFetchConfiguration -> String)
-> ([BlockFetchConfiguration] -> ShowS)
-> Show BlockFetchConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockFetchConfiguration -> ShowS
showsPrec :: Int -> BlockFetchConfiguration -> ShowS
$cshow :: BlockFetchConfiguration -> String
show :: BlockFetchConfiguration -> String
$cshowList :: [BlockFetchConfiguration] -> ShowS
showList :: [BlockFetchConfiguration] -> ShowS
Show)

-- | BlockFetch configuration parameters specific to Genesis.
data GenesisBlockFetchConfiguration =
     GenesisBlockFetchConfiguration
      { -- | Grace period when starting to talk to a peer in genesis mode
        -- during which it is fine if the chain selection gets starved.
        GenesisBlockFetchConfiguration -> DiffTime
gbfcGracePeriod :: !DiffTime
      }
      deriving (GenesisBlockFetchConfiguration
-> GenesisBlockFetchConfiguration -> Bool
(GenesisBlockFetchConfiguration
 -> GenesisBlockFetchConfiguration -> Bool)
-> (GenesisBlockFetchConfiguration
    -> GenesisBlockFetchConfiguration -> Bool)
-> Eq GenesisBlockFetchConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenesisBlockFetchConfiguration
-> GenesisBlockFetchConfiguration -> Bool
== :: GenesisBlockFetchConfiguration
-> GenesisBlockFetchConfiguration -> Bool
$c/= :: GenesisBlockFetchConfiguration
-> GenesisBlockFetchConfiguration -> Bool
/= :: GenesisBlockFetchConfiguration
-> GenesisBlockFetchConfiguration -> Bool
Eq, (forall x.
 GenesisBlockFetchConfiguration
 -> Rep GenesisBlockFetchConfiguration x)
-> (forall x.
    Rep GenesisBlockFetchConfiguration x
    -> GenesisBlockFetchConfiguration)
-> Generic GenesisBlockFetchConfiguration
forall x.
Rep GenesisBlockFetchConfiguration x
-> GenesisBlockFetchConfiguration
forall x.
GenesisBlockFetchConfiguration
-> Rep GenesisBlockFetchConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GenesisBlockFetchConfiguration
-> Rep GenesisBlockFetchConfiguration x
from :: forall x.
GenesisBlockFetchConfiguration
-> Rep GenesisBlockFetchConfiguration x
$cto :: forall x.
Rep GenesisBlockFetchConfiguration x
-> GenesisBlockFetchConfiguration
to :: forall x.
Rep GenesisBlockFetchConfiguration x
-> GenesisBlockFetchConfiguration
Generic, Int -> GenesisBlockFetchConfiguration -> ShowS
[GenesisBlockFetchConfiguration] -> ShowS
GenesisBlockFetchConfiguration -> String
(Int -> GenesisBlockFetchConfiguration -> ShowS)
-> (GenesisBlockFetchConfiguration -> String)
-> ([GenesisBlockFetchConfiguration] -> ShowS)
-> Show GenesisBlockFetchConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenesisBlockFetchConfiguration -> ShowS
showsPrec :: Int -> GenesisBlockFetchConfiguration -> ShowS
$cshow :: GenesisBlockFetchConfiguration -> String
show :: GenesisBlockFetchConfiguration -> String
$cshowList :: [GenesisBlockFetchConfiguration] -> ShowS
showList :: [GenesisBlockFetchConfiguration] -> ShowS
Show)

-- | Execute the block fetch logic. It monitors the current chain and candidate
-- chains. It decided which block bodies to fetch and manages the process of
-- fetching them, including making alternative decisions based on timeouts and
-- failures.
--
-- This runs forever and should be shut down using mechanisms such as async.
--
blockFetchLogic :: forall addr header block matchedBlock m.
                   ( HasHeader header
                   , HasHeader block
                   , HeaderHash header ~ HeaderHash block
                   , MonadDelay m
                   , MonadTimer m
                   , Ord addr
                   , Hashable addr
                   )
                => Tracer m (TraceDecisionEvent addr header)
                -> Tracer m (TraceLabelPeer addr (TraceFetchClientState header))
                -> BlockFetchConsensusInterface addr header block matchedBlock m
                -> FetchClientRegistry addr header block matchedBlock m
                -> KeepAliveRegistry addr m
                -> BlockFetchConfiguration
                -> m Void
blockFetchLogic :: forall addr header block matchedBlock (m :: * -> *).
(HasHeader header, HasHeader block,
 HeaderHash header ~ HeaderHash block, MonadDelay m, MonadTimer m,
 Ord addr, Hashable addr) =>
Tracer m (TraceDecisionEvent addr header)
-> Tracer m (TraceLabelPeer addr (TraceFetchClientState header))
-> BlockFetchConsensusInterface addr header block matchedBlock m
-> FetchClientRegistry addr header block matchedBlock m
-> KeepAliveRegistry addr m
-> BlockFetchConfiguration
-> m Void
blockFetchLogic Tracer m (TraceDecisionEvent addr header)
decisionTracer Tracer m (TraceLabelPeer addr (TraceFetchClientState header))
clientStateTracer
                BlockFetchConsensusInterface{STM m (Map addr (AnchoredFragment header))
STM m MaxSlotNo
STM m (AnchoredFragment header)
STM m FetchMode
STM m ChainSelStarvation
STM m (WithFingerprint (ChainComparison header))
STM m (Point block -> Bool)
STM m (Point block -> matchedBlock -> m ())
addr -> m ()
header -> UTCTime
header -> SizeInBytes
header -> block -> Maybe matchedBlock
readCandidateChains :: STM m (Map addr (AnchoredFragment header))
readCurrentChain :: STM m (AnchoredFragment header)
readFetchMode :: STM m FetchMode
readFetchedBlocks :: STM m (Point block -> Bool)
mkAddFetchedBlock :: STM m (Point block -> matchedBlock -> m ())
readFetchedMaxSlotNo :: STM m MaxSlotNo
readChainComparison :: STM m (WithFingerprint (ChainComparison header))
blockFetchSize :: header -> SizeInBytes
blockMatchesHeader :: header -> block -> Maybe matchedBlock
headerForgeUTCTime :: header -> UTCTime
readChainSelStarvation :: STM m ChainSelStarvation
demoteChainSyncJumpingDynamo :: addr -> m ()
blockFetchSize :: forall peer header block matchedBlock (m :: * -> *).
BlockFetchConsensusInterface peer header block matchedBlock m
-> header -> SizeInBytes
blockMatchesHeader :: forall peer header block matchedBlock (m :: * -> *).
BlockFetchConsensusInterface peer header block matchedBlock m
-> header -> block -> Maybe matchedBlock
demoteChainSyncJumpingDynamo :: forall peer header block matchedBlock (m :: * -> *).
BlockFetchConsensusInterface peer header block matchedBlock m
-> peer -> m ()
headerForgeUTCTime :: forall peer header block matchedBlock (m :: * -> *).
BlockFetchConsensusInterface peer header block matchedBlock m
-> header -> UTCTime
mkAddFetchedBlock :: forall peer header block matchedBlock (m :: * -> *).
BlockFetchConsensusInterface peer header block matchedBlock m
-> STM m (Point block -> matchedBlock -> m ())
readCandidateChains :: forall peer header block matchedBlock (m :: * -> *).
BlockFetchConsensusInterface peer header block matchedBlock m
-> STM m (Map peer (AnchoredFragment header))
readChainComparison :: forall peer header block matchedBlock (m :: * -> *).
BlockFetchConsensusInterface peer header block matchedBlock m
-> STM m (WithFingerprint (ChainComparison header))
readChainSelStarvation :: forall peer header block matchedBlock (m :: * -> *).
BlockFetchConsensusInterface peer header block matchedBlock m
-> STM m ChainSelStarvation
readCurrentChain :: forall peer header block matchedBlock (m :: * -> *).
BlockFetchConsensusInterface peer header block matchedBlock m
-> STM m (AnchoredFragment header)
readFetchMode :: forall peer header block matchedBlock (m :: * -> *).
BlockFetchConsensusInterface peer header block matchedBlock m
-> STM m FetchMode
readFetchedBlocks :: forall peer header block matchedBlock (m :: * -> *).
BlockFetchConsensusInterface peer header block matchedBlock m
-> STM m (Point block -> Bool)
readFetchedMaxSlotNo :: forall peer header block matchedBlock (m :: * -> *).
BlockFetchConsensusInterface peer header block matchedBlock m
-> STM m MaxSlotNo
..}
                FetchClientRegistry addr header block matchedBlock m
blockFetchRegistry
                KeepAliveRegistry addr m
keepAliveRegistry
                BlockFetchConfiguration{Word
DiffTime
Salt
GenesisBlockFetchConfiguration
bfcMaxConcurrencyBulkSync :: BlockFetchConfiguration -> Word
bfcMaxConcurrencyDeadline :: BlockFetchConfiguration -> Word
bfcMaxRequestsInflight :: BlockFetchConfiguration -> Word
bfcDecisionLoopIntervalGenesis :: BlockFetchConfiguration -> DiffTime
bfcDecisionLoopIntervalPraos :: BlockFetchConfiguration -> DiffTime
bfcSalt :: BlockFetchConfiguration -> Salt
bfcGenesisBFConfig :: BlockFetchConfiguration -> GenesisBlockFetchConfiguration
bfcMaxConcurrencyBulkSync :: Word
bfcMaxConcurrencyDeadline :: Word
bfcMaxRequestsInflight :: Word
bfcDecisionLoopIntervalGenesis :: DiffTime
bfcDecisionLoopIntervalPraos :: DiffTime
bfcSalt :: Salt
bfcGenesisBFConfig :: GenesisBlockFetchConfiguration
..} = do

    FetchClientRegistry addr header block matchedBlock m
-> Tracer m (TraceLabelPeer addr (TraceFetchClientState header))
-> STM m (FetchClientPolicy header block matchedBlock m)
-> m ()
forall (m :: * -> *) peer header block matchedBlock.
MonadSTM m =>
FetchClientRegistry peer header block matchedBlock m
-> Tracer m (TraceLabelPeer peer (TraceFetchClientState header))
-> STM m (FetchClientPolicy header block matchedBlock m)
-> m ()
setFetchClientContext FetchClientRegistry addr header block matchedBlock m
blockFetchRegistry Tracer m (TraceLabelPeer addr (TraceFetchClientState header))
clientStateTracer STM m (FetchClientPolicy header block matchedBlock m)
mkFetchClientPolicy

    Tracer m (TraceDecisionEvent addr header)
-> Tracer m (TraceLabelPeer addr (TraceFetchClientState header))
-> FetchDecisionPolicy header
-> FetchTriggerVariables addr header m
-> FetchNonTriggerVariables addr header block m
-> (addr -> m ())
-> m Void
forall header block (m :: * -> *) peer.
(HasHeader header, HasHeader block,
 HeaderHash header ~ HeaderHash block, MonadDelay m, MonadTimer m,
 Ord peer, Hashable peer) =>
Tracer m (TraceDecisionEvent peer header)
-> Tracer m (TraceLabelPeer peer (TraceFetchClientState header))
-> FetchDecisionPolicy header
-> FetchTriggerVariables peer header m
-> FetchNonTriggerVariables peer header block m
-> (peer -> m ())
-> m Void
fetchLogicIterations
      Tracer m (TraceDecisionEvent addr header)
decisionTracer Tracer m (TraceLabelPeer addr (TraceFetchClientState header))
clientStateTracer
      FetchDecisionPolicy header
fetchDecisionPolicy
      FetchTriggerVariables addr header m
fetchTriggerVariables
      FetchNonTriggerVariables addr header block m
fetchNonTriggerVariables
      addr -> m ()
demoteChainSyncJumpingDynamo
  where
    mkFetchClientPolicy :: STM m (FetchClientPolicy header block matchedBlock m)
    mkFetchClientPolicy :: STM m (FetchClientPolicy header block matchedBlock m)
mkFetchClientPolicy = do
      addFetchedBlock <- STM m (Point block -> matchedBlock -> m ())
mkAddFetchedBlock
      pure FetchClientPolicy {
          blockFetchSize,
          blockMatchesHeader,
          addFetchedBlock,
          headerForgeUTCTime
        }

    fetchDecisionPolicy :: FetchDecisionPolicy header
    fetchDecisionPolicy :: FetchDecisionPolicy header
fetchDecisionPolicy =
      FetchDecisionPolicy {
        maxInFlightReqsPerPeer :: Word
maxInFlightReqsPerPeer      = Word
bfcMaxRequestsInflight,
        maxConcurrencyBulkSync :: Word
maxConcurrencyBulkSync      = Word
bfcMaxConcurrencyBulkSync,
        maxConcurrencyDeadline :: Word
maxConcurrencyDeadline      = Word
bfcMaxConcurrencyDeadline,
        decisionLoopIntervalGenesis :: DiffTime
decisionLoopIntervalGenesis = DiffTime
bfcDecisionLoopIntervalGenesis,
        decisionLoopIntervalPraos :: DiffTime
decisionLoopIntervalPraos   = DiffTime
bfcDecisionLoopIntervalPraos,
        peerSalt :: Salt
peerSalt                    = Salt
bfcSalt,
        bulkSyncGracePeriod :: DiffTime
bulkSyncGracePeriod         = GenesisBlockFetchConfiguration -> DiffTime
gbfcGracePeriod GenesisBlockFetchConfiguration
bfcGenesisBFConfig,

        header -> SizeInBytes
blockFetchSize :: header -> SizeInBytes
blockFetchSize :: header -> SizeInBytes
blockFetchSize
      }

    fetchTriggerVariables :: FetchTriggerVariables addr header m
    fetchTriggerVariables :: FetchTriggerVariables addr header m
fetchTriggerVariables =
      FetchTriggerVariables {
        readStateCurrentChain :: STM m (AnchoredFragment header)
readStateCurrentChain    = STM m (AnchoredFragment header)
readCurrentChain,
        readStateCandidateChains :: STM m (Map addr (AnchoredFragment header))
readStateCandidateChains = STM m (Map addr (AnchoredFragment header))
readCandidateChains,
        readStatePeerStatus :: STM m (Map addr (PeerFetchStatus header))
readStatePeerStatus      = FetchClientRegistry addr header block matchedBlock m
-> STM m (Map addr (PeerFetchStatus header))
forall (m :: * -> *) peer header block matchedBlock.
MonadSTM m =>
FetchClientRegistry peer header block matchedBlock m
-> STM m (Map peer (PeerFetchStatus header))
readFetchClientsStatus FetchClientRegistry addr header block matchedBlock m
blockFetchRegistry,
        readStateChainComparison :: STM m (WithFingerprint (ChainComparison header))
readStateChainComparison = STM m (WithFingerprint (ChainComparison header))
readChainComparison
      }

    fetchNonTriggerVariables :: FetchNonTriggerVariables addr header block m
    fetchNonTriggerVariables :: FetchNonTriggerVariables addr header block m
fetchNonTriggerVariables =
      FetchNonTriggerVariables {
        readStateFetchedBlocks :: STM m (Point block -> Bool)
readStateFetchedBlocks      = STM m (Point block -> Bool)
readFetchedBlocks,
        readStatePeerStateVars :: STM m (Map addr (FetchClientStateVars m header))
readStatePeerStateVars      = FetchClientRegistry addr header block matchedBlock m
-> STM m (Map addr (FetchClientStateVars m header))
forall (m :: * -> *) peer header block matchedBlock.
MonadSTM m =>
FetchClientRegistry peer header block matchedBlock m
-> STM m (Map peer (FetchClientStateVars m header))
readFetchClientsStateVars FetchClientRegistry addr header block matchedBlock m
blockFetchRegistry,
        readStatePeerGSVs :: STM m (Map addr PeerGSV)
readStatePeerGSVs           = KeepAliveRegistry addr m -> STM m (Map addr PeerGSV)
forall (m :: * -> *) peer.
(MonadSTM m, Ord peer) =>
KeepAliveRegistry peer m -> STM m (Map peer PeerGSV)
readPeerGSVs KeepAliveRegistry addr m
keepAliveRegistry,
        readStateFetchMode :: STM m FetchMode
readStateFetchMode          = STM m FetchMode
readFetchMode,
        readStateFetchedMaxSlotNo :: STM m MaxSlotNo
readStateFetchedMaxSlotNo   = STM m MaxSlotNo
readFetchedMaxSlotNo,
        readStateChainSelStarvation :: STM m ChainSelStarvation
readStateChainSelStarvation = STM m ChainSelStarvation
readChainSelStarvation
      }