{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Ouroboros.Consensus.Node.Genesis (
    -- * 'GenesisConfig'
    GenesisConfig (..)
  , GenesisConfigFlags (..)
  , LoEAndGDDConfig (..)
  , defaultGenesisConfigFlags
  , disableGenesisConfig
  , enableGenesisConfigDefault
  , mkGenesisConfig
    -- * NodeKernel helpers
  , GenesisNodeKernelArgs (..)
  , LoEAndGDDNodeKernelArgs (..)
  , mkGenesisNodeKernelArgs
  , setGetLoEFragment
  ) where

import           Control.Monad (join)
import           Data.Maybe (fromMaybe)
import           Data.Traversable (for)
import           GHC.Generics (Generic)
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client
                     (CSJConfig (..), CSJEnabledConfig (..),
                     ChainSyncLoPBucketConfig (..),
                     ChainSyncLoPBucketEnabledConfig (..))
import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client.HistoricityCheck
                     (HistoricityCutoff (..))
import qualified Ouroboros.Consensus.Node.GsmState as GSM
import           Ouroboros.Consensus.Storage.ChainDB (ChainDbArgs)
import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
import qualified Ouroboros.Consensus.Storage.ChainDB.Impl.Args as ChainDB
import           Ouroboros.Consensus.Util.Args
import           Ouroboros.Consensus.Util.IOLike
import           Ouroboros.Network.AnchoredFragment (AnchoredFragment)
import qualified Ouroboros.Network.AnchoredFragment as AF
import           Ouroboros.Network.BlockFetch
                     (GenesisBlockFetchConfiguration (..))

-- | Whether to en-/disable the Limit on Eagerness and the Genesis Density
-- Disconnector.
data LoEAndGDDConfig a =
    LoEAndGDDEnabled !a
  | LoEAndGDDDisabled
  deriving stock (LoEAndGDDConfig a -> LoEAndGDDConfig a -> Bool
(LoEAndGDDConfig a -> LoEAndGDDConfig a -> Bool)
-> (LoEAndGDDConfig a -> LoEAndGDDConfig a -> Bool)
-> Eq (LoEAndGDDConfig a)
forall a. Eq a => LoEAndGDDConfig a -> LoEAndGDDConfig a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => LoEAndGDDConfig a -> LoEAndGDDConfig a -> Bool
== :: LoEAndGDDConfig a -> LoEAndGDDConfig a -> Bool
$c/= :: forall a. Eq a => LoEAndGDDConfig a -> LoEAndGDDConfig a -> Bool
/= :: LoEAndGDDConfig a -> LoEAndGDDConfig a -> Bool
Eq, (forall x. LoEAndGDDConfig a -> Rep (LoEAndGDDConfig a) x)
-> (forall x. Rep (LoEAndGDDConfig a) x -> LoEAndGDDConfig a)
-> Generic (LoEAndGDDConfig a)
forall x. Rep (LoEAndGDDConfig a) x -> LoEAndGDDConfig a
forall x. LoEAndGDDConfig a -> Rep (LoEAndGDDConfig a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (LoEAndGDDConfig a) x -> LoEAndGDDConfig a
forall a x. LoEAndGDDConfig a -> Rep (LoEAndGDDConfig a) x
$cfrom :: forall a x. LoEAndGDDConfig a -> Rep (LoEAndGDDConfig a) x
from :: forall x. LoEAndGDDConfig a -> Rep (LoEAndGDDConfig a) x
$cto :: forall a x. Rep (LoEAndGDDConfig a) x -> LoEAndGDDConfig a
to :: forall x. Rep (LoEAndGDDConfig a) x -> LoEAndGDDConfig a
Generic, Int -> LoEAndGDDConfig a -> ShowS
[LoEAndGDDConfig a] -> ShowS
LoEAndGDDConfig a -> String
(Int -> LoEAndGDDConfig a -> ShowS)
-> (LoEAndGDDConfig a -> String)
-> ([LoEAndGDDConfig a] -> ShowS)
-> Show (LoEAndGDDConfig a)
forall a. Show a => Int -> LoEAndGDDConfig a -> ShowS
forall a. Show a => [LoEAndGDDConfig a] -> ShowS
forall a. Show a => LoEAndGDDConfig a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> LoEAndGDDConfig a -> ShowS
showsPrec :: Int -> LoEAndGDDConfig a -> ShowS
$cshow :: forall a. Show a => LoEAndGDDConfig a -> String
show :: LoEAndGDDConfig a -> String
$cshowList :: forall a. Show a => [LoEAndGDDConfig a] -> ShowS
showList :: [LoEAndGDDConfig a] -> ShowS
Show, (forall a b. (a -> b) -> LoEAndGDDConfig a -> LoEAndGDDConfig b)
-> (forall a b. a -> LoEAndGDDConfig b -> LoEAndGDDConfig a)
-> Functor LoEAndGDDConfig
forall a b. a -> LoEAndGDDConfig b -> LoEAndGDDConfig a
forall a b. (a -> b) -> LoEAndGDDConfig a -> LoEAndGDDConfig b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> LoEAndGDDConfig a -> LoEAndGDDConfig b
fmap :: forall a b. (a -> b) -> LoEAndGDDConfig a -> LoEAndGDDConfig b
$c<$ :: forall a b. a -> LoEAndGDDConfig b -> LoEAndGDDConfig a
<$ :: forall a b. a -> LoEAndGDDConfig b -> LoEAndGDDConfig a
Functor, (forall m. Monoid m => LoEAndGDDConfig m -> m)
-> (forall m a. Monoid m => (a -> m) -> LoEAndGDDConfig a -> m)
-> (forall m a. Monoid m => (a -> m) -> LoEAndGDDConfig a -> m)
-> (forall a b. (a -> b -> b) -> b -> LoEAndGDDConfig a -> b)
-> (forall a b. (a -> b -> b) -> b -> LoEAndGDDConfig a -> b)
-> (forall b a. (b -> a -> b) -> b -> LoEAndGDDConfig a -> b)
-> (forall b a. (b -> a -> b) -> b -> LoEAndGDDConfig a -> b)
-> (forall a. (a -> a -> a) -> LoEAndGDDConfig a -> a)
-> (forall a. (a -> a -> a) -> LoEAndGDDConfig a -> a)
-> (forall a. LoEAndGDDConfig a -> [a])
-> (forall a. LoEAndGDDConfig a -> Bool)
-> (forall a. LoEAndGDDConfig a -> Int)
-> (forall a. Eq a => a -> LoEAndGDDConfig a -> Bool)
-> (forall a. Ord a => LoEAndGDDConfig a -> a)
-> (forall a. Ord a => LoEAndGDDConfig a -> a)
-> (forall a. Num a => LoEAndGDDConfig a -> a)
-> (forall a. Num a => LoEAndGDDConfig a -> a)
-> Foldable LoEAndGDDConfig
forall a. Eq a => a -> LoEAndGDDConfig a -> Bool
forall a. Num a => LoEAndGDDConfig a -> a
forall a. Ord a => LoEAndGDDConfig a -> a
forall m. Monoid m => LoEAndGDDConfig m -> m
forall a. LoEAndGDDConfig a -> Bool
forall a. LoEAndGDDConfig a -> Int
forall a. LoEAndGDDConfig a -> [a]
forall a. (a -> a -> a) -> LoEAndGDDConfig a -> a
forall m a. Monoid m => (a -> m) -> LoEAndGDDConfig a -> m
forall b a. (b -> a -> b) -> b -> LoEAndGDDConfig a -> b
forall a b. (a -> b -> b) -> b -> LoEAndGDDConfig a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => LoEAndGDDConfig m -> m
fold :: forall m. Monoid m => LoEAndGDDConfig m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> LoEAndGDDConfig a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> LoEAndGDDConfig a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> LoEAndGDDConfig a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> LoEAndGDDConfig a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> LoEAndGDDConfig a -> b
foldr :: forall a b. (a -> b -> b) -> b -> LoEAndGDDConfig a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> LoEAndGDDConfig a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> LoEAndGDDConfig a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> LoEAndGDDConfig a -> b
foldl :: forall b a. (b -> a -> b) -> b -> LoEAndGDDConfig a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> LoEAndGDDConfig a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> LoEAndGDDConfig a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> LoEAndGDDConfig a -> a
foldr1 :: forall a. (a -> a -> a) -> LoEAndGDDConfig a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> LoEAndGDDConfig a -> a
foldl1 :: forall a. (a -> a -> a) -> LoEAndGDDConfig a -> a
$ctoList :: forall a. LoEAndGDDConfig a -> [a]
toList :: forall a. LoEAndGDDConfig a -> [a]
$cnull :: forall a. LoEAndGDDConfig a -> Bool
null :: forall a. LoEAndGDDConfig a -> Bool
$clength :: forall a. LoEAndGDDConfig a -> Int
length :: forall a. LoEAndGDDConfig a -> Int
$celem :: forall a. Eq a => a -> LoEAndGDDConfig a -> Bool
elem :: forall a. Eq a => a -> LoEAndGDDConfig a -> Bool
$cmaximum :: forall a. Ord a => LoEAndGDDConfig a -> a
maximum :: forall a. Ord a => LoEAndGDDConfig a -> a
$cminimum :: forall a. Ord a => LoEAndGDDConfig a -> a
minimum :: forall a. Ord a => LoEAndGDDConfig a -> a
$csum :: forall a. Num a => LoEAndGDDConfig a -> a
sum :: forall a. Num a => LoEAndGDDConfig a -> a
$cproduct :: forall a. Num a => LoEAndGDDConfig a -> a
product :: forall a. Num a => LoEAndGDDConfig a -> a
Foldable, Functor LoEAndGDDConfig
Foldable LoEAndGDDConfig
(Functor LoEAndGDDConfig, Foldable LoEAndGDDConfig) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> LoEAndGDDConfig a -> f (LoEAndGDDConfig b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    LoEAndGDDConfig (f a) -> f (LoEAndGDDConfig a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> LoEAndGDDConfig a -> m (LoEAndGDDConfig b))
-> (forall (m :: * -> *) a.
    Monad m =>
    LoEAndGDDConfig (m a) -> m (LoEAndGDDConfig a))
-> Traversable LoEAndGDDConfig
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
LoEAndGDDConfig (m a) -> m (LoEAndGDDConfig a)
forall (f :: * -> *) a.
Applicative f =>
LoEAndGDDConfig (f a) -> f (LoEAndGDDConfig a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LoEAndGDDConfig a -> m (LoEAndGDDConfig b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LoEAndGDDConfig a -> f (LoEAndGDDConfig b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LoEAndGDDConfig a -> f (LoEAndGDDConfig b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LoEAndGDDConfig a -> f (LoEAndGDDConfig b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
LoEAndGDDConfig (f a) -> f (LoEAndGDDConfig a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
LoEAndGDDConfig (f a) -> f (LoEAndGDDConfig a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LoEAndGDDConfig a -> m (LoEAndGDDConfig b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LoEAndGDDConfig a -> m (LoEAndGDDConfig b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
LoEAndGDDConfig (m a) -> m (LoEAndGDDConfig a)
sequence :: forall (m :: * -> *) a.
Monad m =>
LoEAndGDDConfig (m a) -> m (LoEAndGDDConfig a)
Traversable)

-- | Aggregating the various configs for Genesis-related subcomponents.
--
-- Usually, 'enableGenesisConfigDefault' or 'disableGenesisConfig' can be used.
-- See the haddocks of the types of the individual fields for details.
data GenesisConfig = GenesisConfig
  { GenesisConfig -> GenesisBlockFetchConfiguration
gcBlockFetchConfig         :: !GenesisBlockFetchConfiguration
  , GenesisConfig -> ChainSyncLoPBucketConfig
gcChainSyncLoPBucketConfig :: !ChainSyncLoPBucketConfig
  , GenesisConfig -> CSJConfig
gcCSJConfig                :: !CSJConfig
  , GenesisConfig -> LoEAndGDDConfig LoEAndGDDParams
gcLoEAndGDDConfig          :: !(LoEAndGDDConfig LoEAndGDDParams)
  , GenesisConfig -> Maybe HistoricityCutoff
gcHistoricityCutoff        :: !(Maybe HistoricityCutoff)
  } deriving stock (GenesisConfig -> GenesisConfig -> Bool
(GenesisConfig -> GenesisConfig -> Bool)
-> (GenesisConfig -> GenesisConfig -> Bool) -> Eq GenesisConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenesisConfig -> GenesisConfig -> Bool
== :: GenesisConfig -> GenesisConfig -> Bool
$c/= :: GenesisConfig -> GenesisConfig -> Bool
/= :: GenesisConfig -> GenesisConfig -> Bool
Eq, (forall x. GenesisConfig -> Rep GenesisConfig x)
-> (forall x. Rep GenesisConfig x -> GenesisConfig)
-> Generic GenesisConfig
forall x. Rep GenesisConfig x -> GenesisConfig
forall x. GenesisConfig -> Rep GenesisConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenesisConfig -> Rep GenesisConfig x
from :: forall x. GenesisConfig -> Rep GenesisConfig x
$cto :: forall x. Rep GenesisConfig x -> GenesisConfig
to :: forall x. Rep GenesisConfig x -> GenesisConfig
Generic, Int -> GenesisConfig -> ShowS
[GenesisConfig] -> ShowS
GenesisConfig -> String
(Int -> GenesisConfig -> ShowS)
-> (GenesisConfig -> String)
-> ([GenesisConfig] -> ShowS)
-> Show GenesisConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenesisConfig -> ShowS
showsPrec :: Int -> GenesisConfig -> ShowS
$cshow :: GenesisConfig -> String
show :: GenesisConfig -> String
$cshowList :: [GenesisConfig] -> ShowS
showList :: [GenesisConfig] -> ShowS
Show)

-- | Genesis configuration flags and low-level args, as parsed from config file or CLI
data GenesisConfigFlags = GenesisConfigFlags
  { GenesisConfigFlags -> Bool
gcfEnableCSJ             :: Bool
  , GenesisConfigFlags -> Bool
gcfEnableLoEAndGDD       :: Bool
  , GenesisConfigFlags -> Bool
gcfEnableLoP             :: Bool
  , GenesisConfigFlags -> Maybe DiffTime
gcfBlockFetchGracePeriod :: Maybe DiffTime
  , GenesisConfigFlags -> Maybe Integer
gcfBucketCapacity        :: Maybe Integer
  , GenesisConfigFlags -> Maybe Integer
gcfBucketRate            :: Maybe Integer
  , GenesisConfigFlags -> Maybe SlotNo
gcfCSJJumpSize           :: Maybe SlotNo
  , GenesisConfigFlags -> Maybe DiffTime
gcfGDDRateLimit          :: Maybe DiffTime
  } deriving stock (GenesisConfigFlags -> GenesisConfigFlags -> Bool
(GenesisConfigFlags -> GenesisConfigFlags -> Bool)
-> (GenesisConfigFlags -> GenesisConfigFlags -> Bool)
-> Eq GenesisConfigFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenesisConfigFlags -> GenesisConfigFlags -> Bool
== :: GenesisConfigFlags -> GenesisConfigFlags -> Bool
$c/= :: GenesisConfigFlags -> GenesisConfigFlags -> Bool
/= :: GenesisConfigFlags -> GenesisConfigFlags -> Bool
Eq, (forall x. GenesisConfigFlags -> Rep GenesisConfigFlags x)
-> (forall x. Rep GenesisConfigFlags x -> GenesisConfigFlags)
-> Generic GenesisConfigFlags
forall x. Rep GenesisConfigFlags x -> GenesisConfigFlags
forall x. GenesisConfigFlags -> Rep GenesisConfigFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenesisConfigFlags -> Rep GenesisConfigFlags x
from :: forall x. GenesisConfigFlags -> Rep GenesisConfigFlags x
$cto :: forall x. Rep GenesisConfigFlags x -> GenesisConfigFlags
to :: forall x. Rep GenesisConfigFlags x -> GenesisConfigFlags
Generic, Int -> GenesisConfigFlags -> ShowS
[GenesisConfigFlags] -> ShowS
GenesisConfigFlags -> String
(Int -> GenesisConfigFlags -> ShowS)
-> (GenesisConfigFlags -> String)
-> ([GenesisConfigFlags] -> ShowS)
-> Show GenesisConfigFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenesisConfigFlags -> ShowS
showsPrec :: Int -> GenesisConfigFlags -> ShowS
$cshow :: GenesisConfigFlags -> String
show :: GenesisConfigFlags -> String
$cshowList :: [GenesisConfigFlags] -> ShowS
showList :: [GenesisConfigFlags] -> ShowS
Show)

defaultGenesisConfigFlags :: GenesisConfigFlags
defaultGenesisConfigFlags :: GenesisConfigFlags
defaultGenesisConfigFlags = GenesisConfigFlags
  { gcfEnableCSJ :: Bool
gcfEnableCSJ              = Bool
True
  , gcfEnableLoEAndGDD :: Bool
gcfEnableLoEAndGDD        = Bool
True
  , gcfEnableLoP :: Bool
gcfEnableLoP              = Bool
True
  , gcfBlockFetchGracePeriod :: Maybe DiffTime
gcfBlockFetchGracePeriod  = Maybe DiffTime
forall a. Maybe a
Nothing
  , gcfBucketCapacity :: Maybe Integer
gcfBucketCapacity         = Maybe Integer
forall a. Maybe a
Nothing
  , gcfBucketRate :: Maybe Integer
gcfBucketRate             = Maybe Integer
forall a. Maybe a
Nothing
  , gcfCSJJumpSize :: Maybe SlotNo
gcfCSJJumpSize            = Maybe SlotNo
forall a. Maybe a
Nothing
  , gcfGDDRateLimit :: Maybe DiffTime
gcfGDDRateLimit           = Maybe DiffTime
forall a. Maybe a
Nothing
  }

enableGenesisConfigDefault :: GenesisConfig
enableGenesisConfigDefault :: GenesisConfig
enableGenesisConfigDefault = Maybe GenesisConfigFlags -> GenesisConfig
mkGenesisConfig (Maybe GenesisConfigFlags -> GenesisConfig)
-> Maybe GenesisConfigFlags -> GenesisConfig
forall a b. (a -> b) -> a -> b
$ GenesisConfigFlags -> Maybe GenesisConfigFlags
forall a. a -> Maybe a
Just GenesisConfigFlags
defaultGenesisConfigFlags

-- | Disable all Genesis components, yielding Praos behavior.
disableGenesisConfig :: GenesisConfig
disableGenesisConfig :: GenesisConfig
disableGenesisConfig = Maybe GenesisConfigFlags -> GenesisConfig
mkGenesisConfig Maybe GenesisConfigFlags
forall a. Maybe a
Nothing

mkGenesisConfig :: Maybe GenesisConfigFlags -> GenesisConfig
mkGenesisConfig :: Maybe GenesisConfigFlags -> GenesisConfig
mkGenesisConfig Maybe GenesisConfigFlags
Nothing = -- disable Genesis
  GenesisConfig
    { gcBlockFetchConfig :: GenesisBlockFetchConfiguration
gcBlockFetchConfig = GenesisBlockFetchConfiguration
        { gbfcGracePeriod :: DiffTime
gbfcGracePeriod = DiffTime
0 -- no grace period when Genesis is disabled
        }
    , gcChainSyncLoPBucketConfig :: ChainSyncLoPBucketConfig
gcChainSyncLoPBucketConfig = ChainSyncLoPBucketConfig
ChainSyncLoPBucketDisabled
    , gcCSJConfig :: CSJConfig
gcCSJConfig                = CSJConfig
CSJDisabled
    , gcLoEAndGDDConfig :: LoEAndGDDConfig LoEAndGDDParams
gcLoEAndGDDConfig          = LoEAndGDDConfig LoEAndGDDParams
forall a. LoEAndGDDConfig a
LoEAndGDDDisabled
    , gcHistoricityCutoff :: Maybe HistoricityCutoff
gcHistoricityCutoff        = Maybe HistoricityCutoff
forall a. Maybe a
Nothing
    }
mkGenesisConfig (Just GenesisConfigFlags
cfg) =
  GenesisConfig
    { gcBlockFetchConfig :: GenesisBlockFetchConfiguration
gcBlockFetchConfig = GenesisBlockFetchConfiguration
        { DiffTime
gbfcGracePeriod :: DiffTime
gbfcGracePeriod :: DiffTime
gbfcGracePeriod
        }
    , gcChainSyncLoPBucketConfig :: ChainSyncLoPBucketConfig
gcChainSyncLoPBucketConfig = if Bool
gcfEnableLoP
        then ChainSyncLoPBucketEnabledConfig -> ChainSyncLoPBucketConfig
ChainSyncLoPBucketEnabled ChainSyncLoPBucketEnabledConfig
          { Integer
csbcCapacity :: Integer
$sel:csbcCapacity:ChainSyncLoPBucketEnabledConfig :: Integer
csbcCapacity
          , Rational
csbcRate :: Rational
$sel:csbcRate:ChainSyncLoPBucketEnabledConfig :: Rational
csbcRate
          }
        else ChainSyncLoPBucketConfig
ChainSyncLoPBucketDisabled
    , gcCSJConfig :: CSJConfig
gcCSJConfig = if Bool
gcfEnableCSJ
        then CSJEnabledConfig -> CSJConfig
CSJEnabled CSJEnabledConfig
          { SlotNo
csjcJumpSize :: SlotNo
$sel:csjcJumpSize:CSJEnabledConfig :: SlotNo
csjcJumpSize
          }
        else CSJConfig
CSJDisabled
    , gcLoEAndGDDConfig :: LoEAndGDDConfig LoEAndGDDParams
gcLoEAndGDDConfig = if Bool
gcfEnableLoEAndGDD
        then LoEAndGDDParams -> LoEAndGDDConfig LoEAndGDDParams
forall a. a -> LoEAndGDDConfig a
LoEAndGDDEnabled LoEAndGDDParams{DiffTime
lgpGDDRateLimit :: DiffTime
lgpGDDRateLimit :: DiffTime
lgpGDDRateLimit}
        else LoEAndGDDConfig LoEAndGDDParams
forall a. LoEAndGDDConfig a
LoEAndGDDDisabled
    , -- Duration in seconds of one Cardano mainnet Shelley stability window
      -- (3k/f slots times one second per slot) plus one extra hour as a
      -- safety margin.
      gcHistoricityCutoff :: Maybe HistoricityCutoff
gcHistoricityCutoff = HistoricityCutoff -> Maybe HistoricityCutoff
forall a. a -> Maybe a
Just (HistoricityCutoff -> Maybe HistoricityCutoff)
-> HistoricityCutoff -> Maybe HistoricityCutoff
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> HistoricityCutoff
HistoricityCutoff (NominalDiffTime -> HistoricityCutoff)
-> NominalDiffTime -> HistoricityCutoff
forall a b. (a -> b) -> a -> b
$ NominalDiffTime
3 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
2160 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
3600
    }
  where
    GenesisConfigFlags {
        Bool
gcfEnableLoP :: GenesisConfigFlags -> Bool
gcfEnableLoP :: Bool
gcfEnableLoP
      , Bool
gcfEnableCSJ :: GenesisConfigFlags -> Bool
gcfEnableCSJ :: Bool
gcfEnableCSJ
      , Bool
gcfEnableLoEAndGDD :: GenesisConfigFlags -> Bool
gcfEnableLoEAndGDD :: Bool
gcfEnableLoEAndGDD
      , Maybe DiffTime
gcfBlockFetchGracePeriod :: GenesisConfigFlags -> Maybe DiffTime
gcfBlockFetchGracePeriod :: Maybe DiffTime
gcfBlockFetchGracePeriod
      , Maybe Integer
gcfBucketCapacity :: GenesisConfigFlags -> Maybe Integer
gcfBucketCapacity :: Maybe Integer
gcfBucketCapacity
      , Maybe Integer
gcfBucketRate :: GenesisConfigFlags -> Maybe Integer
gcfBucketRate :: Maybe Integer
gcfBucketRate
      , Maybe SlotNo
gcfCSJJumpSize :: GenesisConfigFlags -> Maybe SlotNo
gcfCSJJumpSize :: Maybe SlotNo
gcfCSJJumpSize
      , Maybe DiffTime
gcfGDDRateLimit :: GenesisConfigFlags -> Maybe DiffTime
gcfGDDRateLimit :: Maybe DiffTime
gcfGDDRateLimit
      } = GenesisConfigFlags
cfg

    -- The minimum amount of time during which the Genesis BlockFetch logic will
    -- download blocks from a specific peer (even if it is not performing well
    -- during that period).
    defaultBlockFetchGracePeriod :: DiffTime
defaultBlockFetchGracePeriod = DiffTime
10 -- seconds

    -- LoP parameters. Empirically, it takes less than 1ms to validate a header,
    -- so leaking one token per 2ms is conservative. The capacity of 100_000
    -- tokens corresponds to 200s, which is definitely enough to handle long GC
    -- pauses; we could even make this more conservative.
    defaultCapacity :: Integer
defaultCapacity = Integer
100_000 -- number of tokens
    defaultRate :: Rational
defaultRate     = Rational
500 -- tokens per second leaking, 1/2ms

    -- The larger Shelley forecast range (3 * 2160 * 20) works in more recent
    -- ranges of slots, but causes syncing to block in Byron. A future
    -- improvement would be to make this era-dynamic, such that we can use the
    -- larger (and hence more efficient) larger CSJ jump size in Shelley-based
    -- eras.
    defaultCSJJumpSize :: SlotNo
defaultCSJJumpSize = SlotNo
2 SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
* SlotNo
2160 -- Byron forecast range

    -- Limiting the performance impact of the GDD.
    defaultGDDRateLimit :: DiffTime
defaultGDDRateLimit        = DiffTime
1.0 -- seconds

    gbfcGracePeriod :: DiffTime
gbfcGracePeriod = DiffTime -> Maybe DiffTime -> DiffTime
forall a. a -> Maybe a -> a
fromMaybe DiffTime
defaultBlockFetchGracePeriod Maybe DiffTime
gcfBlockFetchGracePeriod
    csbcCapacity :: Integer
csbcCapacity    = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
defaultCapacity Maybe Integer
gcfBucketCapacity
    csbcRate :: Rational
csbcRate        = Rational -> (Integer -> Rational) -> Maybe Integer -> Rational
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rational
defaultRate (forall a. Num a => Integer -> a
fromInteger @Rational) Maybe Integer
gcfBucketRate
    csjcJumpSize :: SlotNo
csjcJumpSize    = SlotNo -> Maybe SlotNo -> SlotNo
forall a. a -> Maybe a -> a
fromMaybe SlotNo
defaultCSJJumpSize Maybe SlotNo
gcfCSJJumpSize
    lgpGDDRateLimit :: DiffTime
lgpGDDRateLimit = DiffTime -> Maybe DiffTime -> DiffTime
forall a. a -> Maybe a -> a
fromMaybe DiffTime
defaultGDDRateLimit Maybe DiffTime
gcfGDDRateLimit

newtype LoEAndGDDParams = LoEAndGDDParams
  { -- | How often to evaluate GDD. 0 means as soon as possible.
    -- Otherwise, no faster than once every T seconds, where T is the
    -- value of the field.
    LoEAndGDDParams -> DiffTime
lgpGDDRateLimit :: DiffTime
  } deriving stock (LoEAndGDDParams -> LoEAndGDDParams -> Bool
(LoEAndGDDParams -> LoEAndGDDParams -> Bool)
-> (LoEAndGDDParams -> LoEAndGDDParams -> Bool)
-> Eq LoEAndGDDParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LoEAndGDDParams -> LoEAndGDDParams -> Bool
== :: LoEAndGDDParams -> LoEAndGDDParams -> Bool
$c/= :: LoEAndGDDParams -> LoEAndGDDParams -> Bool
/= :: LoEAndGDDParams -> LoEAndGDDParams -> Bool
Eq, (forall x. LoEAndGDDParams -> Rep LoEAndGDDParams x)
-> (forall x. Rep LoEAndGDDParams x -> LoEAndGDDParams)
-> Generic LoEAndGDDParams
forall x. Rep LoEAndGDDParams x -> LoEAndGDDParams
forall x. LoEAndGDDParams -> Rep LoEAndGDDParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LoEAndGDDParams -> Rep LoEAndGDDParams x
from :: forall x. LoEAndGDDParams -> Rep LoEAndGDDParams x
$cto :: forall x. Rep LoEAndGDDParams x -> LoEAndGDDParams
to :: forall x. Rep LoEAndGDDParams x -> LoEAndGDDParams
Generic, Int -> LoEAndGDDParams -> ShowS
[LoEAndGDDParams] -> ShowS
LoEAndGDDParams -> String
(Int -> LoEAndGDDParams -> ShowS)
-> (LoEAndGDDParams -> String)
-> ([LoEAndGDDParams] -> ShowS)
-> Show LoEAndGDDParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoEAndGDDParams -> ShowS
showsPrec :: Int -> LoEAndGDDParams -> ShowS
$cshow :: LoEAndGDDParams -> String
show :: LoEAndGDDParams -> String
$cshowList :: [LoEAndGDDParams] -> ShowS
showList :: [LoEAndGDDParams] -> ShowS
Show)

-- | Genesis-related arguments needed by the NodeKernel initialization logic.
data GenesisNodeKernelArgs m blk = GenesisNodeKernelArgs {
    forall (m :: * -> *) blk.
GenesisNodeKernelArgs m blk
-> LoEAndGDDConfig (LoEAndGDDNodeKernelArgs m blk)
gnkaLoEAndGDDArgs :: !(LoEAndGDDConfig (LoEAndGDDNodeKernelArgs m blk))
  }

data LoEAndGDDNodeKernelArgs m blk = LoEAndGDDNodeKernelArgs {
    -- | A TVar containing an action that returns the 'ChainDB.GetLoEFragment'
    -- action. We use this extra indirection to update this action after we
    -- opened the ChainDB (which happens before we initialize the NodeKernel).
    -- After that, this TVar will not be modified again.
    forall (m :: * -> *) blk.
LoEAndGDDNodeKernelArgs m blk
-> StrictTVar m (GetLoEFragment m blk)
lgnkaLoEFragmentTVar :: !(StrictTVar m (ChainDB.GetLoEFragment m blk))
  , forall (m :: * -> *) blk. LoEAndGDDNodeKernelArgs m blk -> DiffTime
lgnkaGDDRateLimit    :: DiffTime
  }
-- | Create the initial 'GenesisNodeKernelArgs" (with a temporary
-- 'ChainDB.GetLoEFragment' that will be replaced via 'setGetLoEFragment') and a
-- function to update the 'ChainDbArgs' accordingly.
mkGenesisNodeKernelArgs ::
     forall m blk. (IOLike m, GetHeader blk)
  => GenesisConfig
  -> m ( GenesisNodeKernelArgs m blk
       , Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk
       )
mkGenesisNodeKernelArgs :: forall (m :: * -> *) blk.
(IOLike m, GetHeader blk) =>
GenesisConfig
-> m (GenesisNodeKernelArgs m blk,
      Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk)
mkGenesisNodeKernelArgs GenesisConfig
gcfg = do
    LoEAndGDDConfig (LoEAndGDDNodeKernelArgs m blk)
gnkaLoEAndGDDArgs <- LoEAndGDDConfig LoEAndGDDParams
-> (LoEAndGDDParams -> m (LoEAndGDDNodeKernelArgs m blk))
-> m (LoEAndGDDConfig (LoEAndGDDNodeKernelArgs m blk))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (GenesisConfig -> LoEAndGDDConfig LoEAndGDDParams
gcLoEAndGDDConfig GenesisConfig
gcfg) ((LoEAndGDDParams -> m (LoEAndGDDNodeKernelArgs m blk))
 -> m (LoEAndGDDConfig (LoEAndGDDNodeKernelArgs m blk)))
-> (LoEAndGDDParams -> m (LoEAndGDDNodeKernelArgs m blk))
-> m (LoEAndGDDConfig (LoEAndGDDNodeKernelArgs m blk))
forall a b. (a -> b) -> a -> b
$ \LoEAndGDDParams
p -> do
        StrictTVar
  m
  (m (LoE
        (AnchoredSeq
           (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))))
loeFragmentTVar <- m (LoE
     (AnchoredSeq
        (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)))
-> m (StrictTVar
        m
        (m (LoE
              (AnchoredSeq
                 (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)))))
forall (m :: * -> *) a.
(HasCallStack, MonadSTM m, NoThunks a) =>
a -> m (StrictTVar m a)
newTVarIO (m (LoE
      (AnchoredSeq
         (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)))
 -> m (StrictTVar
         m
         (m (LoE
               (AnchoredSeq
                  (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))))))
-> m (LoE
        (AnchoredSeq
           (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)))
-> m (StrictTVar
        m
        (m (LoE
              (AnchoredSeq
                 (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)))))
forall a b. (a -> b) -> a -> b
$ LoE
  (AnchoredSeq
     (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))
-> m (LoE
        (AnchoredSeq
           (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LoE
   (AnchoredSeq
      (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))
 -> m (LoE
         (AnchoredSeq
            (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))))
-> LoE
     (AnchoredSeq
        (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))
-> m (LoE
        (AnchoredSeq
           (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)))
forall a b. (a -> b) -> a -> b
$
          -- Use the most conservative LoE fragment until 'setGetLoEFragment'
          -- is called.
          AnchoredSeq (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
-> LoE
     (AnchoredSeq
        (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))
forall a. a -> LoE a
ChainDB.LoEEnabled (AnchoredSeq (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
 -> LoE
      (AnchoredSeq
         (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)))
-> AnchoredSeq
     (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
-> LoE
     (AnchoredSeq
        (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))
forall a b. (a -> b) -> a -> b
$ Anchor (Header blk)
-> AnchoredSeq
     (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
forall v a b. Anchorable v a b => a -> AnchoredSeq v a b
AF.Empty Anchor (Header blk)
forall block. Anchor block
AF.AnchorGenesis
        LoEAndGDDNodeKernelArgs m blk -> m (LoEAndGDDNodeKernelArgs m blk)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoEAndGDDNodeKernelArgs
          { lgnkaLoEFragmentTVar :: StrictTVar
  m
  (m (LoE
        (AnchoredSeq
           (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))))
lgnkaLoEFragmentTVar = StrictTVar
  m
  (m (LoE
        (AnchoredSeq
           (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))))
loeFragmentTVar
          , lgnkaGDDRateLimit :: DiffTime
lgnkaGDDRateLimit = LoEAndGDDParams -> DiffTime
lgpGDDRateLimit LoEAndGDDParams
p
          }
    let updateChainDbArgs :: ChainDbArgs f m blk -> ChainDbArgs f m blk
updateChainDbArgs = case LoEAndGDDConfig (LoEAndGDDNodeKernelArgs m blk)
gnkaLoEAndGDDArgs of
          LoEAndGDDConfig (LoEAndGDDNodeKernelArgs m blk)
LoEAndGDDDisabled -> ChainDbArgs f m blk -> ChainDbArgs f m blk
forall a. a -> a
id
          LoEAndGDDEnabled LoEAndGDDNodeKernelArgs m blk
lgnkArgs -> \ChainDbArgs f m blk
cfg ->
            ChainDbArgs f m blk
cfg { ChainDB.cdbsArgs =
                  (ChainDB.cdbsArgs cfg) { ChainDB.cdbsLoE = getLoEFragment }
                }
            where
              getLoEFragment :: m (LoE
     (AnchoredSeq
        (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)))
getLoEFragment = m (m (LoE
        (AnchoredSeq
           (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))))
-> m (LoE
        (AnchoredSeq
           (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m (LoE
         (AnchoredSeq
            (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))))
 -> m (LoE
         (AnchoredSeq
            (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))))
-> m (m (LoE
           (AnchoredSeq
              (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))))
-> m (LoE
        (AnchoredSeq
           (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)))
forall a b. (a -> b) -> a -> b
$ StrictTVar
  m
  (m (LoE
        (AnchoredSeq
           (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))))
-> m (m (LoE
           (AnchoredSeq
              (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> m a
readTVarIO (StrictTVar
   m
   (m (LoE
         (AnchoredSeq
            (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))))
 -> m (m (LoE
            (AnchoredSeq
               (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)))))
-> StrictTVar
     m
     (m (LoE
           (AnchoredSeq
              (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))))
-> m (m (LoE
           (AnchoredSeq
              (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))))
forall a b. (a -> b) -> a -> b
$ LoEAndGDDNodeKernelArgs m blk
-> StrictTVar
     m
     (m (LoE
           (AnchoredSeq
              (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))))
forall (m :: * -> *) blk.
LoEAndGDDNodeKernelArgs m blk
-> StrictTVar m (GetLoEFragment m blk)
lgnkaLoEFragmentTVar LoEAndGDDNodeKernelArgs m blk
lgnkArgs
    (GenesisNodeKernelArgs m blk,
 Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk)
-> m (GenesisNodeKernelArgs m blk,
      Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenesisNodeKernelArgs{LoEAndGDDConfig (LoEAndGDDNodeKernelArgs m blk)
gnkaLoEAndGDDArgs :: LoEAndGDDConfig (LoEAndGDDNodeKernelArgs m blk)
gnkaLoEAndGDDArgs :: LoEAndGDDConfig (LoEAndGDDNodeKernelArgs m blk)
gnkaLoEAndGDDArgs}, Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk
forall {f :: * -> *}. ChainDbArgs f m blk -> ChainDbArgs f m blk
updateChainDbArgs)

-- | Set 'gnkaGetLoEFragment' to the actual logic for determining the current
-- LoE fragment.
setGetLoEFragment ::
     forall m blk. (IOLike m, GetHeader blk)
  => STM m GSM.GsmState
  -> STM m (AnchoredFragment (Header blk))
     -- ^ The LoE fragment.
  -> StrictTVar m (ChainDB.GetLoEFragment m blk)
  -> m ()
setGetLoEFragment :: forall (m :: * -> *) blk.
(IOLike m, GetHeader blk) =>
STM m GsmState
-> STM m (AnchoredFragment (Header blk))
-> StrictTVar m (GetLoEFragment m blk)
-> m ()
setGetLoEFragment STM m GsmState
readGsmState STM m (AnchoredFragment (Header blk))
readLoEFragment StrictTVar m (GetLoEFragment m blk)
varGetLoEFragment =
    STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ StrictTVar m (GetLoEFragment m blk)
-> GetLoEFragment m blk -> STM m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar m (GetLoEFragment m blk)
varGetLoEFragment GetLoEFragment m blk
getLoEFragment
  where
    getLoEFragment :: ChainDB.GetLoEFragment m blk
    getLoEFragment :: GetLoEFragment m blk
getLoEFragment = STM m (LoE (AnchoredFragment (Header blk))) -> GetLoEFragment m blk
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (LoE (AnchoredFragment (Header blk)))
 -> GetLoEFragment m blk)
-> STM m (LoE (AnchoredFragment (Header blk)))
-> GetLoEFragment m blk
forall a b. (a -> b) -> a -> b
$ STM m GsmState
readGsmState STM m GsmState
-> (GsmState -> STM m (LoE (AnchoredFragment (Header blk))))
-> STM m (LoE (AnchoredFragment (Header blk)))
forall a b. STM m a -> (a -> STM m b) -> STM m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        -- When the Honest Availability Assumption cannot currently be
        -- guaranteed, we should not select any blocks that would cause our
        -- immutable tip to advance, so we return the most conservative LoE
        -- fragment.
        GsmState
GSM.PreSyncing ->
          LoE (AnchoredFragment (Header blk))
-> STM m (LoE (AnchoredFragment (Header blk)))
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LoE (AnchoredFragment (Header blk))
 -> STM m (LoE (AnchoredFragment (Header blk))))
-> LoE (AnchoredFragment (Header blk))
-> STM m (LoE (AnchoredFragment (Header blk)))
forall a b. (a -> b) -> a -> b
$ AnchoredFragment (Header blk)
-> LoE (AnchoredFragment (Header blk))
forall a. a -> LoE a
ChainDB.LoEEnabled (AnchoredFragment (Header blk)
 -> LoE (AnchoredFragment (Header blk)))
-> AnchoredFragment (Header blk)
-> LoE (AnchoredFragment (Header blk))
forall a b. (a -> b) -> a -> b
$ Anchor (Header blk) -> AnchoredFragment (Header blk)
forall v a b. Anchorable v a b => a -> AnchoredSeq v a b
AF.Empty Anchor (Header blk)
forall block. Anchor block
AF.AnchorGenesis
        -- When we are syncing, return the current LoE fragment.
        GsmState
GSM.Syncing    ->
          AnchoredFragment (Header blk)
-> LoE (AnchoredFragment (Header blk))
forall a. a -> LoE a
ChainDB.LoEEnabled (AnchoredFragment (Header blk)
 -> LoE (AnchoredFragment (Header blk)))
-> STM m (AnchoredFragment (Header blk))
-> STM m (LoE (AnchoredFragment (Header blk)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM m (AnchoredFragment (Header blk))
readLoEFragment
        -- When we are caught up, the LoE is disabled.
        GsmState
GSM.CaughtUp   ->
          LoE (AnchoredFragment (Header blk))
-> STM m (LoE (AnchoredFragment (Header blk)))
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoE (AnchoredFragment (Header blk))
forall a. LoE a
ChainDB.LoEDisabled