{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Ouroboros.Consensus.HardFork.Combinator.Basics (
HardForkBlock (..)
, HardForkProtocol
, LedgerState (..)
, BlockConfig (..)
, CodecConfig (..)
, ConsensusConfig (..)
, HardForkLedgerConfig (..)
, StorageConfig (..)
, completeConsensusConfig'
, completeConsensusConfig''
, completeLedgerConfig'
, completeLedgerConfig''
, distribLedgerConfig
, distribTopLevelConfig
, EpochInfo
, Except
) where
import Data.Kind (Type)
import Data.SOP.Strict
import Data.Typeable
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Cardano.Slotting.EpochInfo
import Ouroboros.Consensus.Block.Abstract
import Ouroboros.Consensus.Config
import qualified Ouroboros.Consensus.HardFork.History as History
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Protocol.Abstract
import Ouroboros.Consensus.TypeFamilyWrappers
import Ouroboros.Consensus.Util (ShowProxy)
import Ouroboros.Consensus.Util.SOP (fn_5)
import Ouroboros.Consensus.HardFork.Combinator.Abstract
import Ouroboros.Consensus.HardFork.Combinator.AcrossEras
import Ouroboros.Consensus.HardFork.Combinator.PartialConfig
import Ouroboros.Consensus.HardFork.Combinator.State.Instances ()
import Ouroboros.Consensus.HardFork.Combinator.State.Types
data HardForkProtocol (xs :: [Type])
newtype HardForkBlock xs = HardForkBlock {
HardForkBlock xs -> OneEraBlock xs
getHardForkBlock :: OneEraBlock xs
}
deriving (Int -> HardForkBlock xs -> ShowS
[HardForkBlock xs] -> ShowS
HardForkBlock xs -> String
(Int -> HardForkBlock xs -> ShowS)
-> (HardForkBlock xs -> String)
-> ([HardForkBlock xs] -> ShowS)
-> Show (HardForkBlock xs)
forall (xs :: [*]).
CanHardFork xs =>
Int -> HardForkBlock xs -> ShowS
forall (xs :: [*]). CanHardFork xs => [HardForkBlock xs] -> ShowS
forall (xs :: [*]). CanHardFork xs => HardForkBlock xs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HardForkBlock xs] -> ShowS
$cshowList :: forall (xs :: [*]). CanHardFork xs => [HardForkBlock xs] -> ShowS
show :: HardForkBlock xs -> String
$cshow :: forall (xs :: [*]). CanHardFork xs => HardForkBlock xs -> String
showsPrec :: Int -> HardForkBlock xs -> ShowS
$cshowsPrec :: forall (xs :: [*]).
CanHardFork xs =>
Int -> HardForkBlock xs -> ShowS
Show)
instance Typeable xs => ShowProxy (HardForkBlock xs) where
type instance BlockProtocol (HardForkBlock xs) = HardForkProtocol xs
type instance (HardForkBlock xs) = OneEraHash xs
newtype instance LedgerState (HardForkBlock xs) = HardForkLedgerState {
LedgerState (HardForkBlock xs) -> HardForkState LedgerState xs
hardForkLedgerStatePerEra :: HardForkState LedgerState xs
}
deriving stock instance CanHardFork xs => Show (LedgerState (HardForkBlock xs))
deriving stock instance CanHardFork xs => Eq (LedgerState (HardForkBlock xs))
deriving newtype instance CanHardFork xs => NoThunks (LedgerState (HardForkBlock xs))
data instance ConsensusConfig (HardForkProtocol xs) = HardForkConsensusConfig {
ConsensusConfig (HardForkProtocol xs) -> SecurityParam
hardForkConsensusConfigK :: !(SecurityParam)
, ConsensusConfig (HardForkProtocol xs) -> Shape xs
hardForkConsensusConfigShape :: !(History.Shape xs)
, ConsensusConfig (HardForkProtocol xs) -> PerEraConsensusConfig xs
hardForkConsensusConfigPerEra :: !(PerEraConsensusConfig xs)
}
deriving stock ((forall x.
ConsensusConfig (HardForkProtocol xs)
-> Rep (ConsensusConfig (HardForkProtocol xs)) x)
-> (forall x.
Rep (ConsensusConfig (HardForkProtocol xs)) x
-> ConsensusConfig (HardForkProtocol xs))
-> Generic (ConsensusConfig (HardForkProtocol xs))
forall (xs :: [*]) x.
Rep (ConsensusConfig (HardForkProtocol xs)) x
-> ConsensusConfig (HardForkProtocol xs)
forall (xs :: [*]) x.
ConsensusConfig (HardForkProtocol xs)
-> Rep (ConsensusConfig (HardForkProtocol xs)) x
forall x.
Rep (ConsensusConfig (HardForkProtocol xs)) x
-> ConsensusConfig (HardForkProtocol xs)
forall x.
ConsensusConfig (HardForkProtocol xs)
-> Rep (ConsensusConfig (HardForkProtocol xs)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (xs :: [*]) x.
Rep (ConsensusConfig (HardForkProtocol xs)) x
-> ConsensusConfig (HardForkProtocol xs)
$cfrom :: forall (xs :: [*]) x.
ConsensusConfig (HardForkProtocol xs)
-> Rep (ConsensusConfig (HardForkProtocol xs)) x
Generic)
deriving anyclass (Context
-> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo)
Proxy (ConsensusConfig (HardForkProtocol xs)) -> String
(Context
-> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo))
-> (Context
-> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo))
-> (Proxy (ConsensusConfig (HardForkProtocol xs)) -> String)
-> NoThunks (ConsensusConfig (HardForkProtocol xs))
forall (xs :: [*]).
CanHardFork xs =>
Context
-> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo)
forall (xs :: [*]).
CanHardFork xs =>
Proxy (ConsensusConfig (HardForkProtocol xs)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (ConsensusConfig (HardForkProtocol xs)) -> String
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (ConsensusConfig (HardForkProtocol xs)) -> String
wNoThunks :: Context
-> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context
-> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo)
noThunks :: Context
-> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context
-> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo)
NoThunks)
newtype instance BlockConfig (HardForkBlock xs) = HardForkBlockConfig {
BlockConfig (HardForkBlock xs) -> PerEraBlockConfig xs
hardForkBlockConfigPerEra :: PerEraBlockConfig xs
}
deriving newtype (Context -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
Proxy (BlockConfig (HardForkBlock xs)) -> String
(Context -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo))
-> (Context
-> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo))
-> (Proxy (BlockConfig (HardForkBlock xs)) -> String)
-> NoThunks (BlockConfig (HardForkBlock xs))
forall (xs :: [*]).
CanHardFork xs =>
Context -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
forall (xs :: [*]).
CanHardFork xs =>
Proxy (BlockConfig (HardForkBlock xs)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (BlockConfig (HardForkBlock xs)) -> String
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (BlockConfig (HardForkBlock xs)) -> String
wNoThunks :: Context -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
NoThunks)
newtype instance CodecConfig (HardForkBlock xs) = HardForkCodecConfig {
CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
hardForkCodecConfigPerEra :: PerEraCodecConfig xs
}
deriving newtype (Context -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
Proxy (CodecConfig (HardForkBlock xs)) -> String
(Context -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo))
-> (Context
-> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo))
-> (Proxy (CodecConfig (HardForkBlock xs)) -> String)
-> NoThunks (CodecConfig (HardForkBlock xs))
forall (xs :: [*]).
CanHardFork xs =>
Context -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
forall (xs :: [*]).
CanHardFork xs =>
Proxy (CodecConfig (HardForkBlock xs)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (CodecConfig (HardForkBlock xs)) -> String
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (CodecConfig (HardForkBlock xs)) -> String
wNoThunks :: Context -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
noThunks :: Context -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
NoThunks)
newtype instance StorageConfig (HardForkBlock xs) = HardForkStorageConfig {
StorageConfig (HardForkBlock xs) -> PerEraStorageConfig xs
hardForkStorageConfigPerEra :: PerEraStorageConfig xs
}
deriving newtype (Context -> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
Proxy (StorageConfig (HardForkBlock xs)) -> String
(Context
-> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo))
-> (Context
-> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo))
-> (Proxy (StorageConfig (HardForkBlock xs)) -> String)
-> NoThunks (StorageConfig (HardForkBlock xs))
forall (xs :: [*]).
CanHardFork xs =>
Context -> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
forall (xs :: [*]).
CanHardFork xs =>
Proxy (StorageConfig (HardForkBlock xs)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (StorageConfig (HardForkBlock xs)) -> String
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (StorageConfig (HardForkBlock xs)) -> String
wNoThunks :: Context -> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
noThunks :: Context -> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
NoThunks)
data HardForkLedgerConfig xs = HardForkLedgerConfig {
HardForkLedgerConfig xs -> Shape xs
hardForkLedgerConfigShape :: !(History.Shape xs)
, HardForkLedgerConfig xs -> PerEraLedgerConfig xs
hardForkLedgerConfigPerEra :: !(PerEraLedgerConfig xs)
}
deriving ((forall x.
HardForkLedgerConfig xs -> Rep (HardForkLedgerConfig xs) x)
-> (forall x.
Rep (HardForkLedgerConfig xs) x -> HardForkLedgerConfig xs)
-> Generic (HardForkLedgerConfig xs)
forall (xs :: [*]) x.
Rep (HardForkLedgerConfig xs) x -> HardForkLedgerConfig xs
forall (xs :: [*]) x.
HardForkLedgerConfig xs -> Rep (HardForkLedgerConfig xs) x
forall x.
Rep (HardForkLedgerConfig xs) x -> HardForkLedgerConfig xs
forall x.
HardForkLedgerConfig xs -> Rep (HardForkLedgerConfig xs) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (xs :: [*]) x.
Rep (HardForkLedgerConfig xs) x -> HardForkLedgerConfig xs
$cfrom :: forall (xs :: [*]) x.
HardForkLedgerConfig xs -> Rep (HardForkLedgerConfig xs) x
Generic)
instance CanHardFork xs => NoThunks (HardForkLedgerConfig xs)
type instance LedgerCfg (LedgerState (HardForkBlock xs)) = HardForkLedgerConfig xs
completeLedgerConfig' :: forall blk.
HasPartialLedgerConfig blk
=> EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk
-> LedgerConfig blk
completeLedgerConfig' :: EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk -> LedgerConfig blk
completeLedgerConfig' EpochInfo (Except PastHorizonException)
ei =
Proxy blk
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig blk
-> LedgerConfig blk
forall blk (proxy :: * -> *).
HasPartialLedgerConfig blk =>
proxy blk
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig blk
-> LedgerConfig blk
completeLedgerConfig (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) EpochInfo (Except PastHorizonException)
ei
(PartialLedgerConfig blk -> LedgerConfig blk)
-> (WrapPartialLedgerConfig blk -> PartialLedgerConfig blk)
-> WrapPartialLedgerConfig blk
-> LedgerConfig blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapPartialLedgerConfig blk -> PartialLedgerConfig blk
forall blk. WrapPartialLedgerConfig blk -> PartialLedgerConfig blk
unwrapPartialLedgerConfig
completeLedgerConfig'' :: forall blk.
HasPartialLedgerConfig blk
=> EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk
-> WrapLedgerConfig blk
completeLedgerConfig'' :: EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk -> WrapLedgerConfig blk
completeLedgerConfig'' EpochInfo (Except PastHorizonException)
ei =
LedgerCfg (LedgerState blk) -> WrapLedgerConfig blk
forall blk. LedgerConfig blk -> WrapLedgerConfig blk
WrapLedgerConfig
(LedgerCfg (LedgerState blk) -> WrapLedgerConfig blk)
-> (WrapPartialLedgerConfig blk -> LedgerCfg (LedgerState blk))
-> WrapPartialLedgerConfig blk
-> WrapLedgerConfig blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy blk
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig blk
-> LedgerCfg (LedgerState blk)
forall blk (proxy :: * -> *).
HasPartialLedgerConfig blk =>
proxy blk
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig blk
-> LedgerConfig blk
completeLedgerConfig (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) EpochInfo (Except PastHorizonException)
ei
(PartialLedgerConfig blk -> LedgerCfg (LedgerState blk))
-> (WrapPartialLedgerConfig blk -> PartialLedgerConfig blk)
-> WrapPartialLedgerConfig blk
-> LedgerCfg (LedgerState blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapPartialLedgerConfig blk -> PartialLedgerConfig blk
forall blk. WrapPartialLedgerConfig blk -> PartialLedgerConfig blk
unwrapPartialLedgerConfig
completeConsensusConfig' :: forall blk.
HasPartialConsensusConfig (BlockProtocol blk)
=> EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig blk
-> ConsensusConfig (BlockProtocol blk)
completeConsensusConfig' :: EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig blk
-> ConsensusConfig (BlockProtocol blk)
completeConsensusConfig' EpochInfo (Except PastHorizonException)
ei =
Proxy (BlockProtocol blk)
-> EpochInfo (Except PastHorizonException)
-> PartialConsensusConfig (BlockProtocol blk)
-> ConsensusConfig (BlockProtocol blk)
forall p (proxy :: * -> *).
HasPartialConsensusConfig p =>
proxy p
-> EpochInfo (Except PastHorizonException)
-> PartialConsensusConfig p
-> ConsensusConfig p
completeConsensusConfig (Proxy (BlockProtocol blk)
forall k (t :: k). Proxy t
Proxy @(BlockProtocol blk)) EpochInfo (Except PastHorizonException)
ei
(PartialConsensusConfig (BlockProtocol blk)
-> ConsensusConfig (BlockProtocol blk))
-> (WrapPartialConsensusConfig blk
-> PartialConsensusConfig (BlockProtocol blk))
-> WrapPartialConsensusConfig blk
-> ConsensusConfig (BlockProtocol blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapPartialConsensusConfig blk
-> PartialConsensusConfig (BlockProtocol blk)
forall blk.
WrapPartialConsensusConfig blk
-> PartialConsensusConfig (BlockProtocol blk)
unwrapPartialConsensusConfig
completeConsensusConfig'' :: forall blk.
HasPartialConsensusConfig (BlockProtocol blk)
=> EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig blk
-> WrapConsensusConfig blk
completeConsensusConfig'' :: EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig blk -> WrapConsensusConfig blk
completeConsensusConfig'' EpochInfo (Except PastHorizonException)
ei =
ConsensusConfig (BlockProtocol blk) -> WrapConsensusConfig blk
forall blk.
ConsensusConfig (BlockProtocol blk) -> WrapConsensusConfig blk
WrapConsensusConfig
(ConsensusConfig (BlockProtocol blk) -> WrapConsensusConfig blk)
-> (WrapPartialConsensusConfig blk
-> ConsensusConfig (BlockProtocol blk))
-> WrapPartialConsensusConfig blk
-> WrapConsensusConfig blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (BlockProtocol blk)
-> EpochInfo (Except PastHorizonException)
-> PartialConsensusConfig (BlockProtocol blk)
-> ConsensusConfig (BlockProtocol blk)
forall p (proxy :: * -> *).
HasPartialConsensusConfig p =>
proxy p
-> EpochInfo (Except PastHorizonException)
-> PartialConsensusConfig p
-> ConsensusConfig p
completeConsensusConfig (Proxy (BlockProtocol blk)
forall k (t :: k). Proxy t
Proxy @(BlockProtocol blk)) EpochInfo (Except PastHorizonException)
ei
(PartialConsensusConfig (BlockProtocol blk)
-> ConsensusConfig (BlockProtocol blk))
-> (WrapPartialConsensusConfig blk
-> PartialConsensusConfig (BlockProtocol blk))
-> WrapPartialConsensusConfig blk
-> ConsensusConfig (BlockProtocol blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapPartialConsensusConfig blk
-> PartialConsensusConfig (BlockProtocol blk)
forall blk.
WrapPartialConsensusConfig blk
-> PartialConsensusConfig (BlockProtocol blk)
unwrapPartialConsensusConfig
distribLedgerConfig ::
CanHardFork xs
=> EpochInfo (Except PastHorizonException)
-> LedgerConfig (HardForkBlock xs)
-> NP WrapLedgerConfig xs
distribLedgerConfig :: EpochInfo (Except PastHorizonException)
-> LedgerConfig (HardForkBlock xs) -> NP WrapLedgerConfig xs
distribLedgerConfig EpochInfo (Except PastHorizonException)
ei LedgerConfig (HardForkBlock xs)
cfg =
Proxy SingleEraBlock
-> (forall a.
SingleEraBlock a =>
WrapPartialLedgerConfig a -> WrapLedgerConfig a)
-> NP WrapPartialLedgerConfig xs
-> NP WrapLedgerConfig xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
(xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
(f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap
Proxy SingleEraBlock
proxySingle
(EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig a -> WrapLedgerConfig a
forall blk.
HasPartialLedgerConfig blk =>
EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk -> WrapLedgerConfig blk
completeLedgerConfig'' EpochInfo (Except PastHorizonException)
ei)
(PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
forall (xs :: [*]).
PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
getPerEraLedgerConfig (PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs)
-> PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
forall a b. (a -> b) -> a -> b
$ HardForkLedgerConfig xs -> PerEraLedgerConfig xs
forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
hardForkLedgerConfigPerEra LedgerConfig (HardForkBlock xs)
HardForkLedgerConfig xs
cfg)
distribTopLevelConfig :: All SingleEraBlock xs
=> EpochInfo (Except PastHorizonException)
-> TopLevelConfig (HardForkBlock xs)
-> NP TopLevelConfig xs
distribTopLevelConfig :: EpochInfo (Except PastHorizonException)
-> TopLevelConfig (HardForkBlock xs) -> NP TopLevelConfig xs
distribTopLevelConfig EpochInfo (Except PastHorizonException)
ei TopLevelConfig (HardForkBlock xs)
tlc =
Proxy SingleEraBlock
-> (forall a.
SingleEraBlock a =>
(-.->)
WrapPartialConsensusConfig
(WrapPartialLedgerConfig
-.-> (BlockConfig
-.-> (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig))))
a)
-> NP
(WrapPartialConsensusConfig
-.-> (WrapPartialLedgerConfig
-.-> (BlockConfig
-.-> (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig)))))
xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
(xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
hcpure Proxy SingleEraBlock
proxySingle
((WrapPartialConsensusConfig a
-> WrapPartialLedgerConfig a
-> BlockConfig a
-> CodecConfig a
-> StorageConfig a
-> TopLevelConfig a)
-> (-.->)
WrapPartialConsensusConfig
(WrapPartialLedgerConfig
-.-> (BlockConfig
-.-> (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig))))
a
forall k (f0 :: k -> *) (a :: k) (f1 :: k -> *) (f2 :: k -> *)
(f3 :: k -> *) (f4 :: k -> *) (f5 :: k -> *).
(f0 a -> f1 a -> f2 a -> f3 a -> f4 a -> f5 a)
-> (-.->) f0 (f1 -.-> (f2 -.-> (f3 -.-> (f4 -.-> f5)))) a
fn_5 (\WrapPartialConsensusConfig a
cfgConsensus WrapPartialLedgerConfig a
cfgLedger BlockConfig a
cfgBlock CodecConfig a
cfgCodec StorageConfig a
cfgStorage ->
ConsensusConfig (BlockProtocol a)
-> LedgerConfig a
-> BlockConfig a
-> CodecConfig a
-> StorageConfig a
-> TopLevelConfig a
forall blk.
ConsensusConfig (BlockProtocol blk)
-> LedgerConfig blk
-> BlockConfig blk
-> CodecConfig blk
-> StorageConfig blk
-> TopLevelConfig blk
mkTopLevelConfig
(EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig a
-> ConsensusConfig (BlockProtocol a)
forall blk.
HasPartialConsensusConfig (BlockProtocol blk) =>
EpochInfo (Except PastHorizonException)
-> WrapPartialConsensusConfig blk
-> ConsensusConfig (BlockProtocol blk)
completeConsensusConfig' EpochInfo (Except PastHorizonException)
ei WrapPartialConsensusConfig a
cfgConsensus)
(EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig a -> LedgerConfig a
forall blk.
HasPartialLedgerConfig blk =>
EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk -> LedgerConfig blk
completeLedgerConfig' EpochInfo (Except PastHorizonException)
ei WrapPartialLedgerConfig a
cfgLedger)
BlockConfig a
cfgBlock
CodecConfig a
cfgCodec
StorageConfig a
cfgStorage))
Prod
NP
(WrapPartialConsensusConfig
-.-> (WrapPartialLedgerConfig
-.-> (BlockConfig
-.-> (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig)))))
xs
-> NP WrapPartialConsensusConfig xs
-> NP
(WrapPartialLedgerConfig
-.-> (BlockConfig
-.-> (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig))))
xs
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
(xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
`hap`
(PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs
forall (xs :: [*]).
PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs
getPerEraConsensusConfig (PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs)
-> PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs
forall a b. (a -> b) -> a -> b
$
ConsensusConfig (HardForkProtocol xs) -> PerEraConsensusConfig xs
forall (xs :: [*]).
ConsensusConfig (HardForkProtocol xs) -> PerEraConsensusConfig xs
hardForkConsensusConfigPerEra (TopLevelConfig (HardForkBlock xs)
-> ConsensusConfig (BlockProtocol (HardForkBlock xs))
forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
configConsensus TopLevelConfig (HardForkBlock xs)
tlc))
Prod
NP
(WrapPartialLedgerConfig
-.-> (BlockConfig
-.-> (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig))))
xs
-> NP WrapPartialLedgerConfig xs
-> NP
(BlockConfig
-.-> (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig)))
xs
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
(xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
`hap`
(PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
forall (xs :: [*]).
PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
getPerEraLedgerConfig (PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs)
-> PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
forall a b. (a -> b) -> a -> b
$
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
hardForkLedgerConfigPerEra (TopLevelConfig (HardForkBlock xs)
-> LedgerConfig (HardForkBlock xs)
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger TopLevelConfig (HardForkBlock xs)
tlc))
Prod
NP
(BlockConfig
-.-> (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig)))
xs
-> NP BlockConfig xs
-> NP (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig)) xs
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
(xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
`hap`
(PerEraBlockConfig xs -> NP BlockConfig xs
forall (xs :: [*]). PerEraBlockConfig xs -> NP BlockConfig xs
getPerEraBlockConfig (PerEraBlockConfig xs -> NP BlockConfig xs)
-> PerEraBlockConfig xs -> NP BlockConfig xs
forall a b. (a -> b) -> a -> b
$
BlockConfig (HardForkBlock xs) -> PerEraBlockConfig xs
forall (xs :: [*]).
BlockConfig (HardForkBlock xs) -> PerEraBlockConfig xs
hardForkBlockConfigPerEra (TopLevelConfig (HardForkBlock xs) -> BlockConfig (HardForkBlock xs)
forall blk. TopLevelConfig blk -> BlockConfig blk
configBlock TopLevelConfig (HardForkBlock xs)
tlc))
Prod NP (CodecConfig -.-> (StorageConfig -.-> TopLevelConfig)) xs
-> NP CodecConfig xs -> NP (StorageConfig -.-> TopLevelConfig) xs
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
(xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
`hap`
(PerEraCodecConfig xs -> NP CodecConfig xs
forall (xs :: [*]). PerEraCodecConfig xs -> NP CodecConfig xs
getPerEraCodecConfig (PerEraCodecConfig xs -> NP CodecConfig xs)
-> PerEraCodecConfig xs -> NP CodecConfig xs
forall a b. (a -> b) -> a -> b
$
CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
forall (xs :: [*]).
CodecConfig (HardForkBlock xs) -> PerEraCodecConfig xs
hardForkCodecConfigPerEra (TopLevelConfig (HardForkBlock xs) -> CodecConfig (HardForkBlock xs)
forall blk. TopLevelConfig blk -> CodecConfig blk
configCodec TopLevelConfig (HardForkBlock xs)
tlc))
Prod NP (StorageConfig -.-> TopLevelConfig) xs
-> NP StorageConfig xs -> NP TopLevelConfig xs
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
(xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
`hap`
(PerEraStorageConfig xs -> NP StorageConfig xs
forall (xs :: [*]). PerEraStorageConfig xs -> NP StorageConfig xs
getPerEraStorageConfig (PerEraStorageConfig xs -> NP StorageConfig xs)
-> PerEraStorageConfig xs -> NP StorageConfig xs
forall a b. (a -> b) -> a -> b
$
StorageConfig (HardForkBlock xs) -> PerEraStorageConfig xs
forall (xs :: [*]).
StorageConfig (HardForkBlock xs) -> PerEraStorageConfig xs
hardForkStorageConfigPerEra (TopLevelConfig (HardForkBlock xs)
-> StorageConfig (HardForkBlock xs)
forall blk. TopLevelConfig blk -> StorageConfig blk
configStorage TopLevelConfig (HardForkBlock xs)
tlc))