{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Ouroboros.Consensus.HardFork.Combinator.Basics (
    -- * Hard fork protocol, block, and ledger state
    HardForkBlock (..)
  , HardForkProtocol
  , LedgerState (..)
    -- * Config
  , BlockConfig (..)
  , CodecConfig (..)
  , ConsensusConfig (..)
  , HardForkLedgerConfig (..)
  , StorageConfig (..)
    -- ** Functions on config
  , completeConsensusConfig'
  , completeConsensusConfig''
  , completeLedgerConfig'
  , completeLedgerConfig''
  , distribLedgerConfig
  , distribTopLevelConfig
    -- ** Convenience re-exports
  , EpochInfo
  , Except
  ) where

import           Cardano.Slotting.EpochInfo
import           Data.Kind (Type)
import           Data.SOP.Constraint
import           Data.SOP.Strict
import           Data.Typeable
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)
import           Ouroboros.Consensus.Block.Abstract
import           Ouroboros.Consensus.Config
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
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)

{-------------------------------------------------------------------------------
  Hard fork protocol, block, and ledger state
-------------------------------------------------------------------------------}

data HardForkProtocol (xs :: [Type])

newtype HardForkBlock xs = HardForkBlock {
      forall (xs :: [*]). 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
$cshowsPrec :: forall (xs :: [*]).
CanHardFork xs =>
Int -> HardForkBlock xs -> ShowS
showsPrec :: Int -> HardForkBlock xs -> ShowS
$cshow :: forall (xs :: [*]). CanHardFork xs => HardForkBlock xs -> String
show :: HardForkBlock xs -> String
$cshowList :: forall (xs :: [*]). CanHardFork xs => [HardForkBlock xs] -> ShowS
showList :: [HardForkBlock xs] -> ShowS
Show)

instance Typeable xs => ShowProxy (HardForkBlock xs) where

type instance BlockProtocol (HardForkBlock xs) = HardForkProtocol xs
type instance HeaderHash    (HardForkBlock xs) = OneEraHash       xs

newtype instance LedgerState (HardForkBlock xs) = HardForkLedgerState {
      forall (xs :: [*]).
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))

{-------------------------------------------------------------------------------
  Protocol config
-------------------------------------------------------------------------------}

data instance ConsensusConfig (HardForkProtocol xs) = HardForkConsensusConfig {
      -- | The value of @k@ cannot change at hard fork boundaries
      forall (xs :: [*]).
ConsensusConfig (HardForkProtocol xs) -> SecurityParam
hardForkConsensusConfigK :: !(SecurityParam)

      -- | The shape of the hard fork
      --
      -- We require this in the consensus config because consensus might need
      -- access to 'EpochInfo', and in order to compute that, we need the
      -- 'EraParams' of all eras.
    , forall (xs :: [*]).
ConsensusConfig (HardForkProtocol xs) -> Shape xs
hardForkConsensusConfigShape :: !(History.Shape xs)

      -- | Config for each era
    , forall (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
$cfrom :: forall (xs :: [*]) x.
ConsensusConfig (HardForkProtocol xs)
-> Rep (ConsensusConfig (HardForkProtocol xs)) x
from :: forall x.
ConsensusConfig (HardForkProtocol xs)
-> Rep (ConsensusConfig (HardForkProtocol xs)) x
$cto :: forall (xs :: [*]) x.
Rep (ConsensusConfig (HardForkProtocol xs)) x
-> ConsensusConfig (HardForkProtocol xs)
to :: forall x.
Rep (ConsensusConfig (HardForkProtocol xs)) x
-> ConsensusConfig (HardForkProtocol xs)
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
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context
-> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo)
noThunks :: Context
-> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context
-> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo)
wNoThunks :: Context
-> ConsensusConfig (HardForkProtocol xs) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (ConsensusConfig (HardForkProtocol xs)) -> String
showTypeOf :: Proxy (ConsensusConfig (HardForkProtocol xs)) -> String
NoThunks)

{-------------------------------------------------------------------------------
  Block config
-------------------------------------------------------------------------------}

newtype instance BlockConfig (HardForkBlock xs) = HardForkBlockConfig {
      forall (xs :: [*]).
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
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> BlockConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (BlockConfig (HardForkBlock xs)) -> String
showTypeOf :: Proxy (BlockConfig (HardForkBlock xs)) -> String
NoThunks)

{-------------------------------------------------------------------------------
  Codec config
-------------------------------------------------------------------------------}

newtype instance CodecConfig (HardForkBlock xs) = HardForkCodecConfig {
      forall (xs :: [*]).
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
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
noThunks :: Context -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CodecConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (CodecConfig (HardForkBlock xs)) -> String
showTypeOf :: Proxy (CodecConfig (HardForkBlock xs)) -> String
NoThunks)

{-------------------------------------------------------------------------------
  Storage config
-------------------------------------------------------------------------------}

newtype instance StorageConfig (HardForkBlock xs) = HardForkStorageConfig {
      forall (xs :: [*]).
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
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
noThunks :: Context -> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> StorageConfig (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (StorageConfig (HardForkBlock xs)) -> String
showTypeOf :: Proxy (StorageConfig (HardForkBlock xs)) -> String
NoThunks)

{-------------------------------------------------------------------------------
  Ledger config
-------------------------------------------------------------------------------}

data HardForkLedgerConfig xs = HardForkLedgerConfig {
      forall (xs :: [*]). HardForkLedgerConfig xs -> Shape xs
hardForkLedgerConfigShape  :: !(History.Shape xs)
    , forall (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
$cfrom :: forall (xs :: [*]) x.
HardForkLedgerConfig xs -> Rep (HardForkLedgerConfig xs) x
from :: forall x.
HardForkLedgerConfig xs -> Rep (HardForkLedgerConfig xs) x
$cto :: forall (xs :: [*]) x.
Rep (HardForkLedgerConfig xs) x -> HardForkLedgerConfig xs
to :: forall x.
Rep (HardForkLedgerConfig xs) x -> HardForkLedgerConfig xs
Generic)

instance CanHardFork xs => NoThunks (HardForkLedgerConfig xs)

type instance LedgerCfg (LedgerState (HardForkBlock xs)) = HardForkLedgerConfig xs

{-------------------------------------------------------------------------------
  Operations on config
-------------------------------------------------------------------------------}

completeLedgerConfig' :: forall blk.
                         HasPartialLedgerConfig blk
                      => EpochInfo (Except PastHorizonException)
                      -> WrapPartialLedgerConfig blk
                      -> LedgerConfig blk
completeLedgerConfig' :: forall blk.
HasPartialLedgerConfig blk =>
EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk -> LedgerConfig blk
completeLedgerConfig' EpochInfo (Except PastHorizonException)
ei =
      Proxy blk
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig blk
-> LedgerCfg (LedgerState blk)
forall blk (proxy :: * -> *).
HasPartialLedgerConfig blk =>
proxy blk
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig blk
-> LedgerConfig blk
forall (proxy :: * -> *).
proxy blk
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig blk
-> LedgerCfg (LedgerState blk)
completeLedgerConfig (forall t. Proxy t
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

completeLedgerConfig'' :: forall blk.
                          HasPartialLedgerConfig blk
                       => EpochInfo (Except PastHorizonException)
                       -> WrapPartialLedgerConfig blk
                       -> WrapLedgerConfig blk
completeLedgerConfig'' :: forall blk.
HasPartialLedgerConfig blk =>
EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk -> WrapLedgerConfig blk
completeLedgerConfig'' EpochInfo (Except PastHorizonException)
ei =
      LedgerConfig blk -> WrapLedgerConfig blk
forall blk. LedgerConfig blk -> WrapLedgerConfig blk
WrapLedgerConfig
    (LedgerConfig blk -> WrapLedgerConfig blk)
-> (WrapPartialLedgerConfig blk -> LedgerConfig blk)
-> WrapPartialLedgerConfig blk
-> WrapLedgerConfig blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy blk
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig blk
-> LedgerConfig blk
forall blk (proxy :: * -> *).
HasPartialLedgerConfig blk =>
proxy blk
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig blk
-> LedgerConfig blk
forall (proxy :: * -> *).
proxy blk
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig blk
-> LedgerConfig blk
completeLedgerConfig (forall t. Proxy t
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

completeConsensusConfig' :: forall blk.
                            HasPartialConsensusConfig (BlockProtocol blk)
                         => EpochInfo (Except PastHorizonException)
                         -> WrapPartialConsensusConfig blk
                         -> ConsensusConfig (BlockProtocol blk)
completeConsensusConfig' :: forall blk.
HasPartialConsensusConfig (BlockProtocol blk) =>
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
forall (proxy :: * -> *).
proxy (BlockProtocol blk)
-> EpochInfo (Except PastHorizonException)
-> PartialConsensusConfig (BlockProtocol blk)
-> ConsensusConfig (BlockProtocol blk)
completeConsensusConfig (forall t. Proxy t
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'' :: forall blk.
HasPartialConsensusConfig (BlockProtocol blk) =>
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
forall (proxy :: * -> *).
proxy (BlockProtocol blk)
-> EpochInfo (Except PastHorizonException)
-> PartialConsensusConfig (BlockProtocol blk)
-> ConsensusConfig (BlockProtocol blk)
completeConsensusConfig (forall t. Proxy t
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 :: forall (xs :: [*]).
CanHardFork xs =>
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 :: forall (xs :: [*]).
All SingleEraBlock xs =>
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
forall (c :: * -> Constraint) (xs :: [*])
       (proxy :: (* -> Constraint) -> *) (f :: * -> *).
AllN NP c xs =>
proxy c -> (forall a. c a => f a) -> NP 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
-> CheckpointsMap a
-> TopLevelConfig a
forall blk.
ConsensusConfig (BlockProtocol blk)
-> LedgerConfig blk
-> BlockConfig blk
-> CodecConfig blk
-> StorageConfig blk
-> CheckpointsMap 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
             -- topLevelConfigCheckpoints is only used in validateEnvelope,
             -- where it comes from the TopLevelConfig of the HardForkBlock.
             --
             -- The checkpoints of the underlying blocks are not used.
             CheckpointsMap a
forall blk. CheckpointsMap blk
emptyCheckpointsMap))
    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
forall (f :: * -> *) (g :: * -> *) (xs :: [*]).
Prod NP (f -.-> g) xs -> NP f xs -> NP 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
forall (f :: * -> *) (g :: * -> *) (xs :: [*]).
Prod NP (f -.-> g) xs -> NP f xs -> NP 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
forall (f :: * -> *) (g :: * -> *) (xs :: [*]).
Prod NP (f -.-> g) xs -> NP f xs -> NP 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
forall (f :: * -> *) (g :: * -> *) (xs :: [*]).
Prod NP (f -.-> g) xs -> NP f xs -> NP 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
forall (f :: * -> *) (g :: * -> *) (xs :: [*]).
Prod NP (f -.-> g) xs -> NP f xs -> NP 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))