{-# 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.Counting (exactlyTwo)
import Data.SOP.Functors (Flip (..))
import Data.SOP.OptNP (OptNP (..))
import Data.SOP.Strict (NP (..))
import Data.These (These (..))
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.HardFork.Combinator
import qualified Ouroboros.Consensus.HardFork.History as History
import Ouroboros.Consensus.HeaderValidation
import Ouroboros.Consensus.Ledger.Basics (LedgerConfig)
import Ouroboros.Consensus.Ledger.Extended
import Ouroboros.Consensus.Node.ProtocolInfo
import Ouroboros.Consensus.Protocol.Abstract (protocolSecurityParam)
import Ouroboros.Consensus.TypeFamilyWrappers

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

protocolInfoBinary ::
  forall m blk1 blk2.
  (CanHardFork '[blk1, blk2], Monad m) =>
  -- First era
  ProtocolInfo blk1 ->
  m [BlockForging m blk1] ->
  History.EraParams ->
  (ConsensusConfig (BlockProtocol blk1) -> PartialConsensusConfig (BlockProtocol blk1)) ->
  (LedgerConfig blk1 -> PartialLedgerConfig blk1) ->
  -- Second era
  ProtocolInfo blk2 ->
  m [BlockForging m blk2] ->
  History.EraParams ->
  (ConsensusConfig (BlockProtocol blk2) -> PartialConsensusConfig (BlockProtocol blk2)) ->
  (LedgerConfig blk2 -> PartialLedgerConfig blk2) ->
  ( ProtocolInfo (HardForkBlock '[blk1, blk2])
  , m [BlockForging m (HardForkBlock '[blk1, blk2])]
  )
protocolInfoBinary :: forall (m :: * -> *) blk1 blk2.
(CanHardFork '[blk1, blk2], Monad m) =>
ProtocolInfo blk1
-> m [BlockForging m blk1]
-> EraParams
-> (ConsensusConfig (BlockProtocol blk1)
    -> PartialConsensusConfig (BlockProtocol blk1))
-> (LedgerConfig blk1 -> PartialLedgerConfig blk1)
-> ProtocolInfo blk2
-> m [BlockForging m blk2]
-> EraParams
-> (ConsensusConfig (BlockProtocol blk2)
    -> PartialConsensusConfig (BlockProtocol blk2))
-> (LedgerConfig blk2 -> PartialLedgerConfig blk2)
-> (ProtocolInfo (HardForkBlock '[blk1, blk2]),
    m [BlockForging m (HardForkBlock '[blk1, blk2])])
protocolInfoBinary
  ProtocolInfo blk1
protocolInfo1
  m [BlockForging m blk1]
blockForging1
  EraParams
eraParams1
  ConsensusConfig (BlockProtocol blk1)
-> PartialConsensusConfig (BlockProtocol blk1)
toPartialConsensusConfig1
  LedgerConfig blk1 -> PartialLedgerConfig blk1
toPartialLedgerConfig1
  ProtocolInfo blk2
protocolInfo2
  m [BlockForging m blk2]
blockForging2
  EraParams
eraParams2
  ConsensusConfig (BlockProtocol blk2)
-> PartialConsensusConfig (BlockProtocol blk2)
toPartialConsensusConfig2
  LedgerConfig blk2 -> PartialLedgerConfig blk2
toPartialLedgerConfig2 =
    ( ProtocolInfo
        { pInfoConfig :: TopLevelConfig (HardForkBlock '[blk1, blk2])
pInfoConfig =
            TopLevelConfig
              { topLevelConfigProtocol :: ConsensusConfig (BlockProtocol (HardForkBlock '[blk1, blk2]))
topLevelConfigProtocol =
                  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 {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* 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 {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP WrapPartialConsensusConfig '[]
forall {k} (f :: k -> *). NP f '[]
Nil
                          )
                    }
              , topLevelConfigLedger :: LedgerConfig (HardForkBlock '[blk1, blk2])
topLevelConfigLedger =
                  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 {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* 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 {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* 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 {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* BlockConfig blk2
blockConfig2 BlockConfig blk2 -> NP BlockConfig '[] -> NP BlockConfig '[blk2]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* 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 {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* CodecConfig blk2
codecConfig2 CodecConfig blk2 -> NP CodecConfig '[] -> NP CodecConfig '[blk2]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* 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 {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* StorageConfig blk2
storageConfig2 StorageConfig blk2
-> NP StorageConfig '[] -> NP StorageConfig '[blk2]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP StorageConfig '[]
forall {k} (f :: k -> *). NP f '[]
Nil)
              , topLevelConfigCheckpoints :: CheckpointsMap (HardForkBlock '[blk1, blk2])
topLevelConfigCheckpoints = CheckpointsMap (HardForkBlock '[blk1, blk2])
forall blk. CheckpointsMap blk
emptyCheckpointsMap
              }
        , pInfoInitLedger :: ExtLedgerState (HardForkBlock '[blk1, blk2]) ValuesMK
pInfoInitLedger =
            ExtLedgerState
              { ledgerState :: LedgerState (HardForkBlock '[blk1, blk2]) ValuesMK
ledgerState =
                  HardForkState (Flip LedgerState ValuesMK) '[blk1, blk2]
-> LedgerState (HardForkBlock '[blk1, blk2]) ValuesMK
forall (xs :: [*]) (mk :: MapKind).
HardForkState (Flip LedgerState mk) xs
-> LedgerState (HardForkBlock xs) mk
HardForkLedgerState (HardForkState (Flip LedgerState ValuesMK) '[blk1, blk2]
 -> LedgerState (HardForkBlock '[blk1, blk2]) ValuesMK)
-> HardForkState (Flip LedgerState ValuesMK) '[blk1, blk2]
-> LedgerState (HardForkBlock '[blk1, blk2]) ValuesMK
forall a b. (a -> b) -> a -> b
$
                    Flip LedgerState ValuesMK blk1
-> HardForkState (Flip LedgerState ValuesMK) '[blk1, blk2]
forall (f :: * -> *) x (xs :: [*]). f x -> HardForkState f (x : xs)
initHardForkState (LedgerState blk1 ValuesMK -> Flip LedgerState ValuesMK blk1
forall x y (f :: x -> y -> *) (x1 :: y) (y1 :: x).
f y1 x1 -> Flip f x1 y1
Flip LedgerState blk1 ValuesMK
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
              }
        }
    , (These (BlockForging m blk1) (BlockForging m blk2)
 -> BlockForging m (HardForkBlock '[blk1, blk2]))
-> [BlockForging m blk1]
-> [BlockForging m blk2]
-> [BlockForging m (HardForkBlock '[blk1, blk2])]
forall a b c. (These a b -> c) -> [a] -> [b] -> [c]
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 a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m [BlockForging m blk2]
blockForging2
    )
   where
    ProtocolInfo
      { pInfoConfig :: forall b. ProtocolInfo 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 b. ProtocolInfo b -> ExtLedgerState b ValuesMK
pInfoInitLedger =
        ExtLedgerState
          { ledgerState :: forall blk (mk :: MapKind).
ExtLedgerState blk mk -> LedgerState blk mk
ledgerState = LedgerState blk1 ValuesMK
initLedgerState1
          , headerState :: forall blk (mk :: MapKind).
ExtLedgerState blk mk -> HeaderState blk
headerState = HeaderState blk1
initHeaderState1
          }
      } = ProtocolInfo blk1
protocolInfo1

    ProtocolInfo
      { pInfoConfig :: forall b. ProtocolInfo 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
          }
      } = ProtocolInfo 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 {k} (f :: k -> *) (x :: k) (empty1 :: Bool) (xs1 :: [k]).
f x -> OptNP empty1 f xs1 -> OptNP 'False f (x : xs1)
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 {k} (empty :: Bool) (f :: k -> *) (xs1 :: [k]) (x :: k).
OptNP empty f xs1 -> OptNP empty f (x : xs1)
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 {k} (empty :: Bool) (f :: k -> *) (xs1 :: [k]) (x :: k).
OptNP empty f xs1 -> OptNP empty f (x : xs1)
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 {k} (f :: k -> *) (x :: k) (empty1 :: Bool) (xs1 :: [k]).
f x -> OptNP empty1 f xs1 -> OptNP 'False f (x : xs1)
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 {k} (f :: k -> *) (x :: k) (empty1 :: Bool) (xs1 :: [k]).
f x -> OptNP empty1 f xs1 -> OptNP 'False f (x : xs1)
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 {k} (f :: k -> *) (x :: k) (empty1 :: Bool) (xs1 :: [k]).
f x -> OptNP empty1 f xs1 -> OptNP 'False f (x : xs1)
OptCons BlockForging m blk2
bf2 OptNP 'True (BlockForging m) '[]
forall {k} (f :: k -> *). OptNP 'True f '[]
OptNil)