{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans #-}

-- | Test infrastructure to test hard-forking from one Shelley-based era to
-- another, e.g., Shelley to Allegra.
module Test.ThreadNet.Infra.ShelleyBasedHardFork (
    -- * Blocks
    ShelleyBasedHardForkBlock
  , ShelleyBasedHardForkEras
    -- * Transactions
  , pattern GenTxShelley1
  , pattern GenTxShelley2
    -- * Node
  , ShelleyBasedHardForkConstraints
  , protocolInfoShelleyBasedHardFork
  ) where

import qualified Cardano.Ledger.Api.Transition as L
import qualified Cardano.Ledger.Era as SL
import qualified Cardano.Ledger.Shelley.API as SL
import           Control.Monad.Except (runExcept)
import qualified Data.Map.Strict as Map
import           Data.SOP.BasicFunctors
import qualified Data.SOP.InPairs as InPairs
import           Data.SOP.Strict
import qualified Data.SOP.Tails as Tails
import           Data.Void (Void)
import           Lens.Micro ((^.))
import           Ouroboros.Consensus.Block.Forging (BlockForging)
import           Ouroboros.Consensus.Cardano.CanHardFork
                     (ShelleyPartialLedgerConfig (..),
                     crossEraForecastAcrossShelley,
                     translateChainDepStateAcrossShelley)
import           Ouroboros.Consensus.Cardano.Node (TriggerHardFork (..))
import           Ouroboros.Consensus.HardFork.Combinator
import           Ouroboros.Consensus.HardFork.Combinator.Embed.Binary
import           Ouroboros.Consensus.HardFork.Combinator.Serialisation
import qualified Ouroboros.Consensus.HardFork.Combinator.State.Types as HFC
import qualified Ouroboros.Consensus.HardFork.History as History
import           Ouroboros.Consensus.Ledger.Basics (LedgerConfig)
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.Ledger.SupportsProtocol
                     (LedgerSupportsProtocol)
import           Ouroboros.Consensus.Node
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
import           Ouroboros.Consensus.Protocol.TPraos
import           Ouroboros.Consensus.Shelley.Eras
import           Ouroboros.Consensus.Shelley.Ledger
import           Ouroboros.Consensus.Shelley.Node
import           Ouroboros.Consensus.TypeFamilyWrappers
import           Ouroboros.Consensus.Util (eitherToMaybe)
import           Ouroboros.Consensus.Util.IOLike (IOLike)
import           Test.ThreadNet.TxGen
import           Test.ThreadNet.TxGen.Shelley ()

{-------------------------------------------------------------------------------
  Block type
-------------------------------------------------------------------------------}

-- | Two eras, both Shelley-based.
type ShelleyBasedHardForkEras proto1 era1 proto2 era2 =
    '[ShelleyBlock proto1 era1, ShelleyBlock proto2 era2]

type ShelleyBasedHardForkBlock proto1 era1 proto2 era2 =
  HardForkBlock (ShelleyBasedHardForkEras proto1 era1 proto2 era2)

{-------------------------------------------------------------------------------
  Pattern synonyms, for encapsulation and legibility
-------------------------------------------------------------------------------}

type ShelleyBasedHardForkGenTx proto1 era1 proto2 era2 =
  GenTx (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)

pattern GenTxShelley1 ::
     GenTx (ShelleyBlock proto1 era1)
  -> ShelleyBasedHardForkGenTx proto1 era1 proto2 era2
pattern $mGenTxShelley1 :: forall {r} {proto1} {era1} {proto2} {era2}.
ShelleyBasedHardForkGenTx proto1 era1 proto2 era2
-> (GenTx (ShelleyBlock proto1 era1) -> r) -> ((# #) -> r) -> r
$bGenTxShelley1 :: forall proto1 era1 proto2 era2.
GenTx (ShelleyBlock proto1 era1)
-> ShelleyBasedHardForkGenTx proto1 era1 proto2 era2
GenTxShelley1 tx = HardForkGenTx (OneEraGenTx (Z tx))

pattern GenTxShelley2 ::
     GenTx (ShelleyBlock proto2 era2)
  -> ShelleyBasedHardForkGenTx proto1 era1 proto2 era2
pattern $mGenTxShelley2 :: forall {r} {proto2} {era2} {proto1} {era1}.
ShelleyBasedHardForkGenTx proto1 era1 proto2 era2
-> (GenTx (ShelleyBlock proto2 era2) -> r) -> ((# #) -> r) -> r
$bGenTxShelley2 :: forall proto2 era2 proto1 era1.
GenTx (ShelleyBlock proto2 era2)
-> ShelleyBasedHardForkGenTx proto1 era1 proto2 era2
GenTxShelley2 tx = HardForkGenTx (OneEraGenTx (S (Z tx)))

{-# COMPLETE GenTxShelley1, GenTxShelley2 #-}

pattern ShelleyBasedHardForkNodeToNodeVersion1 ::
     BlockNodeToNodeVersion (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
pattern $mShelleyBasedHardForkNodeToNodeVersion1 :: forall {r} {proto1} {era1} {proto2} {era2}.
BlockNodeToNodeVersion
  (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
-> ((# #) -> r) -> ((# #) -> r) -> r
$bShelleyBasedHardForkNodeToNodeVersion1 :: forall proto1 era1 proto2 era2.
BlockNodeToNodeVersion
  (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
ShelleyBasedHardForkNodeToNodeVersion1 =
    HardForkNodeToNodeEnabled
      HardForkSpecificNodeToNodeVersion1
      (  WrapNodeToNodeVersion ShelleyNodeToNodeVersion1
      :* WrapNodeToNodeVersion ShelleyNodeToNodeVersion1
      :* Nil
      )

pattern ShelleyBasedHardForkNodeToClientVersion1 ::
     BlockNodeToClientVersion (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
pattern $mShelleyBasedHardForkNodeToClientVersion1 :: forall {r} {proto1} {era1} {proto2} {era2}.
BlockNodeToClientVersion
  (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
-> ((# #) -> r) -> ((# #) -> r) -> r
$bShelleyBasedHardForkNodeToClientVersion1 :: forall proto1 era1 proto2 era2.
BlockNodeToClientVersion
  (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
ShelleyBasedHardForkNodeToClientVersion1 =
    HardForkNodeToClientEnabled
      HardForkSpecificNodeToClientVersion2
      (  EraNodeToClientEnabled ShelleyNodeToClientVersion2
      :* EraNodeToClientEnabled ShelleyNodeToClientVersion2
      :* Nil
      )

{-------------------------------------------------------------------------------
  Consensus instances
-------------------------------------------------------------------------------}

type ShelleyBasedHardForkConstraints proto1 era1 proto2 era2 =
  ( ShelleyCompatible proto1 era1
  , ShelleyCompatible proto2 era2
  , LedgerSupportsProtocol (ShelleyBlock proto1 era1)
  , LedgerSupportsProtocol (ShelleyBlock proto2 era2)
  , TxLimits (ShelleyBlock proto1 era1)
  , TxLimits (ShelleyBlock proto2 era2)
  , TranslateTxMeasure (TxMeasure (ShelleyBlock proto1 era1)) (TxMeasure (ShelleyBlock proto2 era2))
  , SL.PreviousEra era2 ~ era1

  , SL.TranslateEra       era2 SL.NewEpochState
  , SL.TranslateEra       era2 WrapTx

  , SL.TranslationError   era2 SL.NewEpochState ~ Void

    -- At the moment, fix the protocols together
  , EraCrypto era1 ~ EraCrypto era2
  , PraosCrypto (EraCrypto era1)
  , proto1 ~ TPraos (EraCrypto era1)
  , proto1 ~ proto2
  )

class TranslateTxMeasure a b where
  translateTxMeasure :: a -> b

instance TranslateTxMeasure (IgnoringOverflow ByteSize32) (IgnoringOverflow ByteSize32) where
  translateTxMeasure :: IgnoringOverflow ByteSize32 -> IgnoringOverflow ByteSize32
translateTxMeasure = IgnoringOverflow ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> a
id

instance TranslateTxMeasure (IgnoringOverflow ByteSize32) AlonzoMeasure where
  translateTxMeasure :: IgnoringOverflow ByteSize32 -> AlonzoMeasure
translateTxMeasure IgnoringOverflow ByteSize32
x = IgnoringOverflow ByteSize32 -> ExUnits' Natural -> AlonzoMeasure
AlonzoMeasure IgnoringOverflow ByteSize32
x ExUnits' Natural
forall a. Monoid a => a
mempty

instance TranslateTxMeasure (IgnoringOverflow ByteSize32) ConwayMeasure where
  translateTxMeasure :: IgnoringOverflow ByteSize32 -> ConwayMeasure
translateTxMeasure =
    AlonzoMeasure -> ConwayMeasure
forall a b. TranslateTxMeasure a b => a -> b
translateTxMeasure (AlonzoMeasure -> ConwayMeasure)
-> (IgnoringOverflow ByteSize32 -> AlonzoMeasure)
-> IgnoringOverflow ByteSize32
-> ConwayMeasure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\AlonzoMeasure
x -> AlonzoMeasure
x :: AlonzoMeasure) (AlonzoMeasure -> AlonzoMeasure)
-> (IgnoringOverflow ByteSize32 -> AlonzoMeasure)
-> IgnoringOverflow ByteSize32
-> AlonzoMeasure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IgnoringOverflow ByteSize32 -> AlonzoMeasure
forall a b. TranslateTxMeasure a b => a -> b
translateTxMeasure

instance TranslateTxMeasure AlonzoMeasure AlonzoMeasure where
  translateTxMeasure :: AlonzoMeasure -> AlonzoMeasure
translateTxMeasure = AlonzoMeasure -> AlonzoMeasure
forall a. a -> a
id

instance TranslateTxMeasure AlonzoMeasure ConwayMeasure where
  translateTxMeasure :: AlonzoMeasure -> ConwayMeasure
translateTxMeasure AlonzoMeasure
x = AlonzoMeasure -> IgnoringOverflow ByteSize32 -> ConwayMeasure
ConwayMeasure AlonzoMeasure
x IgnoringOverflow ByteSize32
forall a. Monoid a => a
mempty

instance TranslateTxMeasure ConwayMeasure ConwayMeasure where
  translateTxMeasure :: ConwayMeasure -> ConwayMeasure
translateTxMeasure = ConwayMeasure -> ConwayMeasure
forall a. a -> a
id

instance ShelleyBasedHardForkConstraints proto1 era1 proto2 era2
      => SerialiseHFC (ShelleyBasedHardForkEras proto1 era1 proto2 era2)
   -- use defaults

instance ShelleyBasedHardForkConstraints proto1 era1 proto2 era2
      => CanHardFork (ShelleyBasedHardForkEras proto1 era1 proto2 era2) where
  type HardForkTxMeasure (ShelleyBasedHardForkEras proto1 era1 proto2 era2) =
      TxMeasure (ShelleyBlock proto2 era2)

  hardForkEraTranslation :: EraTranslation (ShelleyBasedHardForkEras proto1 era1 proto2 era2)
hardForkEraTranslation = EraTranslation {
        translateLedgerState :: InPairs
  (RequiringBoth WrapLedgerConfig (Translate LedgerState))
  (ShelleyBasedHardForkEras proto1 era1 proto2 era2)
translateLedgerState   = RequiringBoth
  WrapLedgerConfig
  (Translate LedgerState)
  (ShelleyBlock proto1 era1)
  (ShelleyBlock proto2 era2)
-> InPairs
     (RequiringBoth WrapLedgerConfig (Translate LedgerState))
     '[ShelleyBlock proto2 era2]
-> InPairs
     (RequiringBoth WrapLedgerConfig (Translate LedgerState))
     (ShelleyBasedHardForkEras proto1 era1 proto2 era2)
forall {k} (f :: k -> k -> *) (x :: k) (y :: k) (zs :: [k]).
f x y -> InPairs f (y : zs) -> InPairs f (x : y : zs)
PCons RequiringBoth
  WrapLedgerConfig
  (Translate LedgerState)
  (ShelleyBlock proto1 era1)
  (ShelleyBlock proto2 era2)
translateLedgerState                InPairs
  (RequiringBoth WrapLedgerConfig (Translate LedgerState))
  '[ShelleyBlock proto2 era2]
forall {k} (f :: k -> k -> *) (x :: k). InPairs f '[x]
PNil
      , translateChainDepState :: InPairs
  (RequiringBoth WrapConsensusConfig (Translate WrapChainDepState))
  (ShelleyBasedHardForkEras proto1 era1 proto2 era2)
translateChainDepState = RequiringBoth
  WrapConsensusConfig
  (Translate WrapChainDepState)
  (ShelleyBlock proto1 era1)
  (ShelleyBlock proto2 era2)
-> InPairs
     (RequiringBoth WrapConsensusConfig (Translate WrapChainDepState))
     '[ShelleyBlock proto2 era2]
-> InPairs
     (RequiringBoth WrapConsensusConfig (Translate WrapChainDepState))
     (ShelleyBasedHardForkEras proto1 era1 proto2 era2)
forall {k} (f :: k -> k -> *) (x :: k) (y :: k) (zs :: [k]).
f x y -> InPairs f (y : zs) -> InPairs f (x : y : zs)
PCons RequiringBoth
  WrapConsensusConfig
  (Translate WrapChainDepState)
  (ShelleyBlock proto1 era1)
  (ShelleyBlock proto2 era2)
forall eraFrom eraTo protoFrom protoTo.
TranslateProto protoFrom protoTo =>
RequiringBoth
  WrapConsensusConfig
  (Translate WrapChainDepState)
  (ShelleyBlock protoFrom eraFrom)
  (ShelleyBlock protoTo eraTo)
translateChainDepStateAcrossShelley InPairs
  (RequiringBoth WrapConsensusConfig (Translate WrapChainDepState))
  '[ShelleyBlock proto2 era2]
forall {k} (f :: k -> k -> *) (x :: k). InPairs f '[x]
PNil
      , crossEraForecast :: InPairs
  (RequiringBoth
     WrapLedgerConfig (CrossEraForecaster LedgerState WrapLedgerView))
  (ShelleyBasedHardForkEras proto1 era1 proto2 era2)
crossEraForecast       = RequiringBoth
  WrapLedgerConfig
  (CrossEraForecaster LedgerState WrapLedgerView)
  (ShelleyBlock proto1 era1)
  (ShelleyBlock proto2 era2)
-> InPairs
     (RequiringBoth
        WrapLedgerConfig (CrossEraForecaster LedgerState WrapLedgerView))
     '[ShelleyBlock proto2 era2]
-> InPairs
     (RequiringBoth
        WrapLedgerConfig (CrossEraForecaster LedgerState WrapLedgerView))
     (ShelleyBasedHardForkEras proto1 era1 proto2 era2)
forall {k} (f :: k -> k -> *) (x :: k) (y :: k) (zs :: [k]).
f x y -> InPairs f (y : zs) -> InPairs f (x : y : zs)
PCons RequiringBoth
  WrapLedgerConfig
  (CrossEraForecaster LedgerState WrapLedgerView)
  (ShelleyBlock proto1 era1)
  (ShelleyBlock proto2 era2)
forall eraFrom eraTo protoFrom protoTo.
(TranslateProto protoFrom protoTo,
 LedgerSupportsProtocol (ShelleyBlock protoFrom eraFrom)) =>
RequiringBoth
  WrapLedgerConfig
  (CrossEraForecaster LedgerState WrapLedgerView)
  (ShelleyBlock protoFrom eraFrom)
  (ShelleyBlock protoTo eraTo)
crossEraForecastAcrossShelley       InPairs
  (RequiringBoth
     WrapLedgerConfig (CrossEraForecaster LedgerState WrapLedgerView))
  '[ShelleyBlock proto2 era2]
forall {k} (f :: k -> k -> *) (x :: k). InPairs f '[x]
PNil
      }
    where
      translateLedgerState ::
           InPairs.RequiringBoth
             WrapLedgerConfig
             (HFC.Translate LedgerState)
             (ShelleyBlock proto1 era1)
             (ShelleyBlock proto2 era2)
      translateLedgerState :: RequiringBoth
  WrapLedgerConfig
  (Translate LedgerState)
  (ShelleyBlock proto1 era1)
  (ShelleyBlock proto2 era2)
translateLedgerState =
          (WrapLedgerConfig (ShelleyBlock proto1 era1)
 -> WrapLedgerConfig (ShelleyBlock proto2 era2)
 -> Translate
      LedgerState (ShelleyBlock proto1 era1) (ShelleyBlock proto2 era2))
-> RequiringBoth
     WrapLedgerConfig
     (Translate LedgerState)
     (ShelleyBlock proto1 era1)
     (ShelleyBlock proto2 era2)
forall {k} (h :: k -> *) (f :: k -> k -> *) (x :: k) (y :: k).
(h x -> h y -> f x y) -> RequiringBoth h f x y
InPairs.RequireBoth
        ((WrapLedgerConfig (ShelleyBlock proto1 era1)
  -> WrapLedgerConfig (ShelleyBlock proto2 era2)
  -> Translate
       LedgerState (ShelleyBlock proto1 era1) (ShelleyBlock proto2 era2))
 -> RequiringBoth
      WrapLedgerConfig
      (Translate LedgerState)
      (ShelleyBlock proto1 era1)
      (ShelleyBlock proto2 era2))
-> (WrapLedgerConfig (ShelleyBlock proto1 era1)
    -> WrapLedgerConfig (ShelleyBlock proto2 era2)
    -> Translate
         LedgerState (ShelleyBlock proto1 era1) (ShelleyBlock proto2 era2))
-> RequiringBoth
     WrapLedgerConfig
     (Translate LedgerState)
     (ShelleyBlock proto1 era1)
     (ShelleyBlock proto2 era2)
forall a b. (a -> b) -> a -> b
$ \WrapLedgerConfig (ShelleyBlock proto1 era1)
_cfg1 WrapLedgerConfig (ShelleyBlock proto2 era2)
cfg2 -> (EpochNo
 -> LedgerState (ShelleyBlock proto1 era1)
 -> LedgerState (ShelleyBlock proto2 era2))
-> Translate
     LedgerState (ShelleyBlock proto1 era1) (ShelleyBlock proto2 era2)
forall (f :: * -> *) x y.
(EpochNo -> f x -> f y) -> Translate f x y
HFC.Translate
        ((EpochNo
  -> LedgerState (ShelleyBlock proto1 era1)
  -> LedgerState (ShelleyBlock proto2 era2))
 -> Translate
      LedgerState (ShelleyBlock proto1 era1) (ShelleyBlock proto2 era2))
-> (EpochNo
    -> LedgerState (ShelleyBlock proto1 era1)
    -> LedgerState (ShelleyBlock proto2 era2))
-> Translate
     LedgerState (ShelleyBlock proto1 era1) (ShelleyBlock proto2 era2)
forall a b. (a -> b) -> a -> b
$ \EpochNo
_epochNo ->
              (:.:) LedgerState (ShelleyBlock proto2) era2
-> LedgerState (ShelleyBlock proto2 era2)
forall {l} {k} (f :: l -> *) (g :: k -> l) (p :: k).
(:.:) f g p -> f (g p)
unComp
            ((:.:) LedgerState (ShelleyBlock proto2) era2
 -> LedgerState (ShelleyBlock proto2 era2))
-> (LedgerState (ShelleyBlock proto1 era1)
    -> (:.:) LedgerState (ShelleyBlock proto2) era2)
-> LedgerState (ShelleyBlock proto1 era1)
-> LedgerState (ShelleyBlock proto2 era2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TranslationContext era2
-> (:.:) LedgerState (ShelleyBlock proto2) (PreviousEra era2)
-> (:.:) LedgerState (ShelleyBlock proto2) era2
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
SL.translateEra'
                (ShelleyLedgerConfig era2 -> TranslationContext era2
forall era. ShelleyLedgerConfig era -> TranslationContext era
shelleyLedgerTranslationContext (WrapLedgerConfig (ShelleyBlock proto2 era2)
-> LedgerConfig (ShelleyBlock proto2 era2)
forall blk. WrapLedgerConfig blk -> LedgerConfig blk
unwrapLedgerConfig WrapLedgerConfig (ShelleyBlock proto2 era2)
cfg2))
            ((:.:) LedgerState (ShelleyBlock proto1) era1
 -> (:.:) LedgerState (ShelleyBlock proto2) era2)
-> (LedgerState (ShelleyBlock proto1 era1)
    -> (:.:) LedgerState (ShelleyBlock proto1) era1)
-> LedgerState (ShelleyBlock proto1 era1)
-> (:.:) LedgerState (ShelleyBlock proto2) era2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto1 era1)
-> (:.:) LedgerState (ShelleyBlock proto1) era1
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp

  hardForkChainSel :: Tails
  AcrossEraSelection
  (ShelleyBasedHardForkEras proto1 era1 proto2 era2)
hardForkChainSel = AcrossEraSelection
  (ShelleyBlock proto1 era1) (ShelleyBlock proto2 era2)
-> Tails
     AcrossEraSelection
     (ShelleyBasedHardForkEras proto1 era1 proto2 era2)
forall {k} (f :: k -> k -> *) (x :: k) (y :: k).
f x y -> Tails f '[x, y]
Tails.mk2 AcrossEraSelection
  (ShelleyBlock proto1 era1) (ShelleyBlock proto2 era2)
forall a b.
(SelectView (BlockProtocol a) ~ SelectView (BlockProtocol b)) =>
AcrossEraSelection a b
CompareSameSelectView

  hardForkInjectTxs :: InPairs
  (RequiringBoth
     WrapLedgerConfig (Product2 InjectTx InjectValidatedTx))
  (ShelleyBasedHardForkEras proto1 era1 proto2 era2)
hardForkInjectTxs =
        RequiringBoth
  WrapLedgerConfig
  (Product2 InjectTx InjectValidatedTx)
  (ShelleyBlock proto1 era1)
  (ShelleyBlock proto2 era2)
-> InPairs
     (RequiringBoth
        WrapLedgerConfig (Product2 InjectTx InjectValidatedTx))
     (ShelleyBasedHardForkEras proto1 era1 proto2 era2)
forall {k} (f :: k -> k -> *) (x :: k) (y :: k).
f x y -> InPairs f '[x, y]
InPairs.mk2
      (RequiringBoth
   WrapLedgerConfig
   (Product2 InjectTx InjectValidatedTx)
   (ShelleyBlock proto1 era1)
   (ShelleyBlock proto2 era2)
 -> InPairs
      (RequiringBoth
         WrapLedgerConfig (Product2 InjectTx InjectValidatedTx))
      (ShelleyBasedHardForkEras proto1 era1 proto2 era2))
-> RequiringBoth
     WrapLedgerConfig
     (Product2 InjectTx InjectValidatedTx)
     (ShelleyBlock proto1 era1)
     (ShelleyBlock proto2 era2)
-> InPairs
     (RequiringBoth
        WrapLedgerConfig (Product2 InjectTx InjectValidatedTx))
     (ShelleyBasedHardForkEras proto1 era1 proto2 era2)
forall a b. (a -> b) -> a -> b
$ (WrapLedgerConfig (ShelleyBlock proto1 era1)
 -> WrapLedgerConfig (ShelleyBlock proto2 era2)
 -> Product2
      InjectTx
      InjectValidatedTx
      (ShelleyBlock proto1 era1)
      (ShelleyBlock proto2 era2))
-> RequiringBoth
     WrapLedgerConfig
     (Product2 InjectTx InjectValidatedTx)
     (ShelleyBlock proto1 era1)
     (ShelleyBlock proto2 era2)
forall {k} (h :: k -> *) (f :: k -> k -> *) (x :: k) (y :: k).
(h x -> h y -> f x y) -> RequiringBoth h f x y
InPairs.RequireBoth ((WrapLedgerConfig (ShelleyBlock proto1 era1)
  -> WrapLedgerConfig (ShelleyBlock proto2 era2)
  -> Product2
       InjectTx
       InjectValidatedTx
       (ShelleyBlock proto1 era1)
       (ShelleyBlock proto2 era2))
 -> RequiringBoth
      WrapLedgerConfig
      (Product2 InjectTx InjectValidatedTx)
      (ShelleyBlock proto1 era1)
      (ShelleyBlock proto2 era2))
-> (WrapLedgerConfig (ShelleyBlock proto1 era1)
    -> WrapLedgerConfig (ShelleyBlock proto2 era2)
    -> Product2
         InjectTx
         InjectValidatedTx
         (ShelleyBlock proto1 era1)
         (ShelleyBlock proto2 era2))
-> RequiringBoth
     WrapLedgerConfig
     (Product2 InjectTx InjectValidatedTx)
     (ShelleyBlock proto1 era1)
     (ShelleyBlock proto2 era2)
forall a b. (a -> b) -> a -> b
$ \WrapLedgerConfig (ShelleyBlock proto1 era1)
_cfg1 WrapLedgerConfig (ShelleyBlock proto2 era2)
cfg2 ->
        let ctxt :: TranslationContext era2
ctxt = ShelleyLedgerConfig era2 -> TranslationContext era2
forall era. ShelleyLedgerConfig era -> TranslationContext era
shelleyLedgerTranslationContext (WrapLedgerConfig (ShelleyBlock proto2 era2)
-> LedgerConfig (ShelleyBlock proto2 era2)
forall blk. WrapLedgerConfig blk -> LedgerConfig blk
unwrapLedgerConfig WrapLedgerConfig (ShelleyBlock proto2 era2)
cfg2)
        in
          InjectTx (ShelleyBlock proto1 era1) (ShelleyBlock proto2 era2)
-> InjectValidatedTx
     (ShelleyBlock proto1 era1) (ShelleyBlock proto2 era2)
-> Product2
     InjectTx
     InjectValidatedTx
     (ShelleyBlock proto1 era1)
     (ShelleyBlock proto2 era2)
forall (f :: * -> * -> *) (g :: * -> * -> *) x y.
f x y -> g x y -> Product2 f g x y
Pair2
            ((GenTx (ShelleyBlock proto1 era1)
 -> Maybe (GenTx (ShelleyBlock proto2 era2)))
-> InjectTx (ShelleyBlock proto1 era1) (ShelleyBlock proto2 era2)
forall blk blk'.
(GenTx blk -> Maybe (GenTx blk')) -> InjectTx blk blk'
InjectTx          (TranslationContext era2
-> GenTx (ShelleyBlock proto1 era1)
-> Maybe (GenTx (ShelleyBlock proto1 era2))
forall proto.
TranslationContext era2
-> GenTx (ShelleyBlock proto era1)
-> Maybe (GenTx (ShelleyBlock proto era2))
translateTx          TranslationContext era2
ctxt))
            ((WrapValidatedGenTx (ShelleyBlock proto1 era1)
 -> Maybe (WrapValidatedGenTx (ShelleyBlock proto2 era2)))
-> InjectValidatedTx
     (ShelleyBlock proto1 era1) (ShelleyBlock proto2 era2)
forall blk blk'.
(WrapValidatedGenTx blk -> Maybe (WrapValidatedGenTx blk'))
-> InjectValidatedTx blk blk'
InjectValidatedTx (TranslationContext era2
-> WrapValidatedGenTx (ShelleyBlock proto1 era1)
-> Maybe (WrapValidatedGenTx (ShelleyBlock proto1 era2))
forall proto.
TranslationContext era2
-> WrapValidatedGenTx (ShelleyBlock proto era1)
-> Maybe (WrapValidatedGenTx (ShelleyBlock proto era2))
translateValidatedTx TranslationContext era2
ctxt))
    where
      translateTx ::
           SL.TranslationContext era2
        ->        GenTx (ShelleyBlock proto era1)
        -> Maybe (GenTx (ShelleyBlock proto era2))
      translateTx :: forall proto.
TranslationContext era2
-> GenTx (ShelleyBlock proto era1)
-> Maybe (GenTx (ShelleyBlock proto era2))
translateTx TranslationContext era2
transCtxt =
          ((:.:) GenTx (ShelleyBlock proto) era2
 -> GenTx (ShelleyBlock proto era2))
-> Maybe ((:.:) GenTx (ShelleyBlock proto) era2)
-> Maybe (GenTx (ShelleyBlock proto era2))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:.:) GenTx (ShelleyBlock proto) era2
-> GenTx (ShelleyBlock proto era2)
forall {l} {k} (f :: l -> *) (g :: k -> l) (p :: k).
(:.:) f g p -> f (g p)
unComp
        (Maybe ((:.:) GenTx (ShelleyBlock proto) era2)
 -> Maybe (GenTx (ShelleyBlock proto era2)))
-> (GenTx (ShelleyBlock proto era1)
    -> Maybe ((:.:) GenTx (ShelleyBlock proto) era2))
-> GenTx (ShelleyBlock proto era1)
-> Maybe (GenTx (ShelleyBlock proto era2))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either
  (TranslationError era2 WrapTx)
  ((:.:) GenTx (ShelleyBlock proto) era2)
-> Maybe ((:.:) GenTx (ShelleyBlock proto) era2)
forall a b. Either a b -> Maybe b
eitherToMaybe (Either
   (TranslationError era2 WrapTx)
   ((:.:) GenTx (ShelleyBlock proto) era2)
 -> Maybe ((:.:) GenTx (ShelleyBlock proto) era2))
-> (GenTx (ShelleyBlock proto era1)
    -> Either
         (TranslationError era2 WrapTx)
         ((:.:) GenTx (ShelleyBlock proto) era2))
-> GenTx (ShelleyBlock proto era1)
-> Maybe ((:.:) GenTx (ShelleyBlock proto) era2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except
  (TranslationError era2 WrapTx)
  ((:.:) GenTx (ShelleyBlock proto) era2)
-> Either
     (TranslationError era2 WrapTx)
     ((:.:) GenTx (ShelleyBlock proto) era2)
forall e a. Except e a -> Either e a
runExcept (Except
   (TranslationError era2 WrapTx)
   ((:.:) GenTx (ShelleyBlock proto) era2)
 -> Either
      (TranslationError era2 WrapTx)
      ((:.:) GenTx (ShelleyBlock proto) era2))
-> (GenTx (ShelleyBlock proto era1)
    -> Except
         (TranslationError era2 WrapTx)
         ((:.:) GenTx (ShelleyBlock proto) era2))
-> GenTx (ShelleyBlock proto era1)
-> Either
     (TranslationError era2 WrapTx)
     ((:.:) GenTx (ShelleyBlock proto) era2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TranslationContext era2
-> (:.:) GenTx (ShelleyBlock proto) (PreviousEra era2)
-> Except
     (TranslationError era2 (GenTx :.: ShelleyBlock proto))
     ((:.:) GenTx (ShelleyBlock proto) era2)
forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
SL.translateEra TranslationContext era2
transCtxt
        ((:.:) GenTx (ShelleyBlock proto) era1
 -> Except
      (TranslationError era2 WrapTx)
      ((:.:) GenTx (ShelleyBlock proto) era2))
-> (GenTx (ShelleyBlock proto era1)
    -> (:.:) GenTx (ShelleyBlock proto) era1)
-> GenTx (ShelleyBlock proto era1)
-> Except
     (TranslationError era2 WrapTx)
     ((:.:) GenTx (ShelleyBlock proto) era2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx (ShelleyBlock proto era1)
-> (:.:) GenTx (ShelleyBlock proto) era1
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp

      translateValidatedTx ::
           SL.TranslationContext era2
        ->        WrapValidatedGenTx (ShelleyBlock proto era1)
        -> Maybe (WrapValidatedGenTx (ShelleyBlock proto era2))
      translateValidatedTx :: forall proto.
TranslationContext era2
-> WrapValidatedGenTx (ShelleyBlock proto era1)
-> Maybe (WrapValidatedGenTx (ShelleyBlock proto era2))
translateValidatedTx TranslationContext era2
transCtxt =
            ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2
 -> WrapValidatedGenTx (ShelleyBlock proto era2))
-> Maybe ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2)
-> Maybe (WrapValidatedGenTx (ShelleyBlock proto era2))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:.:) WrapValidatedGenTx (ShelleyBlock proto) era2
-> WrapValidatedGenTx (ShelleyBlock proto era2)
forall {l} {k} (f :: l -> *) (g :: k -> l) (p :: k).
(:.:) f g p -> f (g p)
unComp
          (Maybe ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2)
 -> Maybe (WrapValidatedGenTx (ShelleyBlock proto era2)))
-> (WrapValidatedGenTx (ShelleyBlock proto era1)
    -> Maybe ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2))
-> WrapValidatedGenTx (ShelleyBlock proto era1)
-> Maybe (WrapValidatedGenTx (ShelleyBlock proto era2))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either
  (TranslationError era2 WrapTx)
  ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2)
-> Maybe ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2)
forall a b. Either a b -> Maybe b
eitherToMaybe (Either
   (TranslationError era2 WrapTx)
   ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2)
 -> Maybe ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2))
-> (WrapValidatedGenTx (ShelleyBlock proto era1)
    -> Either
         (TranslationError era2 WrapTx)
         ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2))
-> WrapValidatedGenTx (ShelleyBlock proto era1)
-> Maybe ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except
  (TranslationError era2 WrapTx)
  ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2)
-> Either
     (TranslationError era2 WrapTx)
     ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2)
forall e a. Except e a -> Either e a
runExcept (Except
   (TranslationError era2 WrapTx)
   ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2)
 -> Either
      (TranslationError era2 WrapTx)
      ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2))
-> (WrapValidatedGenTx (ShelleyBlock proto era1)
    -> Except
         (TranslationError era2 WrapTx)
         ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2))
-> WrapValidatedGenTx (ShelleyBlock proto era1)
-> Either
     (TranslationError era2 WrapTx)
     ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TranslationContext era2
-> (:.:) WrapValidatedGenTx (ShelleyBlock proto) (PreviousEra era2)
-> Except
     (TranslationError era2 (WrapValidatedGenTx :.: ShelleyBlock proto))
     ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2)
forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
SL.translateEra TranslationContext era2
transCtxt
          ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era1
 -> Except
      (TranslationError era2 WrapTx)
      ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2))
-> (WrapValidatedGenTx (ShelleyBlock proto era1)
    -> (:.:) WrapValidatedGenTx (ShelleyBlock proto) era1)
-> WrapValidatedGenTx (ShelleyBlock proto era1)
-> Except
     (TranslationError era2 WrapTx)
     ((:.:) WrapValidatedGenTx (ShelleyBlock proto) era2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapValidatedGenTx (ShelleyBlock proto era1)
-> (:.:) WrapValidatedGenTx (ShelleyBlock proto) era1
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp

  hardForkInjTxMeasure :: NS WrapTxMeasure (ShelleyBasedHardForkEras proto1 era1 proto2 era2)
-> HardForkTxMeasure
     (ShelleyBasedHardForkEras proto1 era1 proto2 era2)
hardForkInjTxMeasure = \case
      (  Z (WrapTxMeasure TxMeasure x
x)) -> TxMeasure (ShelleyBlock (TPraos (ProtoCrypto proto2)) era1)
-> TxMeasure (ShelleyBlock (TPraos (ProtoCrypto proto2)) era2)
forall a b. TranslateTxMeasure a b => a -> b
translateTxMeasure TxMeasure x
TxMeasure (ShelleyBlock (TPraos (ProtoCrypto proto2)) era1)
x
      S (Z (WrapTxMeasure TxMeasure x
x)) -> TxMeasure x
HardForkTxMeasure
  (ShelleyBasedHardForkEras proto1 era1 proto2 era2)
x

instance ShelleyBasedHardForkConstraints proto1 era1 proto2 era2
      => SupportedNetworkProtocolVersion (ShelleyBasedHardForkBlock proto1 era1 proto2 era2) where
  supportedNodeToNodeVersions :: Proxy (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
-> Map
     NodeToNodeVersion
     (BlockNodeToNodeVersion
        (ShelleyBasedHardForkBlock proto1 era1 proto2 era2))
supportedNodeToNodeVersions Proxy (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
_ = [(NodeToNodeVersion,
  BlockNodeToNodeVersion
    (ShelleyBasedHardForkBlock proto1 era1 proto2 era2))]
-> Map
     NodeToNodeVersion
     (BlockNodeToNodeVersion
        (ShelleyBasedHardForkBlock proto1 era1 proto2 era2))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(NodeToNodeVersion,
   BlockNodeToNodeVersion
     (ShelleyBasedHardForkBlock proto1 era1 proto2 era2))]
 -> Map
      NodeToNodeVersion
      (BlockNodeToNodeVersion
         (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)))
-> [(NodeToNodeVersion,
     BlockNodeToNodeVersion
       (ShelleyBasedHardForkBlock proto1 era1 proto2 era2))]
-> Map
     NodeToNodeVersion
     (BlockNodeToNodeVersion
        (ShelleyBasedHardForkBlock proto1 era1 proto2 era2))
forall a b. (a -> b) -> a -> b
$
      [ (NodeToNodeVersion
forall a. Bounded a => a
maxBound, BlockNodeToNodeVersion
  (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
BlockNodeToNodeVersion
  (ShelleyBasedHardForkBlock
     (TPraos (ProtoCrypto proto2))
     era1
     (TPraos (ProtoCrypto proto2))
     era2)
forall proto1 era1 proto2 era2.
BlockNodeToNodeVersion
  (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
ShelleyBasedHardForkNodeToNodeVersion1)
      ]

  supportedNodeToClientVersions :: Proxy (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
-> Map
     NodeToClientVersion
     (BlockNodeToClientVersion
        (ShelleyBasedHardForkBlock proto1 era1 proto2 era2))
supportedNodeToClientVersions Proxy (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
_ = [(NodeToClientVersion,
  BlockNodeToClientVersion
    (ShelleyBasedHardForkBlock proto1 era1 proto2 era2))]
-> Map
     NodeToClientVersion
     (BlockNodeToClientVersion
        (ShelleyBasedHardForkBlock proto1 era1 proto2 era2))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(NodeToClientVersion,
   BlockNodeToClientVersion
     (ShelleyBasedHardForkBlock proto1 era1 proto2 era2))]
 -> Map
      NodeToClientVersion
      (BlockNodeToClientVersion
         (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)))
-> [(NodeToClientVersion,
     BlockNodeToClientVersion
       (ShelleyBasedHardForkBlock proto1 era1 proto2 era2))]
-> Map
     NodeToClientVersion
     (BlockNodeToClientVersion
        (ShelleyBasedHardForkBlock proto1 era1 proto2 era2))
forall a b. (a -> b) -> a -> b
$
      [ (NodeToClientVersion
forall a. Bounded a => a
maxBound, BlockNodeToClientVersion
  (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
BlockNodeToClientVersion
  (ShelleyBasedHardForkBlock
     (TPraos (ProtoCrypto proto2))
     era1
     (TPraos (ProtoCrypto proto2))
     era2)
forall proto1 era1 proto2 era2.
BlockNodeToClientVersion
  (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
ShelleyBasedHardForkNodeToClientVersion1)
      ]

  latestReleasedNodeVersion :: Proxy (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
-> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersion = Proxy (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
-> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersionDefault

{-------------------------------------------------------------------------------
  Protocol info
-------------------------------------------------------------------------------}

protocolInfoShelleyBasedHardFork ::
     forall m proto1 era1 proto2 era2.
     (IOLike m, ShelleyBasedHardForkConstraints proto1 era1 proto2 era2)
  => ProtocolParamsShelleyBased (EraCrypto era1)
  -> SL.ProtVer
  -> SL.ProtVer
  -> L.TransitionConfig era2
  -> TriggerHardFork
  -> ( ProtocolInfo      (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
     , m [BlockForging m (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)]
     )
protocolInfoShelleyBasedHardFork :: forall (m :: * -> *) proto1 era1 proto2 era2.
(IOLike m,
 ShelleyBasedHardForkConstraints proto1 era1 proto2 era2) =>
ProtocolParamsShelleyBased (EraCrypto era1)
-> ProtVer
-> ProtVer
-> TransitionConfig era2
-> TriggerHardFork
-> (ProtocolInfo
      (ShelleyBasedHardForkBlock proto1 era1 proto2 era2),
    m [BlockForging
         m (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)])
protocolInfoShelleyBasedHardFork ProtocolParamsShelleyBased (EraCrypto era1)
protocolParamsShelleyBased
                                 ProtVer
protVer1
                                 ProtVer
protVer2
                                 TransitionConfig era2
transCfg2
                                 TriggerHardFork
hardForkTrigger =
    ProtocolInfo (ShelleyBlock proto1 era1)
-> m [BlockForging m (ShelleyBlock proto1 era1)]
-> EraParams
-> (ConsensusConfig (BlockProtocol (ShelleyBlock proto1 era1))
    -> PartialConsensusConfig
         (BlockProtocol (ShelleyBlock proto1 era1)))
-> (LedgerConfig (ShelleyBlock proto1 era1)
    -> PartialLedgerConfig (ShelleyBlock proto1 era1))
-> ProtocolInfo (ShelleyBlock proto2 era2)
-> m [BlockForging m (ShelleyBlock proto2 era2)]
-> EraParams
-> (ConsensusConfig (BlockProtocol (ShelleyBlock proto2 era2))
    -> PartialConsensusConfig
         (BlockProtocol (ShelleyBlock proto2 era2)))
-> (LedgerConfig (ShelleyBlock proto2 era2)
    -> PartialLedgerConfig (ShelleyBlock proto2 era2))
-> (ProtocolInfo
      (HardForkBlock
         '[ShelleyBlock proto1 era1, ShelleyBlock proto2 era2]),
    m [BlockForging
         m
         (HardForkBlock
            '[ShelleyBlock proto1 era1, ShelleyBlock proto2 era2])])
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
      -- Era 1
      ProtocolInfo (ShelleyBlock proto1 era1)
protocolInfo1
      m [BlockForging m (ShelleyBlock proto1 era1)]
blockForging1
      EraParams
eraParams1
      ConsensusConfig (BlockProtocol (ShelleyBlock proto1 era1))
-> PartialConsensusConfig
     (BlockProtocol (ShelleyBlock proto1 era1))
ConsensusConfig (TPraos (ProtoCrypto proto2)) -> TPraosParams
forall c. ConsensusConfig (TPraos c) -> TPraosParams
tpraosParams
      LedgerConfig (ShelleyBlock proto1 era1)
-> PartialLedgerConfig (ShelleyBlock proto1 era1)
toPartialLedgerConfig1
      -- Era 2
      ProtocolInfo (ShelleyBlock proto2 era2)
protocolInfo2
      m [BlockForging m (ShelleyBlock proto2 era2)]
blockForging2
      EraParams
eraParams2
      ConsensusConfig (BlockProtocol (ShelleyBlock proto2 era2))
-> PartialConsensusConfig
     (BlockProtocol (ShelleyBlock proto2 era2))
ConsensusConfig (TPraos (ProtoCrypto proto2)) -> TPraosParams
forall c. ConsensusConfig (TPraos c) -> TPraosParams
tpraosParams
      LedgerConfig (ShelleyBlock proto2 era2)
-> PartialLedgerConfig (ShelleyBlock proto2 era2)
toPartialLedgerConfig2
  where
    ProtocolParamsShelleyBased {
        Nonce
shelleyBasedInitialNonce :: Nonce
shelleyBasedInitialNonce :: forall c. ProtocolParamsShelleyBased c -> Nonce
shelleyBasedInitialNonce
      , [ShelleyLeaderCredentials (EraCrypto era1)]
shelleyBasedLeaderCredentials :: [ShelleyLeaderCredentials (EraCrypto era1)]
shelleyBasedLeaderCredentials :: forall c.
ProtocolParamsShelleyBased c -> [ShelleyLeaderCredentials c]
shelleyBasedLeaderCredentials
      } = ProtocolParamsShelleyBased (EraCrypto era1)
protocolParamsShelleyBased

    -- Era 1

    genesis :: SL.ShelleyGenesis (EraCrypto era1)
    genesis :: ShelleyGenesis (EraCrypto era1)
genesis = TransitionConfig era2
transCfg2 TransitionConfig era2
-> Getting
     (ShelleyGenesis (ProtoCrypto proto2))
     (TransitionConfig era2)
     (ShelleyGenesis (ProtoCrypto proto2))
-> ShelleyGenesis (ProtoCrypto proto2)
forall s a. s -> Getting a s a -> a
^. (ShelleyGenesis (EraCrypto era2)
 -> Const
      (ShelleyGenesis (ProtoCrypto proto2))
      (ShelleyGenesis (EraCrypto era2)))
-> TransitionConfig era2
-> Const
     (ShelleyGenesis (ProtoCrypto proto2)) (TransitionConfig era2)
Getting
  (ShelleyGenesis (ProtoCrypto proto2))
  (TransitionConfig era2)
  (ShelleyGenesis (ProtoCrypto proto2))
forall era.
EraTransition era =>
Lens' (TransitionConfig era) (ShelleyGenesis (EraCrypto era))
Lens' (TransitionConfig era2) (ShelleyGenesis (EraCrypto era2))
L.tcShelleyGenesisL

    protocolInfo1 :: ProtocolInfo (ShelleyBlock proto1 era1)
    blockForging1 :: m [BlockForging m (ShelleyBlock proto1 era1)]
    (ProtocolInfo (ShelleyBlock proto1 era1)
protocolInfo1, m [BlockForging m (ShelleyBlock proto1 era1)]
blockForging1) =
        ProtocolParamsShelleyBased (ProtoCrypto proto2)
-> TransitionConfig era1
-> ProtVer
-> (ProtocolInfo (ShelleyBlock (TPraos (ProtoCrypto proto2)) era1),
    m [BlockForging
         m (ShelleyBlock (TPraos (ProtoCrypto proto2)) era1)])
forall (m :: * -> *) era c.
(IOLike m, PraosCrypto c, ShelleyCompatible (TPraos c) era,
 TxLimits (ShelleyBlock (TPraos c) era), c ~ EraCrypto era) =>
ProtocolParamsShelleyBased c
-> TransitionConfig era
-> ProtVer
-> (ProtocolInfo (ShelleyBlock (TPraos c) era),
    m [BlockForging m (ShelleyBlock (TPraos c) era)])
protocolInfoTPraosShelleyBased
          ProtocolParamsShelleyBased (EraCrypto era1)
ProtocolParamsShelleyBased (ProtoCrypto proto2)
protocolParamsShelleyBased
          (TransitionConfig era2
transCfg2 TransitionConfig era2
-> Getting
     (TransitionConfig era1)
     (TransitionConfig era2)
     (TransitionConfig era1)
-> TransitionConfig era1
forall s a. s -> Getting a s a -> a
^. Getting
  (TransitionConfig era1)
  (TransitionConfig era2)
  (TransitionConfig era1)
(TransitionConfig (PreviousEra era2)
 -> Const
      (TransitionConfig era1) (TransitionConfig (PreviousEra era2)))
-> TransitionConfig era2
-> Const (TransitionConfig era1) (TransitionConfig era2)
forall era.
(EraTransition era, EraTransition (PreviousEra era)) =>
Lens' (TransitionConfig era) (TransitionConfig (PreviousEra era))
Lens' (TransitionConfig era2) (TransitionConfig (PreviousEra era2))
L.tcPreviousEraConfigL)
          ProtVer
protVer1

    eraParams1 :: History.EraParams
    eraParams1 :: EraParams
eraParams1 = ShelleyGenesis (ProtoCrypto proto2) -> EraParams
forall c. ShelleyGenesis c -> EraParams
shelleyEraParams ShelleyGenesis (EraCrypto era1)
ShelleyGenesis (ProtoCrypto proto2)
genesis

    toPartialLedgerConfig1 ::
         LedgerConfig (ShelleyBlock proto1 era1)
      -> PartialLedgerConfig (ShelleyBlock proto1 era1)
    toPartialLedgerConfig1 :: LedgerConfig (ShelleyBlock proto1 era1)
-> PartialLedgerConfig (ShelleyBlock proto1 era1)
toPartialLedgerConfig1 LedgerConfig (ShelleyBlock proto1 era1)
cfg = ShelleyPartialLedgerConfig {
          shelleyLedgerConfig :: ShelleyLedgerConfig era1
shelleyLedgerConfig    = LedgerConfig (ShelleyBlock proto1 era1)
ShelleyLedgerConfig era1
cfg
        , shelleyTriggerHardFork :: TriggerHardFork
shelleyTriggerHardFork = TriggerHardFork
hardForkTrigger
        }

    -- Era 2

    protocolInfo2 :: ProtocolInfo (ShelleyBlock proto2 era2)
    blockForging2 :: m [BlockForging m (ShelleyBlock proto2 era2)]
    (ProtocolInfo (ShelleyBlock proto2 era2)
protocolInfo2, m [BlockForging m (ShelleyBlock proto2 era2)]
blockForging2) =
        ProtocolParamsShelleyBased (ProtoCrypto proto2)
-> TransitionConfig era2
-> ProtVer
-> (ProtocolInfo (ShelleyBlock (TPraos (ProtoCrypto proto2)) era2),
    m [BlockForging
         m (ShelleyBlock (TPraos (ProtoCrypto proto2)) era2)])
forall (m :: * -> *) era c.
(IOLike m, PraosCrypto c, ShelleyCompatible (TPraos c) era,
 TxLimits (ShelleyBlock (TPraos c) era), c ~ EraCrypto era) =>
ProtocolParamsShelleyBased c
-> TransitionConfig era
-> ProtVer
-> (ProtocolInfo (ShelleyBlock (TPraos c) era),
    m [BlockForging m (ShelleyBlock (TPraos c) era)])
protocolInfoTPraosShelleyBased
          ProtocolParamsShelleyBased {
              Nonce
shelleyBasedInitialNonce :: Nonce
shelleyBasedInitialNonce :: Nonce
shelleyBasedInitialNonce
            , [ShelleyLeaderCredentials (EraCrypto era1)]
[ShelleyLeaderCredentials (ProtoCrypto proto2)]
shelleyBasedLeaderCredentials :: [ShelleyLeaderCredentials (EraCrypto era1)]
shelleyBasedLeaderCredentials :: [ShelleyLeaderCredentials (ProtoCrypto proto2)]
shelleyBasedLeaderCredentials
            }
          TransitionConfig era2
transCfg2
          ProtVer
protVer2

    eraParams2 :: History.EraParams
    eraParams2 :: EraParams
eraParams2 = ShelleyGenesis (ProtoCrypto proto2) -> EraParams
forall c. ShelleyGenesis c -> EraParams
shelleyEraParams ShelleyGenesis (EraCrypto era1)
ShelleyGenesis (ProtoCrypto proto2)
genesis

    toPartialLedgerConfig2 ::
         LedgerConfig (ShelleyBlock proto2 era2)
      -> PartialLedgerConfig (ShelleyBlock proto2 era2)
    toPartialLedgerConfig2 :: LedgerConfig (ShelleyBlock proto2 era2)
-> PartialLedgerConfig (ShelleyBlock proto2 era2)
toPartialLedgerConfig2 LedgerConfig (ShelleyBlock proto2 era2)
cfg = ShelleyPartialLedgerConfig {
          shelleyLedgerConfig :: ShelleyLedgerConfig era2
shelleyLedgerConfig    = LedgerConfig (ShelleyBlock proto2 era2)
ShelleyLedgerConfig era2
cfg
        , shelleyTriggerHardFork :: TriggerHardFork
shelleyTriggerHardFork = TriggerHardFork
TriggerHardForkNotDuringThisExecution
        }

{-------------------------------------------------------------------------------
  TxGen instance
-------------------------------------------------------------------------------}

-- | Use a generic implementation for 'TxGen'
instance ( TxGen (ShelleyBlock proto1 era1)
         , TxGen (ShelleyBlock proto2 era2)
         , ShelleyBasedHardForkConstraints proto1 era1 proto2 era2
         ) => TxGen (ShelleyBasedHardForkBlock proto1 era1 proto2 era2) where
  type TxGenExtra (ShelleyBasedHardForkBlock proto1 era1 proto2 era2) =
    NP WrapTxGenExtra (ShelleyBasedHardForkEras proto1 era1 proto2 era2)
  testGenTxs :: CoreNodeId
-> NumCoreNodes
-> SlotNo
-> TopLevelConfig
     (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
-> TxGenExtra (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
-> LedgerState (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
-> Gen [GenTx (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)]
testGenTxs = CoreNodeId
-> NumCoreNodes
-> SlotNo
-> TopLevelConfig
     (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
-> TxGenExtra (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
-> LedgerState (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
-> Gen [GenTx (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)]
CoreNodeId
-> NumCoreNodes
-> SlotNo
-> TopLevelConfig
     (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
-> NP
     WrapTxGenExtra (ShelleyBasedHardForkEras proto1 era1 proto2 era2)
-> LedgerState (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
-> Gen [GenTx (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)]
forall (xs :: [*]).
(All TxGen xs, CanHardFork xs) =>
CoreNodeId
-> NumCoreNodes
-> SlotNo
-> TopLevelConfig (HardForkBlock xs)
-> NP WrapTxGenExtra xs
-> LedgerState (HardForkBlock xs)
-> Gen [GenTx (HardForkBlock xs)]
testGenTxsHfc