{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Ouroboros.Consensus.Node.Genesis (
GenesisConfig (..)
, GenesisConfigFlags (..)
, LoEAndGDDConfig (..)
, defaultGenesisConfigFlags
, disableGenesisConfig
, enableGenesisConfigDefault
, mkGenesisConfig
, 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 (..))
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)
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)
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
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 =
GenesisConfig
{ gcBlockFetchConfig :: GenesisBlockFetchConfiguration
gcBlockFetchConfig = GenesisBlockFetchConfiguration
{ gbfcGracePeriod :: DiffTime
gbfcGracePeriod = DiffTime
0
}
, 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
,
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
defaultBlockFetchGracePeriod :: DiffTime
defaultBlockFetchGracePeriod = DiffTime
10
defaultCapacity :: Integer
defaultCapacity = Integer
100_000
defaultRate :: Rational
defaultRate = Rational
500
defaultCSJJumpSize :: SlotNo
defaultCSJJumpSize = SlotNo
2 SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
* SlotNo
2160
defaultGDDRateLimit :: DiffTime
defaultGDDRateLimit = DiffTime
1.0
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
{
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)
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 {
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
}
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
$
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)
setGetLoEFragment ::
forall m blk. (IOLike m, GetHeader blk)
=> STM m GSM.GsmState
-> STM m (AnchoredFragment (Header blk))
-> 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
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
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
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