{-# 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
  , bracketKeepAliveClient
    -- * Re-export types used by 'BlockFetchConsensusInterface'
  , PraosFetchMode (..)
  , FetchMode (..)
  , FromConsensus (..)
  , SizeInBytes
  ) where

import Data.Hashable (Hashable)
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.SizeInBytes (SizeInBytes)

import Ouroboros.Network.BlockFetch.ClientRegistry (FetchClientPolicy (..),
           FetchClientRegistry, bracketFetchClient, bracketKeepAliveClient,
           bracketSyncWithFetchClient, newFetchClientRegistry,
           readFetchClientsStateVars, readFetchClientsStatus, readPeerGSVs,
           setFetchClientContext)
import Ouroboros.Network.BlockFetch.ConsensusInterface
           (BlockFetchConsensusInterface (..), FromConsensus (..))
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 -> Int
bfcSalt                        :: !Int,

         -- | 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 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 m
                -> FetchClientRegistry addr header block m
                -> BlockFetchConfiguration
                -> m Void
blockFetchLogic :: forall addr header block (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 m
-> FetchClientRegistry addr header block 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 (AnchoredFragment header)
STM m MaxSlotNo
STM m ChainSelStarvation
STM m FetchMode
STM m (Point block -> Bool)
STM m (Point block -> block -> m ())
addr -> m ()
header -> SizeInBytes
header -> block -> Bool
HasCallStack =>
AnchoredFragment header -> AnchoredFragment header -> Bool
HasCallStack =>
AnchoredFragment header -> AnchoredFragment header -> Ordering
FromConsensus header -> STM m UTCTime
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 -> block -> m ())
readFetchedMaxSlotNo :: STM m MaxSlotNo
plausibleCandidateChain :: HasCallStack =>
AnchoredFragment header -> AnchoredFragment header -> Bool
compareCandidateChains :: HasCallStack =>
AnchoredFragment header -> AnchoredFragment header -> Ordering
blockFetchSize :: header -> SizeInBytes
blockMatchesHeader :: header -> block -> Bool
headerForgeUTCTime :: FromConsensus header -> STM m UTCTime
readChainSelStarvation :: STM m ChainSelStarvation
demoteChainSyncJumpingDynamo :: addr -> m ()
blockFetchSize :: forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> header -> SizeInBytes
blockMatchesHeader :: forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> header -> block -> Bool
compareCandidateChains :: forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> HasCallStack =>
   AnchoredFragment header -> AnchoredFragment header -> Ordering
demoteChainSyncJumpingDynamo :: forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m -> peer -> m ()
headerForgeUTCTime :: forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> FromConsensus header -> STM m UTCTime
mkAddFetchedBlock :: forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> STM m (Point block -> block -> m ())
plausibleCandidateChain :: forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> HasCallStack =>
   AnchoredFragment header -> AnchoredFragment header -> Bool
readCandidateChains :: forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> STM m (Map peer (AnchoredFragment header))
readChainSelStarvation :: forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> STM m ChainSelStarvation
readCurrentChain :: forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> STM m (AnchoredFragment header)
readFetchMode :: forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m -> STM m FetchMode
readFetchedBlocks :: forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> STM m (Point block -> Bool)
readFetchedMaxSlotNo :: forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m -> STM m MaxSlotNo
..}
                FetchClientRegistry addr header block m
registry
                BlockFetchConfiguration{Int
Word
DiffTime
GenesisBlockFetchConfiguration
bfcMaxConcurrencyBulkSync :: BlockFetchConfiguration -> Word
bfcMaxConcurrencyDeadline :: BlockFetchConfiguration -> Word
bfcMaxRequestsInflight :: BlockFetchConfiguration -> Word
bfcDecisionLoopIntervalGenesis :: BlockFetchConfiguration -> DiffTime
bfcDecisionLoopIntervalPraos :: BlockFetchConfiguration -> DiffTime
bfcSalt :: BlockFetchConfiguration -> Int
bfcGenesisBFConfig :: BlockFetchConfiguration -> GenesisBlockFetchConfiguration
bfcMaxConcurrencyBulkSync :: Word
bfcMaxConcurrencyDeadline :: Word
bfcMaxRequestsInflight :: Word
bfcDecisionLoopIntervalGenesis :: DiffTime
bfcDecisionLoopIntervalPraos :: DiffTime
bfcSalt :: Int
bfcGenesisBFConfig :: GenesisBlockFetchConfiguration
..} = do

    FetchClientRegistry addr header block m
-> Tracer m (TraceLabelPeer addr (TraceFetchClientState header))
-> STM m (FetchClientPolicy header block m)
-> m ()
forall (m :: * -> *) peer header block.
MonadSTM m =>
FetchClientRegistry peer header block m
-> Tracer m (TraceLabelPeer peer (TraceFetchClientState header))
-> STM m (FetchClientPolicy header block m)
-> m ()
setFetchClientContext FetchClientRegistry addr header block m
registry Tracer m (TraceLabelPeer addr (TraceFetchClientState header))
clientStateTracer STM m (FetchClientPolicy header block 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 m)
    mkFetchClientPolicy :: STM m (FetchClientPolicy header block m)
mkFetchClientPolicy = do
      addFetchedBlock <- STM m (Point block -> block -> 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 :: Int
peerSalt                    = Int
bfcSalt,
        bulkSyncGracePeriod :: DiffTime
bulkSyncGracePeriod         = GenesisBlockFetchConfiguration -> DiffTime
gbfcGracePeriod GenesisBlockFetchConfiguration
bfcGenesisBFConfig,

        HasCallStack =>
AnchoredFragment header -> AnchoredFragment header -> Bool
AnchoredFragment header -> AnchoredFragment header -> Bool
plausibleCandidateChain :: HasCallStack =>
AnchoredFragment header -> AnchoredFragment header -> Bool
plausibleCandidateChain :: HasCallStack =>
AnchoredFragment header -> AnchoredFragment header -> Bool
plausibleCandidateChain,
        HasCallStack =>
AnchoredFragment header -> AnchoredFragment header -> Ordering
AnchoredFragment header -> AnchoredFragment header -> Ordering
compareCandidateChains :: HasCallStack =>
AnchoredFragment header -> AnchoredFragment header -> Ordering
compareCandidateChains :: HasCallStack =>
AnchoredFragment header -> AnchoredFragment header -> Ordering
compareCandidateChains,
        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 m
-> STM m (Map addr (PeerFetchStatus header))
forall (m :: * -> *) peer header block.
MonadSTM m =>
FetchClientRegistry peer header block m
-> STM m (Map peer (PeerFetchStatus header))
readFetchClientsStatus FetchClientRegistry addr header block m
registry
      }

    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 m
-> STM m (Map addr (FetchClientStateVars m header))
forall (m :: * -> *) peer header block.
MonadSTM m =>
FetchClientRegistry peer header block m
-> STM m (Map peer (FetchClientStateVars m header))
readFetchClientsStateVars FetchClientRegistry addr header block m
registry,
        readStatePeerGSVs :: STM m (Map addr PeerGSV)
readStatePeerGSVs           = FetchClientRegistry addr header block m -> STM m (Map addr PeerGSV)
forall block header (m :: * -> *) peer.
(MonadSTM m, Ord peer) =>
FetchClientRegistry peer header block m -> STM m (Map peer PeerGSV)
readPeerGSVs FetchClientRegistry addr header block m
registry,
        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
      }