{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Ouroboros.Consensus.HardFork.Combinator.Embed.Binary (protocolInfoBinary) where

import           Control.Exception (assert)
import           Data.Align (alignWith)
import           Data.SOP.Strict (NP (..))
import           Data.These (These (..))

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Ledger.Basics (LedgerConfig)
import           Ouroboros.Consensus.Ledger.Extended
import           Ouroboros.Consensus.Node
import           Ouroboros.Consensus.Protocol.Abstract (protocolSecurityParam)
import           Ouroboros.Consensus.TypeFamilyWrappers
import           Ouroboros.Consensus.Util.Counting (exactlyTwo)
import           Ouroboros.Consensus.Util.OptNP (OptNP (..))

import           Ouroboros.Consensus.HardFork.Combinator
import qualified Ouroboros.Consensus.HardFork.History as History

{-------------------------------------------------------------------------------
  ProtocolInfo
-------------------------------------------------------------------------------}

protocolInfoBinary ::
     forall m blk1 blk2.
     (CanHardFork '[blk1, blk2], Monad m)
     -- First era
  => ProtocolInfo m blk1
  -> History.EraParams
  -> (ConsensusConfig (BlockProtocol blk1) -> PartialConsensusConfig (BlockProtocol blk1))
  -> (LedgerConfig blk1 -> PartialLedgerConfig blk1)
     -- Second era
  -> ProtocolInfo m blk2
  -> History.EraParams
  -> (ConsensusConfig (BlockProtocol blk2) -> PartialConsensusConfig (BlockProtocol blk2))
  -> (LedgerConfig blk2 -> PartialLedgerConfig blk2)
  -> ProtocolInfo m (HardForkBlock '[blk1, blk2])
protocolInfoBinary :: ProtocolInfo m blk1
-> EraParams
-> (ConsensusConfig (BlockProtocol blk1)
    -> PartialConsensusConfig (BlockProtocol blk1))
-> (LedgerConfig blk1 -> PartialLedgerConfig blk1)
-> ProtocolInfo m blk2
-> EraParams
-> (ConsensusConfig (BlockProtocol blk2)
    -> PartialConsensusConfig (BlockProtocol blk2))
-> (LedgerConfig blk2 -> PartialLedgerConfig blk2)
-> ProtocolInfo m (HardForkBlock '[blk1, blk2])
protocolInfoBinary ProtocolInfo m blk1
protocolInfo1 EraParams
eraParams1 ConsensusConfig (BlockProtocol blk1)
-> PartialConsensusConfig (BlockProtocol blk1)
toPartialConsensusConfig1 LedgerConfig blk1 -> PartialLedgerConfig blk1
toPartialLedgerConfig1
                   ProtocolInfo m blk2
protocolInfo2 EraParams
eraParams2 ConsensusConfig (BlockProtocol blk2)
-> PartialConsensusConfig (BlockProtocol blk2)
toPartialConsensusConfig2 LedgerConfig blk2 -> PartialLedgerConfig blk2
toPartialLedgerConfig2 =
    ProtocolInfo :: forall (m :: * -> *) b.
TopLevelConfig b
-> ExtLedgerState b -> m [BlockForging m b] -> ProtocolInfo m b
ProtocolInfo {
        pInfoConfig :: TopLevelConfig (HardForkBlock '[blk1, blk2])
pInfoConfig = TopLevelConfig :: forall blk.
ConsensusConfig (BlockProtocol blk)
-> LedgerConfig blk
-> BlockConfig blk
-> CodecConfig blk
-> StorageConfig blk
-> TopLevelConfig blk
TopLevelConfig {
            topLevelConfigProtocol :: ConsensusConfig (BlockProtocol (HardForkBlock '[blk1, blk2]))
topLevelConfigProtocol = HardForkConsensusConfig :: forall (xs :: [*]).
SecurityParam
-> Shape xs
-> PerEraConsensusConfig xs
-> ConsensusConfig (HardForkProtocol xs)
HardForkConsensusConfig {
                hardForkConsensusConfigK :: SecurityParam
hardForkConsensusConfigK      = SecurityParam
k
              , hardForkConsensusConfigShape :: Shape '[blk1, blk2]
hardForkConsensusConfigShape  = Shape '[blk1, blk2]
shape
              , hardForkConsensusConfigPerEra :: PerEraConsensusConfig '[blk1, blk2]
hardForkConsensusConfigPerEra = NP WrapPartialConsensusConfig '[blk1, blk2]
-> PerEraConsensusConfig '[blk1, blk2]
forall (xs :: [*]).
NP WrapPartialConsensusConfig xs -> PerEraConsensusConfig xs
PerEraConsensusConfig
                  (  PartialConsensusConfig (BlockProtocol blk1)
-> WrapPartialConsensusConfig blk1
forall blk.
PartialConsensusConfig (BlockProtocol blk)
-> WrapPartialConsensusConfig blk
WrapPartialConsensusConfig (ConsensusConfig (BlockProtocol blk1)
-> PartialConsensusConfig (BlockProtocol blk1)
toPartialConsensusConfig1 ConsensusConfig (BlockProtocol blk1)
consensusConfig1)
                  WrapPartialConsensusConfig blk1
-> NP WrapPartialConsensusConfig '[blk2]
-> NP WrapPartialConsensusConfig '[blk1, blk2]
forall a (f :: a -> *) (x :: a) (xs :: [a]).
f x -> NP f xs -> NP f (x : xs)
:* PartialConsensusConfig (BlockProtocol blk2)
-> WrapPartialConsensusConfig blk2
forall blk.
PartialConsensusConfig (BlockProtocol blk)
-> WrapPartialConsensusConfig blk
WrapPartialConsensusConfig (ConsensusConfig (BlockProtocol blk2)
-> PartialConsensusConfig (BlockProtocol blk2)
toPartialConsensusConfig2 ConsensusConfig (BlockProtocol blk2)
consensusConfig2)
                  WrapPartialConsensusConfig blk2
-> NP WrapPartialConsensusConfig '[]
-> NP WrapPartialConsensusConfig '[blk2]
forall a (f :: a -> *) (x :: a) (xs :: [a]).
f x -> NP f xs -> NP f (x : xs)
:* NP WrapPartialConsensusConfig '[]
forall k (f :: k -> *). NP f '[]
Nil
                  )
              }
          , topLevelConfigLedger :: LedgerConfig (HardForkBlock '[blk1, blk2])
topLevelConfigLedger = HardForkLedgerConfig :: forall (xs :: [*]).
Shape xs -> PerEraLedgerConfig xs -> HardForkLedgerConfig xs
HardForkLedgerConfig {
                hardForkLedgerConfigShape :: Shape '[blk1, blk2]
hardForkLedgerConfigShape  = Shape '[blk1, blk2]
shape
              , hardForkLedgerConfigPerEra :: PerEraLedgerConfig '[blk1, blk2]
hardForkLedgerConfigPerEra = NP WrapPartialLedgerConfig '[blk1, blk2]
-> PerEraLedgerConfig '[blk1, blk2]
forall (xs :: [*]).
NP WrapPartialLedgerConfig xs -> PerEraLedgerConfig xs
PerEraLedgerConfig
                  (  PartialLedgerConfig blk1 -> WrapPartialLedgerConfig blk1
forall blk. PartialLedgerConfig blk -> WrapPartialLedgerConfig blk
WrapPartialLedgerConfig (LedgerConfig blk1 -> PartialLedgerConfig blk1
toPartialLedgerConfig1 LedgerConfig blk1
ledgerConfig1)
                  WrapPartialLedgerConfig blk1
-> NP WrapPartialLedgerConfig '[blk2]
-> NP WrapPartialLedgerConfig '[blk1, blk2]
forall a (f :: a -> *) (x :: a) (xs :: [a]).
f x -> NP f xs -> NP f (x : xs)
:* PartialLedgerConfig blk2 -> WrapPartialLedgerConfig blk2
forall blk. PartialLedgerConfig blk -> WrapPartialLedgerConfig blk
WrapPartialLedgerConfig (LedgerConfig blk2 -> PartialLedgerConfig blk2
toPartialLedgerConfig2 LedgerConfig blk2
ledgerConfig2)
                  WrapPartialLedgerConfig blk2
-> NP WrapPartialLedgerConfig '[]
-> NP WrapPartialLedgerConfig '[blk2]
forall a (f :: a -> *) (x :: a) (xs :: [a]).
f x -> NP f xs -> NP f (x : xs)
:* NP WrapPartialLedgerConfig '[]
forall k (f :: k -> *). NP f '[]
Nil
                  )
              }
          , topLevelConfigBlock :: BlockConfig (HardForkBlock '[blk1, blk2])
topLevelConfigBlock =
              PerEraBlockConfig '[blk1, blk2]
-> BlockConfig (HardForkBlock '[blk1, blk2])
forall (xs :: [*]).
PerEraBlockConfig xs -> BlockConfig (HardForkBlock xs)
HardForkBlockConfig (PerEraBlockConfig '[blk1, blk2]
 -> BlockConfig (HardForkBlock '[blk1, blk2]))
-> PerEraBlockConfig '[blk1, blk2]
-> BlockConfig (HardForkBlock '[blk1, blk2])
forall a b. (a -> b) -> a -> b
$
                NP BlockConfig '[blk1, blk2] -> PerEraBlockConfig '[blk1, blk2]
forall (xs :: [*]). NP BlockConfig xs -> PerEraBlockConfig xs
PerEraBlockConfig (NP BlockConfig '[blk1, blk2] -> PerEraBlockConfig '[blk1, blk2])
-> NP BlockConfig '[blk1, blk2] -> PerEraBlockConfig '[blk1, blk2]
forall a b. (a -> b) -> a -> b
$
                  (BlockConfig blk1
blockConfig1 BlockConfig blk1
-> NP BlockConfig '[blk2] -> NP BlockConfig '[blk1, blk2]
forall a (f :: a -> *) (x :: a) (xs :: [a]).
f x -> NP f xs -> NP f (x : xs)
:* BlockConfig blk2
blockConfig2 BlockConfig blk2 -> NP BlockConfig '[] -> NP BlockConfig '[blk2]
forall a (f :: a -> *) (x :: a) (xs :: [a]).
f x -> NP f xs -> NP f (x : xs)
:* NP BlockConfig '[]
forall k (f :: k -> *). NP f '[]
Nil)
          , topLevelConfigCodec :: CodecConfig (HardForkBlock '[blk1, blk2])
topLevelConfigCodec =
              PerEraCodecConfig '[blk1, blk2]
-> CodecConfig (HardForkBlock '[blk1, blk2])
forall (xs :: [*]).
PerEraCodecConfig xs -> CodecConfig (HardForkBlock xs)
HardForkCodecConfig (PerEraCodecConfig '[blk1, blk2]
 -> CodecConfig (HardForkBlock '[blk1, blk2]))
-> PerEraCodecConfig '[blk1, blk2]
-> CodecConfig (HardForkBlock '[blk1, blk2])
forall a b. (a -> b) -> a -> b
$
                NP CodecConfig '[blk1, blk2] -> PerEraCodecConfig '[blk1, blk2]
forall (xs :: [*]). NP CodecConfig xs -> PerEraCodecConfig xs
PerEraCodecConfig (NP CodecConfig '[blk1, blk2] -> PerEraCodecConfig '[blk1, blk2])
-> NP CodecConfig '[blk1, blk2] -> PerEraCodecConfig '[blk1, blk2]
forall a b. (a -> b) -> a -> b
$
                  (CodecConfig blk1
codecConfig1 CodecConfig blk1
-> NP CodecConfig '[blk2] -> NP CodecConfig '[blk1, blk2]
forall a (f :: a -> *) (x :: a) (xs :: [a]).
f x -> NP f xs -> NP f (x : xs)
:* CodecConfig blk2
codecConfig2 CodecConfig blk2 -> NP CodecConfig '[] -> NP CodecConfig '[blk2]
forall a (f :: a -> *) (x :: a) (xs :: [a]).
f x -> NP f xs -> NP f (x : xs)
:* NP CodecConfig '[]
forall k (f :: k -> *). NP f '[]
Nil)
          , topLevelConfigStorage :: StorageConfig (HardForkBlock '[blk1, blk2])
topLevelConfigStorage =
              PerEraStorageConfig '[blk1, blk2]
-> StorageConfig (HardForkBlock '[blk1, blk2])
forall (xs :: [*]).
PerEraStorageConfig xs -> StorageConfig (HardForkBlock xs)
HardForkStorageConfig (PerEraStorageConfig '[blk1, blk2]
 -> StorageConfig (HardForkBlock '[blk1, blk2]))
-> PerEraStorageConfig '[blk1, blk2]
-> StorageConfig (HardForkBlock '[blk1, blk2])
forall a b. (a -> b) -> a -> b
$
                NP StorageConfig '[blk1, blk2] -> PerEraStorageConfig '[blk1, blk2]
forall (xs :: [*]). NP StorageConfig xs -> PerEraStorageConfig xs
PerEraStorageConfig (NP StorageConfig '[blk1, blk2]
 -> PerEraStorageConfig '[blk1, blk2])
-> NP StorageConfig '[blk1, blk2]
-> PerEraStorageConfig '[blk1, blk2]
forall a b. (a -> b) -> a -> b
$
                  (StorageConfig blk1
storageConfig1 StorageConfig blk1
-> NP StorageConfig '[blk2] -> NP StorageConfig '[blk1, blk2]
forall a (f :: a -> *) (x :: a) (xs :: [a]).
f x -> NP f xs -> NP f (x : xs)
:* StorageConfig blk2
storageConfig2 StorageConfig blk2
-> NP StorageConfig '[] -> NP StorageConfig '[blk2]
forall a (f :: a -> *) (x :: a) (xs :: [a]).
f x -> NP f xs -> NP f (x : xs)
:* NP StorageConfig '[]
forall k (f :: k -> *). NP f '[]
Nil)
          }
      , pInfoInitLedger :: ExtLedgerState (HardForkBlock '[blk1, blk2])
pInfoInitLedger = ExtLedgerState :: forall blk.
LedgerState blk -> HeaderState blk -> ExtLedgerState blk
ExtLedgerState {
            ledgerState :: LedgerState (HardForkBlock '[blk1, blk2])
ledgerState =
              HardForkState LedgerState '[blk1, blk2]
-> LedgerState (HardForkBlock '[blk1, blk2])
forall (xs :: [*]).
HardForkState LedgerState xs -> LedgerState (HardForkBlock xs)
HardForkLedgerState (HardForkState LedgerState '[blk1, blk2]
 -> LedgerState (HardForkBlock '[blk1, blk2]))
-> HardForkState LedgerState '[blk1, blk2]
-> LedgerState (HardForkBlock '[blk1, blk2])
forall a b. (a -> b) -> a -> b
$
                LedgerState blk1 -> HardForkState LedgerState '[blk1, blk2]
forall (f :: * -> *) x (xs :: [*]). f x -> HardForkState f (x : xs)
initHardForkState LedgerState blk1
initLedgerState1
          , headerState :: HeaderState (HardForkBlock '[blk1, blk2])
headerState =
              ChainDepState (BlockProtocol (HardForkBlock '[blk1, blk2]))
-> HeaderState (HardForkBlock '[blk1, blk2])
forall blk. ChainDepState (BlockProtocol blk) -> HeaderState blk
genesisHeaderState (ChainDepState (BlockProtocol (HardForkBlock '[blk1, blk2]))
 -> HeaderState (HardForkBlock '[blk1, blk2]))
-> ChainDepState (BlockProtocol (HardForkBlock '[blk1, blk2]))
-> HeaderState (HardForkBlock '[blk1, blk2])
forall a b. (a -> b) -> a -> b
$
                WrapChainDepState blk1
-> HardForkState WrapChainDepState '[blk1, blk2]
forall (f :: * -> *) x (xs :: [*]). f x -> HardForkState f (x : xs)
initHardForkState (WrapChainDepState blk1
 -> HardForkState WrapChainDepState '[blk1, blk2])
-> WrapChainDepState blk1
-> HardForkState WrapChainDepState '[blk1, blk2]
forall a b. (a -> b) -> a -> b
$
                  ChainDepState (BlockProtocol blk1) -> WrapChainDepState blk1
forall blk.
ChainDepState (BlockProtocol blk) -> WrapChainDepState blk
WrapChainDepState (ChainDepState (BlockProtocol blk1) -> WrapChainDepState blk1)
-> ChainDepState (BlockProtocol blk1) -> WrapChainDepState blk1
forall a b. (a -> b) -> a -> b
$
                    HeaderState blk1 -> ChainDepState (BlockProtocol blk1)
forall blk. HeaderState blk -> ChainDepState (BlockProtocol blk)
headerStateChainDep HeaderState blk1
initHeaderState1
          }
      , pInfoBlockForging :: m [BlockForging m (HardForkBlock '[blk1, blk2])]
pInfoBlockForging =
          (These (BlockForging m blk1) (BlockForging m blk2)
 -> BlockForging m (HardForkBlock '[blk1, blk2]))
-> [BlockForging m blk1]
-> [BlockForging m blk2]
-> [BlockForging m (HardForkBlock '[blk1, blk2])]
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These (BlockForging m blk1) (BlockForging m blk2)
-> BlockForging m (HardForkBlock '[blk1, blk2])
alignBlockForging ([BlockForging m blk1]
 -> [BlockForging m blk2]
 -> [BlockForging m (HardForkBlock '[blk1, blk2])])
-> m [BlockForging m blk1]
-> m ([BlockForging m blk2]
      -> [BlockForging m (HardForkBlock '[blk1, blk2])])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [BlockForging m blk1]
blockForging1 m ([BlockForging m blk2]
   -> [BlockForging m (HardForkBlock '[blk1, blk2])])
-> m [BlockForging m blk2]
-> m [BlockForging m (HardForkBlock '[blk1, blk2])]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m [BlockForging m blk2]
blockForging2
      }
  where
    ProtocolInfo {
        pInfoConfig :: forall (m :: * -> *) b. ProtocolInfo m b -> TopLevelConfig b
pInfoConfig = TopLevelConfig {
            topLevelConfigProtocol :: forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
topLevelConfigProtocol = ConsensusConfig (BlockProtocol blk1)
consensusConfig1
          , topLevelConfigLedger :: forall blk. TopLevelConfig blk -> LedgerConfig blk
topLevelConfigLedger   = LedgerConfig blk1
ledgerConfig1
          , topLevelConfigBlock :: forall blk. TopLevelConfig blk -> BlockConfig blk
topLevelConfigBlock    = BlockConfig blk1
blockConfig1
          , topLevelConfigCodec :: forall blk. TopLevelConfig blk -> CodecConfig blk
topLevelConfigCodec    = CodecConfig blk1
codecConfig1
          , topLevelConfigStorage :: forall blk. TopLevelConfig blk -> StorageConfig blk
topLevelConfigStorage  = StorageConfig blk1
storageConfig1
          }
      , pInfoInitLedger :: forall (m :: * -> *) b. ProtocolInfo m b -> ExtLedgerState b
pInfoInitLedger = ExtLedgerState {
            ledgerState :: forall blk. ExtLedgerState blk -> LedgerState blk
ledgerState = LedgerState blk1
initLedgerState1
          , headerState :: forall blk. ExtLedgerState blk -> HeaderState blk
headerState = HeaderState blk1
initHeaderState1
          }
      , pInfoBlockForging :: forall (m :: * -> *) b. ProtocolInfo m b -> m [BlockForging m b]
pInfoBlockForging = m [BlockForging m blk1]
blockForging1
      } = ProtocolInfo m blk1
protocolInfo1

    ProtocolInfo {
        pInfoConfig :: forall (m :: * -> *) b. ProtocolInfo m b -> TopLevelConfig b
pInfoConfig = TopLevelConfig {
            topLevelConfigProtocol :: forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
topLevelConfigProtocol = ConsensusConfig (BlockProtocol blk2)
consensusConfig2
          , topLevelConfigLedger :: forall blk. TopLevelConfig blk -> LedgerConfig blk
topLevelConfigLedger   = LedgerConfig blk2
ledgerConfig2
          , topLevelConfigBlock :: forall blk. TopLevelConfig blk -> BlockConfig blk
topLevelConfigBlock    = BlockConfig blk2
blockConfig2
          , topLevelConfigCodec :: forall blk. TopLevelConfig blk -> CodecConfig blk
topLevelConfigCodec    = CodecConfig blk2
codecConfig2
          , topLevelConfigStorage :: forall blk. TopLevelConfig blk -> StorageConfig blk
topLevelConfigStorage  = StorageConfig blk2
storageConfig2
          }
      , pInfoBlockForging :: forall (m :: * -> *) b. ProtocolInfo m b -> m [BlockForging m b]
pInfoBlockForging = m [BlockForging m blk2]
blockForging2
      } = ProtocolInfo m blk2
protocolInfo2

    k1, k2, k :: SecurityParam
    k1 :: SecurityParam
k1 = ConsensusConfig (BlockProtocol blk1) -> SecurityParam
forall p. ConsensusProtocol p => ConsensusConfig p -> SecurityParam
protocolSecurityParam ConsensusConfig (BlockProtocol blk1)
consensusConfig1
    k2 :: SecurityParam
k2 = ConsensusConfig (BlockProtocol blk2) -> SecurityParam
forall p. ConsensusProtocol p => ConsensusConfig p -> SecurityParam
protocolSecurityParam ConsensusConfig (BlockProtocol blk2)
consensusConfig2
    k :: SecurityParam
k = Bool -> SecurityParam -> SecurityParam
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (SecurityParam
k1 SecurityParam -> SecurityParam -> Bool
forall a. Eq a => a -> a -> Bool
== SecurityParam
k2) SecurityParam
k1

    shape :: History.Shape '[blk1, blk2]
    shape :: Shape '[blk1, blk2]
shape = Exactly '[blk1, blk2] EraParams -> Shape '[blk1, blk2]
forall (xs :: [*]). Exactly xs EraParams -> Shape xs
History.Shape (Exactly '[blk1, blk2] EraParams -> Shape '[blk1, blk2])
-> Exactly '[blk1, blk2] EraParams -> Shape '[blk1, blk2]
forall a b. (a -> b) -> a -> b
$ EraParams -> EraParams -> Exactly '[blk1, blk2] EraParams
forall a x y. a -> a -> Exactly '[x, y] a
exactlyTwo EraParams
eraParams1 EraParams
eraParams2

    alignBlockForging ::
         These (BlockForging m blk1) (BlockForging m blk2)
      -> BlockForging m (HardForkBlock '[blk1, blk2])
    alignBlockForging :: These (BlockForging m blk1) (BlockForging m blk2)
-> BlockForging m (HardForkBlock '[blk1, blk2])
alignBlockForging = \case
      This BlockForging m blk1
bf1 ->
        Text
-> NonEmptyOptNP (BlockForging m) '[blk1, blk2]
-> BlockForging m (HardForkBlock '[blk1, blk2])
forall (m :: * -> *) (xs :: [*]).
(CanHardFork xs, Monad m) =>
Text
-> NonEmptyOptNP (BlockForging m) xs
-> BlockForging m (HardForkBlock xs)
hardForkBlockForging
          (BlockForging m blk1 -> Text
forall (m :: * -> *) blk. BlockForging m blk -> Text
forgeLabel BlockForging m blk1
bf1)
          (BlockForging m blk1
-> OptNP 'True (BlockForging m) '[blk2]
-> NonEmptyOptNP (BlockForging m) '[blk1, blk2]
forall a (f :: a -> *) (x :: a) (empty :: Bool) (xs :: [a]).
f x -> OptNP empty f xs -> OptNP 'False f (x : xs)
OptCons BlockForging m blk1
bf1 (OptNP 'True (BlockForging m) '[blk2]
 -> NonEmptyOptNP (BlockForging m) '[blk1, blk2])
-> OptNP 'True (BlockForging m) '[blk2]
-> NonEmptyOptNP (BlockForging m) '[blk1, blk2]
forall a b. (a -> b) -> a -> b
$ OptNP 'True (BlockForging m) '[]
-> OptNP 'True (BlockForging m) '[blk2]
forall a (empty :: Bool) (f :: a -> *) (xs :: [a]) (x :: a).
OptNP empty f xs -> OptNP empty f (x : xs)
OptSkip OptNP 'True (BlockForging m) '[]
forall k (f :: k -> *). OptNP 'True f '[]
OptNil)
      That BlockForging m blk2
bf2 ->
        Text
-> NonEmptyOptNP (BlockForging m) '[blk1, blk2]
-> BlockForging m (HardForkBlock '[blk1, blk2])
forall (m :: * -> *) (xs :: [*]).
(CanHardFork xs, Monad m) =>
Text
-> NonEmptyOptNP (BlockForging m) xs
-> BlockForging m (HardForkBlock xs)
hardForkBlockForging
          (BlockForging m blk2 -> Text
forall (m :: * -> *) blk. BlockForging m blk -> Text
forgeLabel BlockForging m blk2
bf2)
          (OptNP 'False (BlockForging m) '[blk2]
-> NonEmptyOptNP (BlockForging m) '[blk1, blk2]
forall a (empty :: Bool) (f :: a -> *) (xs :: [a]) (x :: a).
OptNP empty f xs -> OptNP empty f (x : xs)
OptSkip (OptNP 'False (BlockForging m) '[blk2]
 -> NonEmptyOptNP (BlockForging m) '[blk1, blk2])
-> OptNP 'False (BlockForging m) '[blk2]
-> NonEmptyOptNP (BlockForging m) '[blk1, blk2]
forall a b. (a -> b) -> a -> b
$ BlockForging m blk2
-> OptNP 'True (BlockForging m) '[]
-> OptNP 'False (BlockForging m) '[blk2]
forall a (f :: a -> *) (x :: a) (empty :: Bool) (xs :: [a]).
f x -> OptNP empty f xs -> OptNP 'False f (x : xs)
OptCons BlockForging m blk2
bf2 OptNP 'True (BlockForging m) '[]
forall k (f :: k -> *). OptNP 'True f '[]
OptNil)
      These BlockForging m blk1
bf1 BlockForging m blk2
bf2 ->
        Text
-> NonEmptyOptNP (BlockForging m) '[blk1, blk2]
-> BlockForging m (HardForkBlock '[blk1, blk2])
forall (m :: * -> *) (xs :: [*]).
(CanHardFork xs, Monad m) =>
Text
-> NonEmptyOptNP (BlockForging m) xs
-> BlockForging m (HardForkBlock xs)
hardForkBlockForging
          (BlockForging m blk1 -> Text
forall (m :: * -> *) blk. BlockForging m blk -> Text
forgeLabel BlockForging m blk1
bf1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockForging m blk2 -> Text
forall (m :: * -> *) blk. BlockForging m blk -> Text
forgeLabel BlockForging m blk2
bf2)
          (BlockForging m blk1
-> OptNP 'False (BlockForging m) '[blk2]
-> NonEmptyOptNP (BlockForging m) '[blk1, blk2]
forall a (f :: a -> *) (x :: a) (empty :: Bool) (xs :: [a]).
f x -> OptNP empty f xs -> OptNP 'False f (x : xs)
OptCons BlockForging m blk1
bf1 (OptNP 'False (BlockForging m) '[blk2]
 -> NonEmptyOptNP (BlockForging m) '[blk1, blk2])
-> OptNP 'False (BlockForging m) '[blk2]
-> NonEmptyOptNP (BlockForging m) '[blk1, blk2]
forall a b. (a -> b) -> a -> b
$ BlockForging m blk2
-> OptNP 'True (BlockForging m) '[]
-> OptNP 'False (BlockForging m) '[blk2]
forall a (f :: a -> *) (x :: a) (empty :: Bool) (xs :: [a]).
f x -> OptNP empty f xs -> OptNP 'False f (x : xs)
OptCons BlockForging m blk2
bf2 OptNP 'True (BlockForging m) '[]
forall k (f :: k -> *). OptNP 'True f '[]
OptNil)