{-# 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 (
    -- * 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           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

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

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 HeaderHash    (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))

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

data instance ConsensusConfig (HardForkProtocol xs) = HardForkConsensusConfig {
      -- | The value of @k@ cannot change at hard fork boundaries
      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.
    , ConsensusConfig (HardForkProtocol xs) -> Shape xs
hardForkConsensusConfigShape :: !(History.Shape xs)

      -- | Config for each era
    , 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)

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

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)

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

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)

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

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)

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

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

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

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))