{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Test.Consensus.Cardano.Translation (tests) where

import qualified Cardano.Chain.Block as Byron
import qualified Cardano.Chain.UTxO as Byron
import           Cardano.Ledger.Alonzo ()
import           Cardano.Ledger.BaseTypes (TxIx (..))
import qualified Cardano.Ledger.Core as Core
import qualified Cardano.Ledger.Genesis as Genesis
import           Cardano.Ledger.Shelley.API
                     (NewEpochState (stashedAVVMAddresses), ShelleyGenesis (..),
                     TxIn (..), translateCompactTxOutByronToShelley,
                     translateTxIdByronToShelley)
import qualified Cardano.Ledger.Shelley.API as SL
import           Cardano.Ledger.Shelley.LedgerState (esLState, lsUTxOState,
                     nesEs, utxosUtxo)
import           Cardano.Ledger.Shelley.Translation
import           Cardano.Ledger.Shelley.UTxO (UTxO (..))
import           Cardano.Slotting.EpochInfo (fixedEpochInfo)
import           Cardano.Slotting.Slot (EpochNo (..))
import qualified Data.Map.Strict as Map
import           Data.SOP.BasicFunctors
import           Data.SOP.Functors
import           Data.SOP.InPairs (RequiringBoth (..), provideBoth)
import           Ouroboros.Consensus.BlockchainTime.WallClock.Types
                     (slotLengthFromSec)
import           Ouroboros.Consensus.Byron.Ledger (ByronBlock, byronLedgerState)
import           Ouroboros.Consensus.Cardano.Block (CardanoEras)
import           Ouroboros.Consensus.Cardano.CanHardFork
import           Ouroboros.Consensus.Cardano.CanHardFork ()
import           Ouroboros.Consensus.HardFork.Combinator (InPairs (..),
                     hardForkEraTranslation, translateLedgerState)
import           Ouroboros.Consensus.HardFork.Combinator.State.Types
                     (TranslateLedgerState (TranslateLedgerState, translateLedgerStateWith))
import           Ouroboros.Consensus.Ledger.Basics (LedgerCfg, LedgerConfig,
                     LedgerState)
import           Ouroboros.Consensus.Ledger.Tables hiding (TxIn)
import           Ouroboros.Consensus.Ledger.Tables.Diff (Diff)
import qualified Ouroboros.Consensus.Ledger.Tables.Diff as Diff
import           Ouroboros.Consensus.Ledger.Tables.Utils
import           Ouroboros.Consensus.Protocol.Praos
import           Ouroboros.Consensus.Protocol.TPraos (TPraos)
import           Ouroboros.Consensus.Shelley.Eras
import           Ouroboros.Consensus.Shelley.HFEras ()
import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock,
                     ShelleyLedgerConfig, mkShelleyLedgerConfig,
                     shelleyLedgerState, shelleyLedgerTables)
import           Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
import           Ouroboros.Consensus.TypeFamilyWrappers
import           Test.Cardano.Ledger.Alonzo.Serialisation.Generators ()
import           Test.Cardano.Ledger.Babbage.Serialisation.Generators ()
import           Test.Cardano.Ledger.Conway.Arbitrary ()
import           Test.Cardano.Ledger.Shelley.Examples.Consensus
import           Test.Consensus.Byron.Generators (genByronLedgerConfig,
                     genByronLedgerState)
import           Test.Consensus.Cardano.MockCrypto (MockCryptoCompatByron)
import           Test.Consensus.Shelley.Generators ()
import           Test.QuickCheck
import           Test.Tasty
import           Test.Tasty.QuickCheck

-- Definitions to make the signatures a bit less unwieldy
type Crypto = MockCryptoCompatByron
type Proto  = TPraos Crypto

tests :: TestTree
tests :: TestTree
tests = TestName -> [TestTree] -> TestTree
testGroup TestName
"UpdateTablesOnEraTransition"
  [ TestName
-> RequiringBoth
     WrapLedgerConfig
     TranslateLedgerState
     ByronBlock
     (ShelleyBlock (TPraos Crypto) ShelleyEra)
-> (LedgerState ByronBlock EmptyMK
    -> LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) DiffMK
    -> Bool)
-> (LedgerState ByronBlock EmptyMK -> Property -> Property)
-> TestTree
forall srcBlk dstBlk.
(Arbitrary (TestSetup srcBlk dstBlk),
 Show (LedgerCfg (LedgerState srcBlk)),
 Show (LedgerCfg (LedgerState dstBlk)),
 Show (LedgerState srcBlk EmptyMK)) =>
TestName
-> RequiringBoth
     WrapLedgerConfig TranslateLedgerState srcBlk dstBlk
-> (LedgerState srcBlk EmptyMK
    -> LedgerState dstBlk DiffMK -> Bool)
-> (LedgerState srcBlk EmptyMK -> Property -> Property)
-> TestTree
testTablesTranslation TestName
"Byron to Shelley"
                          RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  ByronBlock
  (ShelleyBlock (TPraos Crypto) ShelleyEra)
byronToShelleyLedgerStateTranslation
                          LedgerState ByronBlock EmptyMK
-> LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) DiffMK
-> Bool
byronUtxosAreInsertsInShelleyUtxoDiff
                          (\LedgerState ByronBlock EmptyMK
st -> Double -> Bool -> TestName -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> TestName -> prop -> Property
cover Double
50  (      LedgerState ByronBlock EmptyMK -> Bool
nonEmptyUtxosByron LedgerState ByronBlock EmptyMK
st) TestName
"UTxO set is not empty"
                                  -- The Byron ledger generators are very
                                  -- unlikely to generate an empty UTxO, but we
                                  -- want to test with the empty UTxO as well.
                                  -- See 'Test.Cardano.Chain.UTxO.Gen.genUTxO'
                                  -- and the @Arbitrary
                                  -- 'Cardano.Chain.UTxO.UTxO'@ instance in
                                  -- "Test.Consensus.Byron.Generators".
                                (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Bool -> TestName -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> TestName -> prop -> Property
cover Double
0.1 (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LedgerState ByronBlock EmptyMK -> Bool
nonEmptyUtxosByron LedgerState ByronBlock EmptyMK
st) TestName
"UTxO set is empty"
                          )
  , TestName
-> RequiringBoth
     WrapLedgerConfig
     TranslateLedgerState
     (ShelleyBlock (TPraos Crypto) ShelleyEra)
     (ShelleyBlock (TPraos Crypto) AllegraEra)
-> (LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
    -> LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) DiffMK
    -> Bool)
-> (LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
    -> Property -> Property)
-> TestTree
forall srcBlk dstBlk.
(Arbitrary (TestSetup srcBlk dstBlk),
 Show (LedgerCfg (LedgerState srcBlk)),
 Show (LedgerCfg (LedgerState dstBlk)),
 Show (LedgerState srcBlk EmptyMK)) =>
TestName
-> RequiringBoth
     WrapLedgerConfig TranslateLedgerState srcBlk dstBlk
-> (LedgerState srcBlk EmptyMK
    -> LedgerState dstBlk DiffMK -> Bool)
-> (LedgerState srcBlk EmptyMK -> Property -> Property)
-> TestTree
testTablesTranslation TestName
"Shelley to Allegra"
                          RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  (ShelleyBlock (TPraos Crypto) ShelleyEra)
  (ShelleyBlock (TPraos Crypto) AllegraEra)
shelleyToAllegraLedgerStateTranslation
                          LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
-> LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) DiffMK
-> Bool
shelleyAvvmAddressesAreDeletesInUtxoDiff
                          (\LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
st -> Double -> Bool -> TestName -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> TestName -> prop -> Property
cover Double
50 (LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
-> Bool
nonEmptyAvvmAddresses LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
st) TestName
"AVVM set is not empty")
  , TestName
-> RequiringBoth
     WrapLedgerConfig
     TranslateLedgerState
     (ShelleyBlock (TPraos Crypto) AllegraEra)
     (ShelleyBlock (TPraos Crypto) MaryEra)
-> (LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) EmptyMK
    -> LedgerState (ShelleyBlock (TPraos Crypto) MaryEra) DiffMK
    -> Bool)
-> (LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) EmptyMK
    -> Property -> Property)
-> TestTree
forall srcBlk dstBlk.
(Arbitrary (TestSetup srcBlk dstBlk),
 Show (LedgerCfg (LedgerState srcBlk)),
 Show (LedgerCfg (LedgerState dstBlk)),
 Show (LedgerState srcBlk EmptyMK)) =>
TestName
-> RequiringBoth
     WrapLedgerConfig TranslateLedgerState srcBlk dstBlk
-> (LedgerState srcBlk EmptyMK
    -> LedgerState dstBlk DiffMK -> Bool)
-> (LedgerState srcBlk EmptyMK -> Property -> Property)
-> TestTree
testTablesTranslation TestName
"Allegra to Mary"
                          RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  (ShelleyBlock (TPraos Crypto) AllegraEra)
  (ShelleyBlock (TPraos Crypto) MaryEra)
allegraToMaryLedgerStateTranslation
                          LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) EmptyMK
-> LedgerState (ShelleyBlock (TPraos Crypto) MaryEra) DiffMK
-> Bool
forall srcProto srcEra destProto destEra.
LedgerState (ShelleyBlock srcProto srcEra) EmptyMK
-> LedgerState (ShelleyBlock destProto destEra) DiffMK -> Bool
utxoTablesAreEmpty
                          (\LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) EmptyMK
st -> Double -> Bool -> TestName -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> TestName -> prop -> Property
cover Double
50 (LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) EmptyMK
-> Bool
forall proto era.
LedgerState (ShelleyBlock proto era) EmptyMK -> Bool
nonEmptyUtxosShelley LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) EmptyMK
st) TestName
"UTxO set is not empty")
  , TestName
-> RequiringBoth
     WrapLedgerConfig
     TranslateLedgerState
     (ShelleyBlock (TPraos Crypto) MaryEra)
     (ShelleyBlock (TPraos Crypto) AlonzoEra)
-> (LedgerState (ShelleyBlock (TPraos Crypto) MaryEra) EmptyMK
    -> LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) DiffMK
    -> Bool)
-> (LedgerState (ShelleyBlock (TPraos Crypto) MaryEra) EmptyMK
    -> Property -> Property)
-> TestTree
forall srcBlk dstBlk.
(Arbitrary (TestSetup srcBlk dstBlk),
 Show (LedgerCfg (LedgerState srcBlk)),
 Show (LedgerCfg (LedgerState dstBlk)),
 Show (LedgerState srcBlk EmptyMK)) =>
TestName
-> RequiringBoth
     WrapLedgerConfig TranslateLedgerState srcBlk dstBlk
-> (LedgerState srcBlk EmptyMK
    -> LedgerState dstBlk DiffMK -> Bool)
-> (LedgerState srcBlk EmptyMK -> Property -> Property)
-> TestTree
testTablesTranslation TestName
"Mary to Alonzo"
                          RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  (ShelleyBlock (TPraos Crypto) MaryEra)
  (ShelleyBlock (TPraos Crypto) AlonzoEra)
maryToAlonzoLedgerStateTranslation
                          LedgerState (ShelleyBlock (TPraos Crypto) MaryEra) EmptyMK
-> LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) DiffMK
-> Bool
forall srcProto srcEra destProto destEra.
LedgerState (ShelleyBlock srcProto srcEra) EmptyMK
-> LedgerState (ShelleyBlock destProto destEra) DiffMK -> Bool
utxoTablesAreEmpty
                          (\LedgerState (ShelleyBlock (TPraos Crypto) MaryEra) EmptyMK
st -> Double -> Bool -> TestName -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> TestName -> prop -> Property
cover Double
50 (LedgerState (ShelleyBlock (TPraos Crypto) MaryEra) EmptyMK -> Bool
forall proto era.
LedgerState (ShelleyBlock proto era) EmptyMK -> Bool
nonEmptyUtxosShelley LedgerState (ShelleyBlock (TPraos Crypto) MaryEra) EmptyMK
st) TestName
"UTxO set is not empty")
  , TestName
-> RequiringBoth
     WrapLedgerConfig
     TranslateLedgerState
     (ShelleyBlock (TPraos Crypto) AlonzoEra)
     (ShelleyBlock (Praos Crypto) BabbageEra)
-> (LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) EmptyMK
    -> LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) DiffMK
    -> Bool)
-> (LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) EmptyMK
    -> Property -> Property)
-> TestTree
forall srcBlk dstBlk.
(Arbitrary (TestSetup srcBlk dstBlk),
 Show (LedgerCfg (LedgerState srcBlk)),
 Show (LedgerCfg (LedgerState dstBlk)),
 Show (LedgerState srcBlk EmptyMK)) =>
TestName
-> RequiringBoth
     WrapLedgerConfig TranslateLedgerState srcBlk dstBlk
-> (LedgerState srcBlk EmptyMK
    -> LedgerState dstBlk DiffMK -> Bool)
-> (LedgerState srcBlk EmptyMK -> Property -> Property)
-> TestTree
testTablesTranslation TestName
"Alonzo to Babbage"
                          RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  (ShelleyBlock (TPraos Crypto) AlonzoEra)
  (ShelleyBlock (Praos Crypto) BabbageEra)
alonzoToBabbageLedgerStateTranslation
                          LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) EmptyMK
-> LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) DiffMK
-> Bool
forall srcProto srcEra destProto destEra.
LedgerState (ShelleyBlock srcProto srcEra) EmptyMK
-> LedgerState (ShelleyBlock destProto destEra) DiffMK -> Bool
utxoTablesAreEmpty
                          (\LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) EmptyMK
st -> Double -> Bool -> TestName -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> TestName -> prop -> Property
cover Double
50 (LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) EmptyMK
-> Bool
forall proto era.
LedgerState (ShelleyBlock proto era) EmptyMK -> Bool
nonEmptyUtxosShelley LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) EmptyMK
st) TestName
"UTxO set is not empty")
  , TestName
-> RequiringBoth
     WrapLedgerConfig
     TranslateLedgerState
     (ShelleyBlock (Praos Crypto) BabbageEra)
     (ShelleyBlock (Praos Crypto) ConwayEra)
-> (LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
    -> LedgerState (ShelleyBlock (Praos Crypto) ConwayEra) DiffMK
    -> Bool)
-> (LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
    -> Property -> Property)
-> TestTree
forall srcBlk dstBlk.
(Arbitrary (TestSetup srcBlk dstBlk),
 Show (LedgerCfg (LedgerState srcBlk)),
 Show (LedgerCfg (LedgerState dstBlk)),
 Show (LedgerState srcBlk EmptyMK)) =>
TestName
-> RequiringBoth
     WrapLedgerConfig TranslateLedgerState srcBlk dstBlk
-> (LedgerState srcBlk EmptyMK
    -> LedgerState dstBlk DiffMK -> Bool)
-> (LedgerState srcBlk EmptyMK -> Property -> Property)
-> TestTree
testTablesTranslation TestName
"Babbage to Conway"
                          RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  (ShelleyBlock (Praos Crypto) BabbageEra)
  (ShelleyBlock (Praos Crypto) ConwayEra)
babbageToConwayLedgerStateTranslation
                          LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
-> LedgerState (ShelleyBlock (Praos Crypto) ConwayEra) DiffMK
-> Bool
forall srcProto srcEra destProto destEra.
LedgerState (ShelleyBlock srcProto srcEra) EmptyMK
-> LedgerState (ShelleyBlock destProto destEra) DiffMK -> Bool
utxoTablesAreEmpty
                          (\LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
st -> Double -> Bool -> TestName -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> TestName -> prop -> Property
cover Double
50 (LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
-> Bool
forall proto era.
LedgerState (ShelleyBlock proto era) EmptyMK -> Bool
nonEmptyUtxosShelley LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
st) TestName
"UTxO set is not empty")
  ]


{-------------------------------------------------------------------------------
  Ledger-state translations between eras that we test in this module
-------------------------------------------------------------------------------}

-- | TODO: we should simply expose 'translateLedgerStateByronToShelleyWrapper'
-- and other translations in ' Ouroboros.Consensus.Cardano.CanHardFork'.
byronToShelleyLedgerStateTranslation ::
  RequiringBoth
        WrapLedgerConfig
        TranslateLedgerState
        ByronBlock
        (ShelleyBlock (TPraos Crypto) ShelleyEra)
shelleyToAllegraLedgerStateTranslation :: RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  (ShelleyBlock (TPraos Crypto) ShelleyEra)
  (ShelleyBlock (TPraos Crypto) AllegraEra)
allegraToMaryLedgerStateTranslation :: RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  (ShelleyBlock (TPraos Crypto) AllegraEra)
  (ShelleyBlock (TPraos Crypto) MaryEra)
maryToAlonzoLedgerStateTranslation :: RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  (ShelleyBlock (TPraos Crypto) MaryEra)
  (ShelleyBlock (TPraos Crypto) AlonzoEra)
alonzoToBabbageLedgerStateTranslation :: RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  (ShelleyBlock (TPraos Crypto) AlonzoEra)
  (ShelleyBlock (Praos Crypto) BabbageEra)
PCons RequiringBoth WrapLedgerConfig TranslateLedgerState x y
RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  ByronBlock
  (ShelleyBlock (TPraos Crypto) ShelleyEra)
byronToShelleyLedgerStateTranslation
      (PCons RequiringBoth WrapLedgerConfig TranslateLedgerState x y
RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  (ShelleyBlock (TPraos Crypto) ShelleyEra)
  (ShelleyBlock (TPraos Crypto) AllegraEra)
shelleyToAllegraLedgerStateTranslation
       (PCons RequiringBoth WrapLedgerConfig TranslateLedgerState x y
RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  (ShelleyBlock (TPraos Crypto) AllegraEra)
  (ShelleyBlock (TPraos Crypto) MaryEra)
allegraToMaryLedgerStateTranslation
        (PCons RequiringBoth WrapLedgerConfig TranslateLedgerState x y
RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  (ShelleyBlock (TPraos Crypto) MaryEra)
  (ShelleyBlock (TPraos Crypto) AlonzoEra)
maryToAlonzoLedgerStateTranslation
         (PCons RequiringBoth WrapLedgerConfig TranslateLedgerState x y
RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  (ShelleyBlock (TPraos Crypto) AlonzoEra)
  (ShelleyBlock (Praos Crypto) BabbageEra)
alonzoToBabbageLedgerStateTranslation
          (PCons RequiringBoth WrapLedgerConfig TranslateLedgerState x y
_
           InPairs
  (RequiringBoth WrapLedgerConfig TranslateLedgerState) (y : zs)
PNil))))) = InPairs
  (RequiringBoth WrapLedgerConfig TranslateLedgerState)
  (CardanoEras Crypto)
tls
  where
    tls :: InPairs
             (RequiringBoth WrapLedgerConfig TranslateLedgerState)
             (CardanoEras Crypto)
    tls :: InPairs
  (RequiringBoth WrapLedgerConfig TranslateLedgerState)
  (CardanoEras Crypto)
tls = EraTranslation (CardanoEras Crypto)
-> InPairs
     (RequiringBoth WrapLedgerConfig TranslateLedgerState)
     (CardanoEras Crypto)
forall (xs :: [*]).
EraTranslation xs
-> InPairs (RequiringBoth WrapLedgerConfig TranslateLedgerState) xs
translateLedgerState EraTranslation (CardanoEras Crypto)
forall (xs :: [*]). CanHardFork xs => EraTranslation xs
hardForkEraTranslation

babbageToConwayLedgerStateTranslation :: RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  (ShelleyBlock (Praos Crypto) BabbageEra)
  (ShelleyBlock (Praos Crypto) ConwayEra)
babbageToConwayLedgerStateTranslation :: RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  (ShelleyBlock (Praos Crypto) BabbageEra)
  (ShelleyBlock (Praos Crypto) ConwayEra)
babbageToConwayLedgerStateTranslation = RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  (ShelleyBlock (Praos Crypto) BabbageEra)
  (ShelleyBlock (Praos Crypto) ConwayEra)
translateLedgerStateBabbageToConwayWrapper

-- | Tech debt: The babbage to conway translation performs a tick, and we would
-- need to create a reasonable ledger state. Instead this is just a copy-paste
-- of the code without the tick.
--
-- This should be fixed once the real translation is fixed.
translateLedgerStateBabbageToConwayWrapper ::
   RequiringBoth
       WrapLedgerConfig
       TranslateLedgerState
       (ShelleyBlock (Praos Crypto) BabbageEra)
       (ShelleyBlock (Praos Crypto) ConwayEra)
translateLedgerStateBabbageToConwayWrapper :: RequiringBoth
  WrapLedgerConfig
  TranslateLedgerState
  (ShelleyBlock (Praos Crypto) BabbageEra)
  (ShelleyBlock (Praos Crypto) ConwayEra)
translateLedgerStateBabbageToConwayWrapper =
    (WrapLedgerConfig (ShelleyBlock (Praos Crypto) BabbageEra)
 -> WrapLedgerConfig (ShelleyBlock (Praos Crypto) ConwayEra)
 -> TranslateLedgerState
      (ShelleyBlock (Praos Crypto) BabbageEra)
      (ShelleyBlock (Praos Crypto) ConwayEra))
-> RequiringBoth
     WrapLedgerConfig
     TranslateLedgerState
     (ShelleyBlock (Praos Crypto) BabbageEra)
     (ShelleyBlock (Praos Crypto) ConwayEra)
forall {k} (h :: k -> *) (f :: k -> k -> *) (x :: k) (y :: k).
(h x -> h y -> f x y) -> RequiringBoth h f x y
RequireBoth ((WrapLedgerConfig (ShelleyBlock (Praos Crypto) BabbageEra)
  -> WrapLedgerConfig (ShelleyBlock (Praos Crypto) ConwayEra)
  -> TranslateLedgerState
       (ShelleyBlock (Praos Crypto) BabbageEra)
       (ShelleyBlock (Praos Crypto) ConwayEra))
 -> RequiringBoth
      WrapLedgerConfig
      TranslateLedgerState
      (ShelleyBlock (Praos Crypto) BabbageEra)
      (ShelleyBlock (Praos Crypto) ConwayEra))
-> (WrapLedgerConfig (ShelleyBlock (Praos Crypto) BabbageEra)
    -> WrapLedgerConfig (ShelleyBlock (Praos Crypto) ConwayEra)
    -> TranslateLedgerState
         (ShelleyBlock (Praos Crypto) BabbageEra)
         (ShelleyBlock (Praos Crypto) ConwayEra))
-> RequiringBoth
     WrapLedgerConfig
     TranslateLedgerState
     (ShelleyBlock (Praos Crypto) BabbageEra)
     (ShelleyBlock (Praos Crypto) ConwayEra)
forall a b. (a -> b) -> a -> b
$ \WrapLedgerConfig (ShelleyBlock (Praos Crypto) BabbageEra)
_ WrapLedgerConfig (ShelleyBlock (Praos Crypto) ConwayEra)
cfgConway ->
      (EpochNo
 -> LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
 -> LedgerState (ShelleyBlock (Praos Crypto) ConwayEra) DiffMK)
-> TranslateLedgerState
     (ShelleyBlock (Praos Crypto) BabbageEra)
     (ShelleyBlock (Praos Crypto) ConwayEra)
forall x y.
(EpochNo -> LedgerState x EmptyMK -> LedgerState y DiffMK)
-> TranslateLedgerState x y
TranslateLedgerState ((EpochNo
  -> LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
  -> LedgerState (ShelleyBlock (Praos Crypto) ConwayEra) DiffMK)
 -> TranslateLedgerState
      (ShelleyBlock (Praos Crypto) BabbageEra)
      (ShelleyBlock (Praos Crypto) ConwayEra))
-> (EpochNo
    -> LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
    -> LedgerState (ShelleyBlock (Praos Crypto) ConwayEra) DiffMK)
-> TranslateLedgerState
     (ShelleyBlock (Praos Crypto) BabbageEra)
     (ShelleyBlock (Praos Crypto) ConwayEra)
forall a b. (a -> b) -> a -> b
$ \EpochNo
_ ->
         LedgerState (ShelleyBlock (Praos Crypto) ConwayEra) EmptyMK
-> LedgerState (ShelleyBlock (Praos Crypto) ConwayEra) DiffMK
forall (l :: LedgerStateKind) (any :: MapKind).
HasLedgerTables l =>
l any -> l DiffMK
noNewTickingDiffs
            (LedgerState (ShelleyBlock (Praos Crypto) ConwayEra) EmptyMK
 -> LedgerState (ShelleyBlock (Praos Crypto) ConwayEra) DiffMK)
-> (LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
    -> LedgerState (ShelleyBlock (Praos Crypto) ConwayEra) EmptyMK)
-> LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
-> LedgerState (ShelleyBlock (Praos Crypto) ConwayEra) DiffMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip LedgerState EmptyMK (ShelleyBlock (Praos Crypto) ConwayEra)
-> LedgerState (ShelleyBlock (Praos Crypto) ConwayEra) EmptyMK
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip
            (Flip LedgerState EmptyMK (ShelleyBlock (Praos Crypto) ConwayEra)
 -> LedgerState (ShelleyBlock (Praos Crypto) ConwayEra) EmptyMK)
-> (LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
    -> Flip
         LedgerState EmptyMK (ShelleyBlock (Praos Crypto) ConwayEra))
-> LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
-> LedgerState (ShelleyBlock (Praos Crypto) ConwayEra) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:.:)
  (Flip LedgerState EmptyMK) (ShelleyBlock (Praos Crypto)) ConwayEra
-> Flip LedgerState EmptyMK (ShelleyBlock (Praos Crypto) ConwayEra)
forall {l} {k} (f :: l -> *) (g :: k -> l) (p :: k).
(:.:) f g p -> f (g p)
unComp
            ((:.:)
   (Flip LedgerState EmptyMK) (ShelleyBlock (Praos Crypto)) ConwayEra
 -> Flip
      LedgerState EmptyMK (ShelleyBlock (Praos Crypto) ConwayEra))
-> (LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
    -> (:.:)
         (Flip LedgerState EmptyMK) (ShelleyBlock (Praos Crypto)) ConwayEra)
-> LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
-> Flip LedgerState EmptyMK (ShelleyBlock (Praos Crypto) ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TranslationContext ConwayEra
-> (:.:)
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (Praos Crypto))
     (PreviousEra ConwayEra)
-> (:.:)
     (Flip LedgerState EmptyMK) (ShelleyBlock (Praos Crypto)) ConwayEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
Core.translateEra' (WrapLedgerConfig (ShelleyBlock (Praos Crypto) ConwayEra)
-> TranslationContext ConwayEra
forall c.
WrapLedgerConfig (ShelleyBlock (Praos c) ConwayEra)
-> TranslationContext ConwayEra
getConwayTranslationContext WrapLedgerConfig (ShelleyBlock (Praos Crypto) ConwayEra)
cfgConway)
            ((:.:)
   (Flip LedgerState EmptyMK) (ShelleyBlock (Praos Crypto)) BabbageEra
 -> (:.:)
      (Flip LedgerState EmptyMK) (ShelleyBlock (Praos Crypto)) ConwayEra)
-> (LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
    -> (:.:)
         (Flip LedgerState EmptyMK)
         (ShelleyBlock (Praos Crypto))
         BabbageEra)
-> LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
-> (:.:)
     (Flip LedgerState EmptyMK) (ShelleyBlock (Praos Crypto)) ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip LedgerState EmptyMK (ShelleyBlock (Praos Crypto) BabbageEra)
-> (:.:)
     (Flip LedgerState EmptyMK) (ShelleyBlock (Praos Crypto)) BabbageEra
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp
            (Flip LedgerState EmptyMK (ShelleyBlock (Praos Crypto) BabbageEra)
 -> (:.:)
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (Praos Crypto))
      BabbageEra)
-> (LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
    -> Flip
         LedgerState EmptyMK (ShelleyBlock (Praos Crypto) BabbageEra))
-> LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
-> (:.:)
     (Flip LedgerState EmptyMK) (ShelleyBlock (Praos Crypto)) BabbageEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
-> Flip
     LedgerState EmptyMK (ShelleyBlock (Praos Crypto) BabbageEra)
forall x y (f :: x -> y -> *) (x1 :: y) (y1 :: x).
f y1 x1 -> Flip f x1 y1
Flip

-- | Check that the tables are correctly translated from one era to the next.
testTablesTranslation ::
     forall srcBlk dstBlk.
     ( Arbitrary (TestSetup srcBlk dstBlk)
     , Show (LedgerCfg (LedgerState srcBlk))
     , Show (LedgerCfg (LedgerState dstBlk))
     , Show (LedgerState srcBlk EmptyMK)
     )
  => String
  -- ^ Property label
  -> RequiringBoth
        WrapLedgerConfig
        TranslateLedgerState
        srcBlk
        dstBlk
  -> (LedgerState srcBlk EmptyMK -> LedgerState dstBlk DiffMK -> Bool)
  -> (LedgerState srcBlk EmptyMK -> Property -> Property)
  -- ^ Coverage testing function
  -> TestTree
testTablesTranslation :: forall srcBlk dstBlk.
(Arbitrary (TestSetup srcBlk dstBlk),
 Show (LedgerCfg (LedgerState srcBlk)),
 Show (LedgerCfg (LedgerState dstBlk)),
 Show (LedgerState srcBlk EmptyMK)) =>
TestName
-> RequiringBoth
     WrapLedgerConfig TranslateLedgerState srcBlk dstBlk
-> (LedgerState srcBlk EmptyMK
    -> LedgerState dstBlk DiffMK -> Bool)
-> (LedgerState srcBlk EmptyMK -> Property -> Property)
-> TestTree
testTablesTranslation TestName
propLabel RequiringBoth WrapLedgerConfig TranslateLedgerState srcBlk dstBlk
translateWithConfig LedgerState srcBlk EmptyMK -> LedgerState dstBlk DiffMK -> Bool
translationShouldSatisfy LedgerState srcBlk EmptyMK -> Property -> Property
ledgerStateShouldCover =
    TestName -> (TestSetup srcBlk dstBlk -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
propLabel TestSetup srcBlk dstBlk -> Property
withTestSetup
  where
    withTestSetup :: TestSetup srcBlk dstBlk -> Property
    withTestSetup :: TestSetup srcBlk dstBlk -> Property
withTestSetup TestSetup srcBlk dstBlk
ts =
        Property -> Property
forall prop. Testable prop => prop -> Property
checkCoverage (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ LedgerState srcBlk EmptyMK -> Property -> Property
ledgerStateShouldCover LedgerState srcBlk EmptyMK
tsSrcLedgerState
                      (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> Property
forall prop. Testable prop => prop -> Property
property
                      (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ LedgerState srcBlk EmptyMK -> LedgerState dstBlk DiffMK -> Bool
translationShouldSatisfy LedgerState srcBlk EmptyMK
tsSrcLedgerState LedgerState dstBlk DiffMK
destState
      where
        TestSetup {LedgerCfg (LedgerState srcBlk)
tsSrcLedgerConfig :: LedgerCfg (LedgerState srcBlk)
tsSrcLedgerConfig :: forall src dest. TestSetup src dest -> LedgerConfig src
tsSrcLedgerConfig, LedgerCfg (LedgerState dstBlk)
tsDestLedgerConfig :: LedgerCfg (LedgerState dstBlk)
tsDestLedgerConfig :: forall src dest. TestSetup src dest -> LedgerConfig dest
tsDestLedgerConfig, LedgerState srcBlk EmptyMK
tsSrcLedgerState :: LedgerState srcBlk EmptyMK
tsSrcLedgerState :: forall src dest. TestSetup src dest -> LedgerState src EmptyMK
tsSrcLedgerState, EpochNo
tsEpochNo :: EpochNo
tsEpochNo :: forall src dest. TestSetup src dest -> EpochNo
tsEpochNo} = TestSetup srcBlk dstBlk
ts
        destState :: LedgerState dstBlk DiffMK
destState = TranslateLedgerState srcBlk dstBlk
-> EpochNo
-> LedgerState srcBlk EmptyMK
-> LedgerState dstBlk DiffMK
forall x y.
TranslateLedgerState x y
-> EpochNo -> LedgerState x EmptyMK -> LedgerState y DiffMK
translateLedgerStateWith TranslateLedgerState srcBlk dstBlk
translation EpochNo
tsEpochNo LedgerState srcBlk EmptyMK
tsSrcLedgerState
          where
            translation :: TranslateLedgerState srcBlk dstBlk
            translation :: TranslateLedgerState srcBlk dstBlk
translation = RequiringBoth WrapLedgerConfig TranslateLedgerState srcBlk dstBlk
-> WrapLedgerConfig srcBlk
-> WrapLedgerConfig dstBlk
-> TranslateLedgerState srcBlk dstBlk
forall {k} (h :: k -> *) (f :: k -> k -> *) (x :: k) (y :: k).
RequiringBoth h f x y -> h x -> h y -> f x y
provideBoth RequiringBoth WrapLedgerConfig TranslateLedgerState srcBlk dstBlk
translateWithConfig
                                      (LedgerCfg (LedgerState srcBlk) -> WrapLedgerConfig srcBlk
forall blk. LedgerConfig blk -> WrapLedgerConfig blk
WrapLedgerConfig LedgerCfg (LedgerState srcBlk)
tsSrcLedgerConfig)
                                      (LedgerCfg (LedgerState dstBlk) -> WrapLedgerConfig dstBlk
forall blk. LedgerConfig blk -> WrapLedgerConfig blk
WrapLedgerConfig LedgerCfg (LedgerState dstBlk)
tsDestLedgerConfig)

{-------------------------------------------------------------------------------
    Specific predicates
-------------------------------------------------------------------------------}

byronUtxosAreInsertsInShelleyUtxoDiff
  :: LedgerState ByronBlock EmptyMK
  -> LedgerState (ShelleyBlock Proto ShelleyEra) DiffMK
  -> Bool
byronUtxosAreInsertsInShelleyUtxoDiff :: LedgerState ByronBlock EmptyMK
-> LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) DiffMK
-> Bool
byronUtxosAreInsertsInShelleyUtxoDiff LedgerState ByronBlock EmptyMK
srcLedgerState LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) DiffMK
destLedgerState =
    LedgerState ByronBlock EmptyMK -> Diff TxIn (TxOut ShelleyEra)
forall (mk :: MapKind).
LedgerState ByronBlock mk -> Diff TxIn (TxOut ShelleyEra)
toNextUtxoDiff LedgerState ByronBlock EmptyMK
srcLedgerState Diff TxIn (ShelleyTxOut ShelleyEra)
-> Diff TxIn (ShelleyTxOut ShelleyEra) -> Bool
forall a. Eq a => a -> a -> Bool
== LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) DiffMK
-> Diff TxIn (TxOut ShelleyEra)
forall proto era.
LedgerState (ShelleyBlock proto era) DiffMK
-> Diff TxIn (TxOut era)
extractUtxoDiff LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) DiffMK
destLedgerState
  where
    toNextUtxoDiff
      :: LedgerState ByronBlock mk
      -> Diff.Diff SL.TxIn (Core.TxOut ShelleyEra)
    toNextUtxoDiff :: forall (mk :: MapKind).
LedgerState ByronBlock mk -> Diff TxIn (TxOut ShelleyEra)
toNextUtxoDiff LedgerState ByronBlock mk
ledgerState =
      let
        Byron.UTxO Map CompactTxIn CompactTxOut
utxo = ChainValidationState -> UTxO
Byron.cvsUtxo (ChainValidationState -> UTxO) -> ChainValidationState -> UTxO
forall a b. (a -> b) -> a -> b
$ LedgerState ByronBlock mk -> ChainValidationState
forall (mk :: MapKind).
LedgerState ByronBlock mk -> ChainValidationState
byronLedgerState LedgerState ByronBlock mk
ledgerState
        keyFn :: CompactTxIn -> TxIn
keyFn = TxIn -> TxIn
translateTxInByronToShelley (TxIn -> TxIn) -> (CompactTxIn -> TxIn) -> CompactTxIn -> TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompactTxIn -> TxIn
Byron.fromCompactTxIn
        valFn :: CompactTxOut -> Delta (ShelleyTxOut ShelleyEra)
valFn = ShelleyTxOut ShelleyEra -> Delta (ShelleyTxOut ShelleyEra)
forall v. v -> Delta v
Diff.Insert (ShelleyTxOut ShelleyEra -> Delta (ShelleyTxOut ShelleyEra))
-> (CompactTxOut -> ShelleyTxOut ShelleyEra)
-> CompactTxOut
-> Delta (ShelleyTxOut ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompactTxOut -> ShelleyTxOut ShelleyEra
translateCompactTxOutByronToShelley
      in
        Map TxIn (Delta (TxOut ShelleyEra)) -> Diff TxIn (TxOut ShelleyEra)
forall k v. Map k (Delta v) -> Diff k v
Diff.Diff (Map TxIn (Delta (TxOut ShelleyEra))
 -> Diff TxIn (TxOut ShelleyEra))
-> Map TxIn (Delta (TxOut ShelleyEra))
-> Diff TxIn (TxOut ShelleyEra)
forall a b. (a -> b) -> a -> b
$ (CompactTxOut -> Delta (TxOut ShelleyEra))
-> Map TxIn CompactTxOut -> Map TxIn (Delta (TxOut ShelleyEra))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map CompactTxOut -> Delta (TxOut ShelleyEra)
CompactTxOut -> Delta (ShelleyTxOut ShelleyEra)
valFn (Map TxIn CompactTxOut -> Map TxIn (Delta (TxOut ShelleyEra)))
-> Map TxIn CompactTxOut -> Map TxIn (Delta (TxOut ShelleyEra))
forall a b. (a -> b) -> a -> b
$ (CompactTxIn -> TxIn)
-> Map CompactTxIn CompactTxOut -> Map TxIn CompactTxOut
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys CompactTxIn -> TxIn
keyFn Map CompactTxIn CompactTxOut
utxo

    translateTxInByronToShelley :: Byron.TxIn -> TxIn
    translateTxInByronToShelley :: TxIn -> TxIn
translateTxInByronToShelley TxIn
byronTxIn =
      let
        Byron.TxInUtxo TxId
txId Word16
txIx = TxIn
byronTxIn
        shelleyTxId' :: TxId
shelleyTxId' = TxId -> TxId
translateTxIdByronToShelley TxId
txId
      in
        TxId -> TxIx -> TxIn
TxIn TxId
shelleyTxId' (Word16 -> TxIx
TxIx Word16
txIx)

shelleyAvvmAddressesAreDeletesInUtxoDiff
  :: LedgerState (ShelleyBlock Proto ShelleyEra) EmptyMK
  -> LedgerState (ShelleyBlock Proto AllegraEra) DiffMK
  -> Bool
shelleyAvvmAddressesAreDeletesInUtxoDiff :: LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
-> LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) DiffMK
-> Bool
shelleyAvvmAddressesAreDeletesInUtxoDiff LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
srcLedgerState LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) DiffMK
destLedgerState =
    LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
-> Diff TxIn (TxOut AllegraEra)
toNextUtxoDiff LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
srcLedgerState Diff TxIn (ShelleyTxOut AllegraEra)
-> Diff TxIn (ShelleyTxOut AllegraEra) -> Bool
forall a. Eq a => a -> a -> Bool
== LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) DiffMK
-> Diff TxIn (TxOut AllegraEra)
forall proto era.
LedgerState (ShelleyBlock proto era) DiffMK
-> Diff TxIn (TxOut era)
extractUtxoDiff LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) DiffMK
destLedgerState
  where
    toNextUtxoDiff
      :: LedgerState (ShelleyBlock Proto ShelleyEra) EmptyMK
      -> Diff.Diff SL.TxIn (Core.TxOut AllegraEra)
    toNextUtxoDiff :: LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
-> Diff TxIn (TxOut AllegraEra)
toNextUtxoDiff = UTxO ShelleyEra -> Diff TxIn (ShelleyTxOut AllegraEra)
forall {era} {v}. UTxO era -> Diff TxIn v
avvmAddressesToUtxoDiff (UTxO ShelleyEra -> Diff TxIn (ShelleyTxOut AllegraEra))
-> (LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
    -> UTxO ShelleyEra)
-> LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
-> Diff TxIn (ShelleyTxOut AllegraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState ShelleyEra -> UTxO ShelleyEra
NewEpochState ShelleyEra -> StashedAVVMAddresses ShelleyEra
forall era. NewEpochState era -> StashedAVVMAddresses era
stashedAVVMAddresses (NewEpochState ShelleyEra -> UTxO ShelleyEra)
-> (LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
    -> NewEpochState ShelleyEra)
-> LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
-> UTxO ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
-> NewEpochState ShelleyEra
forall proto era (mk :: MapKind).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState
    avvmAddressesToUtxoDiff :: UTxO era -> Diff TxIn v
avvmAddressesToUtxoDiff (UTxO Map TxIn (TxOut era)
m) = Map TxIn (Delta v) -> Diff TxIn v
forall k v. Map k (Delta v) -> Diff k v
Diff.Diff (Map TxIn (Delta v) -> Diff TxIn v)
-> Map TxIn (Delta v) -> Diff TxIn v
forall a b. (a -> b) -> a -> b
$ (TxOut era -> Delta v)
-> Map TxIn (TxOut era) -> Map TxIn (Delta v)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\TxOut era
_ -> Delta v
forall v. Delta v
Diff.Delete) Map TxIn (TxOut era)
m

utxoTablesAreEmpty
  :: LedgerState (ShelleyBlock srcProto srcEra) EmptyMK
  -> LedgerState (ShelleyBlock destProto destEra) DiffMK
  -> Bool
utxoTablesAreEmpty :: forall srcProto srcEra destProto destEra.
LedgerState (ShelleyBlock srcProto srcEra) EmptyMK
-> LedgerState (ShelleyBlock destProto destEra) DiffMK -> Bool
utxoTablesAreEmpty LedgerState (ShelleyBlock srcProto srcEra) EmptyMK
_ LedgerState (ShelleyBlock destProto destEra) DiffMK
destLedgerState = Diff TxIn (TxOut destEra) -> Bool
forall k v. Diff k v -> Bool
Diff.null (Diff TxIn (TxOut destEra) -> Bool)
-> Diff TxIn (TxOut destEra) -> Bool
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock destProto destEra) DiffMK
-> Diff TxIn (TxOut destEra)
forall proto era.
LedgerState (ShelleyBlock proto era) DiffMK
-> Diff TxIn (TxOut era)
extractUtxoDiff LedgerState (ShelleyBlock destProto destEra) DiffMK
destLedgerState

nonEmptyUtxosByron :: LedgerState ByronBlock EmptyMK -> Bool
nonEmptyUtxosByron :: LedgerState ByronBlock EmptyMK -> Bool
nonEmptyUtxosByron LedgerState ByronBlock EmptyMK
ledgerState =
  let Byron.UTxO Map CompactTxIn CompactTxOut
utxo = ChainValidationState -> UTxO
Byron.cvsUtxo (ChainValidationState -> UTxO) -> ChainValidationState -> UTxO
forall a b. (a -> b) -> a -> b
$ LedgerState ByronBlock EmptyMK -> ChainValidationState
forall (mk :: MapKind).
LedgerState ByronBlock mk -> ChainValidationState
byronLedgerState LedgerState ByronBlock EmptyMK
ledgerState
  in Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Map CompactTxIn CompactTxOut -> Bool
forall k a. Map k a -> Bool
Map.null Map CompactTxIn CompactTxOut
utxo

nonEmptyUtxosShelley :: LedgerState (ShelleyBlock proto era) EmptyMK -> Bool
nonEmptyUtxosShelley :: forall proto era.
LedgerState (ShelleyBlock proto era) EmptyMK -> Bool
nonEmptyUtxosShelley LedgerState (ShelleyBlock proto era) EmptyMK
ledgerState =
  let UTxO Map TxIn (TxOut era)
m = UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
utxosUtxo (UTxOState era -> UTxO era) -> UTxOState era -> UTxO era
forall a b. (a -> b) -> a -> b
$ LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState (LedgerState era -> UTxOState era)
-> LedgerState era -> UTxOState era
forall a b. (a -> b) -> a -> b
$ EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> EpochState era -> LedgerState era
forall a b. (a -> b) -> a -> b
$ NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs (NewEpochState era -> EpochState era)
-> NewEpochState era -> EpochState era
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era) EmptyMK -> NewEpochState era
forall proto era (mk :: MapKind).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState LedgerState (ShelleyBlock proto era) EmptyMK
ledgerState
  in Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut era) -> Bool
forall k a. Map k a -> Bool
Map.null Map TxIn (TxOut era)
m

nonEmptyAvvmAddresses :: LedgerState (ShelleyBlock Proto ShelleyEra) EmptyMK -> Bool
nonEmptyAvvmAddresses :: LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
-> Bool
nonEmptyAvvmAddresses LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
ledgerState =
  let UTxO Map TxIn (TxOut ShelleyEra)
m = NewEpochState ShelleyEra -> StashedAVVMAddresses ShelleyEra
forall era. NewEpochState era -> StashedAVVMAddresses era
stashedAVVMAddresses (NewEpochState ShelleyEra -> StashedAVVMAddresses ShelleyEra)
-> NewEpochState ShelleyEra -> StashedAVVMAddresses ShelleyEra
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
-> NewEpochState ShelleyEra
forall proto era (mk :: MapKind).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
ledgerState
  in Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Map TxIn (ShelleyTxOut ShelleyEra) -> Bool
forall k a. Map k a -> Bool
Map.null Map TxIn (TxOut ShelleyEra)
Map TxIn (ShelleyTxOut ShelleyEra)
m

{-------------------------------------------------------------------------------
    Utilities
-------------------------------------------------------------------------------}

extractUtxoDiff
  :: LedgerState (ShelleyBlock proto era) DiffMK
  -> Diff SL.TxIn (Core.TxOut era)
extractUtxoDiff :: forall proto era.
LedgerState (ShelleyBlock proto era) DiffMK
-> Diff TxIn (TxOut era)
extractUtxoDiff LedgerState (ShelleyBlock proto era) DiffMK
shelleyLedgerState =
  let DiffMK Diff TxIn (TxOut era)
tables = LedgerTables (LedgerState (ShelleyBlock proto era)) DiffMK
-> DiffMK
     (TxIn (LedgerState (ShelleyBlock proto era)))
     (TxOut (LedgerState (ShelleyBlock proto era)))
forall (l :: LedgerStateKind) (mk :: MapKind).
LedgerTables l mk -> mk (TxIn l) (TxOut l)
getLedgerTables (LedgerTables (LedgerState (ShelleyBlock proto era)) DiffMK
 -> DiffMK
      (TxIn (LedgerState (ShelleyBlock proto era)))
      (TxOut (LedgerState (ShelleyBlock proto era))))
-> LedgerTables (LedgerState (ShelleyBlock proto era)) DiffMK
-> DiffMK
     (TxIn (LedgerState (ShelleyBlock proto era)))
     (TxOut (LedgerState (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era) DiffMK
-> LedgerTables (LedgerState (ShelleyBlock proto era)) DiffMK
forall proto era (mk :: MapKind).
LedgerState (ShelleyBlock proto era) mk
-> LedgerTables (LedgerState (ShelleyBlock proto era)) mk
shelleyLedgerTables LedgerState (ShelleyBlock proto era) DiffMK
shelleyLedgerState
  in Diff TxIn (TxOut era)
tables

{-------------------------------------------------------------------------------
    TestSetup
-------------------------------------------------------------------------------}

data TestSetup src dest = TestSetup {
    forall src dest. TestSetup src dest -> LedgerConfig src
tsSrcLedgerConfig  :: LedgerConfig src
  , forall src dest. TestSetup src dest -> LedgerConfig dest
tsDestLedgerConfig :: LedgerConfig dest
  , forall src dest. TestSetup src dest -> LedgerState src EmptyMK
tsSrcLedgerState   :: LedgerState src EmptyMK
  , forall src dest. TestSetup src dest -> EpochNo
tsEpochNo          :: EpochNo
}

deriving instance ( Show (LedgerConfig src)
                  , Show (LedgerConfig dest)
                  , Show (LedgerState src EmptyMK)) => Show (TestSetup src dest)

instance Arbitrary (TestSetup ByronBlock (ShelleyBlock Proto ShelleyEra)) where
  arbitrary :: Gen
  (TestSetup ByronBlock (ShelleyBlock (TPraos Crypto) ShelleyEra))
arbitrary =
    let ledgerConfig :: ShelleyLedgerConfig ShelleyEra
ledgerConfig = TranslationContext ShelleyEra -> ShelleyLedgerConfig ShelleyEra
forall era. TranslationContext era -> ShelleyLedgerConfig era
fixedShelleyLedgerConfig TranslationContext ShelleyEra
FromByronTranslationContext
emptyFromByronTranslationContext
    in Config
-> ShelleyLedgerConfig ShelleyEra
-> LedgerState ByronBlock EmptyMK
-> EpochNo
-> TestSetup ByronBlock (ShelleyBlock (TPraos Crypto) ShelleyEra)
LedgerCfg (LedgerState ByronBlock)
-> LedgerCfg
     (LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra))
-> LedgerState ByronBlock EmptyMK
-> EpochNo
-> TestSetup ByronBlock (ShelleyBlock (TPraos Crypto) ShelleyEra)
forall src dest.
LedgerConfig src
-> LedgerConfig dest
-> LedgerState src EmptyMK
-> EpochNo
-> TestSetup src dest
TestSetup (Config
 -> ShelleyLedgerConfig ShelleyEra
 -> LedgerState ByronBlock EmptyMK
 -> EpochNo
 -> TestSetup ByronBlock (ShelleyBlock (TPraos Crypto) ShelleyEra))
-> Gen Config
-> Gen
     (ShelleyLedgerConfig ShelleyEra
      -> LedgerState ByronBlock EmptyMK
      -> EpochNo
      -> TestSetup ByronBlock (ShelleyBlock (TPraos Crypto) ShelleyEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Config
genByronLedgerConfig
                 Gen
  (ShelleyLedgerConfig ShelleyEra
   -> LedgerState ByronBlock EmptyMK
   -> EpochNo
   -> TestSetup ByronBlock (ShelleyBlock (TPraos Crypto) ShelleyEra))
-> Gen (ShelleyLedgerConfig ShelleyEra)
-> Gen
     (LedgerState ByronBlock EmptyMK
      -> EpochNo
      -> TestSetup ByronBlock (ShelleyBlock (TPraos Crypto) ShelleyEra))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ShelleyLedgerConfig ShelleyEra
-> Gen (ShelleyLedgerConfig ShelleyEra)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShelleyLedgerConfig ShelleyEra
ledgerConfig
                 Gen
  (LedgerState ByronBlock EmptyMK
   -> EpochNo
   -> TestSetup ByronBlock (ShelleyBlock (TPraos Crypto) ShelleyEra))
-> Gen (LedgerState ByronBlock EmptyMK)
-> Gen
     (EpochNo
      -> TestSetup ByronBlock (ShelleyBlock (TPraos Crypto) ShelleyEra))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (LedgerState ByronBlock EmptyMK)
genByronLedgerState
                 Gen
  (EpochNo
   -> TestSetup ByronBlock (ShelleyBlock (TPraos Crypto) ShelleyEra))
-> Gen EpochNo
-> Gen
     (TestSetup ByronBlock (ShelleyBlock (TPraos Crypto) ShelleyEra))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> EpochNo
EpochNo (Word64 -> EpochNo) -> Gen Word64 -> Gen EpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary)

instance Arbitrary (TestSetup (ShelleyBlock Proto ShelleyEra)
                              (ShelleyBlock Proto AllegraEra)) where
  arbitrary :: Gen
  (TestSetup
     (ShelleyBlock (TPraos Crypto) ShelleyEra)
     (ShelleyBlock (TPraos Crypto) AllegraEra))
arbitrary = LedgerCfg (LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra))
-> LedgerCfg
     (LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra))
-> LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
-> EpochNo
-> TestSetup
     (ShelleyBlock (TPraos Crypto) ShelleyEra)
     (ShelleyBlock (TPraos Crypto) AllegraEra)
forall src dest.
LedgerConfig src
-> LedgerConfig dest
-> LedgerState src EmptyMK
-> EpochNo
-> TestSetup src dest
TestSetup (TranslationContext ShelleyEra -> ShelleyLedgerConfig ShelleyEra
forall era. TranslationContext era -> ShelleyLedgerConfig era
fixedShelleyLedgerConfig TranslationContext ShelleyEra
FromByronTranslationContext
emptyFromByronTranslationContext)
                        (TranslationContext AllegraEra -> ShelleyLedgerConfig AllegraEra
forall era. TranslationContext era -> ShelleyLedgerConfig era
fixedShelleyLedgerConfig TranslationContext AllegraEra
NoGenesis AllegraEra
forall era. NoGenesis era
Genesis.NoGenesis)
                        (LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
 -> EpochNo
 -> TestSetup
      (ShelleyBlock (TPraos Crypto) ShelleyEra)
      (ShelleyBlock (TPraos Crypto) AllegraEra))
-> Gen
     (LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK)
-> Gen
     (EpochNo
      -> TestSetup
           (ShelleyBlock (TPraos Crypto) ShelleyEra)
           (ShelleyBlock (TPraos Crypto) AllegraEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK)
forall a. Arbitrary a => Gen a
arbitrary
                        Gen
  (EpochNo
   -> TestSetup
        (ShelleyBlock (TPraos Crypto) ShelleyEra)
        (ShelleyBlock (TPraos Crypto) AllegraEra))
-> Gen EpochNo
-> Gen
     (TestSetup
        (ShelleyBlock (TPraos Crypto) ShelleyEra)
        (ShelleyBlock (TPraos Crypto) AllegraEra))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> EpochNo
EpochNo (Word64 -> EpochNo) -> Gen Word64 -> Gen EpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary)

instance Arbitrary (TestSetup (ShelleyBlock Proto AllegraEra)
                              (ShelleyBlock Proto MaryEra)) where
  arbitrary :: Gen
  (TestSetup
     (ShelleyBlock (TPraos Crypto) AllegraEra)
     (ShelleyBlock (TPraos Crypto) MaryEra))
arbitrary = LedgerCfg (LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra))
-> LedgerCfg (LedgerState (ShelleyBlock (TPraos Crypto) MaryEra))
-> LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) EmptyMK
-> EpochNo
-> TestSetup
     (ShelleyBlock (TPraos Crypto) AllegraEra)
     (ShelleyBlock (TPraos Crypto) MaryEra)
forall src dest.
LedgerConfig src
-> LedgerConfig dest
-> LedgerState src EmptyMK
-> EpochNo
-> TestSetup src dest
TestSetup (TranslationContext AllegraEra -> ShelleyLedgerConfig AllegraEra
forall era. TranslationContext era -> ShelleyLedgerConfig era
fixedShelleyLedgerConfig TranslationContext AllegraEra
NoGenesis AllegraEra
forall era. NoGenesis era
Genesis.NoGenesis)
                        (TranslationContext MaryEra -> ShelleyLedgerConfig MaryEra
forall era. TranslationContext era -> ShelleyLedgerConfig era
fixedShelleyLedgerConfig TranslationContext MaryEra
NoGenesis MaryEra
forall era. NoGenesis era
Genesis.NoGenesis)
                        (LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) EmptyMK
 -> EpochNo
 -> TestSetup
      (ShelleyBlock (TPraos Crypto) AllegraEra)
      (ShelleyBlock (TPraos Crypto) MaryEra))
-> Gen
     (LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) EmptyMK)
-> Gen
     (EpochNo
      -> TestSetup
           (ShelleyBlock (TPraos Crypto) AllegraEra)
           (ShelleyBlock (TPraos Crypto) MaryEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) EmptyMK)
forall a. Arbitrary a => Gen a
arbitrary
                        Gen
  (EpochNo
   -> TestSetup
        (ShelleyBlock (TPraos Crypto) AllegraEra)
        (ShelleyBlock (TPraos Crypto) MaryEra))
-> Gen EpochNo
-> Gen
     (TestSetup
        (ShelleyBlock (TPraos Crypto) AllegraEra)
        (ShelleyBlock (TPraos Crypto) MaryEra))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> EpochNo
EpochNo (Word64 -> EpochNo) -> Gen Word64 -> Gen EpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary)

instance Arbitrary (TestSetup (ShelleyBlock Proto MaryEra)
                              (ShelleyBlock Proto AlonzoEra)) where
  arbitrary :: Gen
  (TestSetup
     (ShelleyBlock (TPraos Crypto) MaryEra)
     (ShelleyBlock (TPraos Crypto) AlonzoEra))
arbitrary = LedgerCfg (LedgerState (ShelleyBlock (TPraos Crypto) MaryEra))
-> LedgerCfg (LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra))
-> LedgerState (ShelleyBlock (TPraos Crypto) MaryEra) EmptyMK
-> EpochNo
-> TestSetup
     (ShelleyBlock (TPraos Crypto) MaryEra)
     (ShelleyBlock (TPraos Crypto) AlonzoEra)
forall src dest.
LedgerConfig src
-> LedgerConfig dest
-> LedgerState src EmptyMK
-> EpochNo
-> TestSetup src dest
TestSetup (TranslationContext MaryEra -> ShelleyLedgerConfig MaryEra
forall era. TranslationContext era -> ShelleyLedgerConfig era
fixedShelleyLedgerConfig TranslationContext MaryEra
NoGenesis MaryEra
forall era. NoGenesis era
Genesis.NoGenesis)
                        (ShelleyLedgerConfig AlonzoEra
 -> LedgerState (ShelleyBlock (TPraos Crypto) MaryEra) EmptyMK
 -> EpochNo
 -> TestSetup
      (ShelleyBlock (TPraos Crypto) MaryEra)
      (ShelleyBlock (TPraos Crypto) AlonzoEra))
-> Gen (ShelleyLedgerConfig AlonzoEra)
-> Gen
     (LedgerState (ShelleyBlock (TPraos Crypto) MaryEra) EmptyMK
      -> EpochNo
      -> TestSetup
           (ShelleyBlock (TPraos Crypto) MaryEra)
           (ShelleyBlock (TPraos Crypto) AlonzoEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TranslationContext AlonzoEra -> ShelleyLedgerConfig AlonzoEra
AlonzoGenesis -> ShelleyLedgerConfig AlonzoEra
forall era. TranslationContext era -> ShelleyLedgerConfig era
fixedShelleyLedgerConfig (AlonzoGenesis -> ShelleyLedgerConfig AlonzoEra)
-> Gen AlonzoGenesis -> Gen (ShelleyLedgerConfig AlonzoEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AlonzoGenesis
forall a. Arbitrary a => Gen a
arbitrary)
                        Gen
  (LedgerState (ShelleyBlock (TPraos Crypto) MaryEra) EmptyMK
   -> EpochNo
   -> TestSetup
        (ShelleyBlock (TPraos Crypto) MaryEra)
        (ShelleyBlock (TPraos Crypto) AlonzoEra))
-> Gen (LedgerState (ShelleyBlock (TPraos Crypto) MaryEra) EmptyMK)
-> Gen
     (EpochNo
      -> TestSetup
           (ShelleyBlock (TPraos Crypto) MaryEra)
           (ShelleyBlock (TPraos Crypto) AlonzoEra))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (LedgerState (ShelleyBlock (TPraos Crypto) MaryEra) EmptyMK)
forall a. Arbitrary a => Gen a
arbitrary
                        Gen
  (EpochNo
   -> TestSetup
        (ShelleyBlock (TPraos Crypto) MaryEra)
        (ShelleyBlock (TPraos Crypto) AlonzoEra))
-> Gen EpochNo
-> Gen
     (TestSetup
        (ShelleyBlock (TPraos Crypto) MaryEra)
        (ShelleyBlock (TPraos Crypto) AlonzoEra))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> EpochNo
EpochNo (Word64 -> EpochNo) -> Gen Word64 -> Gen EpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary)

instance Arbitrary (TestSetup (ShelleyBlock (TPraos Crypto) AlonzoEra)
                              (ShelleyBlock (Praos Crypto) BabbageEra)) where
  arbitrary :: Gen
  (TestSetup
     (ShelleyBlock (TPraos Crypto) AlonzoEra)
     (ShelleyBlock (Praos Crypto) BabbageEra))
arbitrary = LedgerCfg (LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra))
-> LedgerCfg (LedgerState (ShelleyBlock (Praos Crypto) BabbageEra))
-> LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) EmptyMK
-> EpochNo
-> TestSetup
     (ShelleyBlock (TPraos Crypto) AlonzoEra)
     (ShelleyBlock (Praos Crypto) BabbageEra)
ShelleyLedgerConfig AlonzoEra
-> ShelleyLedgerConfig BabbageEra
-> LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) EmptyMK
-> EpochNo
-> TestSetup
     (ShelleyBlock (TPraos Crypto) AlonzoEra)
     (ShelleyBlock (Praos Crypto) BabbageEra)
forall src dest.
LedgerConfig src
-> LedgerConfig dest
-> LedgerState src EmptyMK
-> EpochNo
-> TestSetup src dest
TestSetup (ShelleyLedgerConfig AlonzoEra
 -> ShelleyLedgerConfig BabbageEra
 -> LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) EmptyMK
 -> EpochNo
 -> TestSetup
      (ShelleyBlock (TPraos Crypto) AlonzoEra)
      (ShelleyBlock (Praos Crypto) BabbageEra))
-> Gen (ShelleyLedgerConfig AlonzoEra)
-> Gen
     (ShelleyLedgerConfig BabbageEra
      -> LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) EmptyMK
      -> EpochNo
      -> TestSetup
           (ShelleyBlock (TPraos Crypto) AlonzoEra)
           (ShelleyBlock (Praos Crypto) BabbageEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TranslationContext AlonzoEra -> ShelleyLedgerConfig AlonzoEra
AlonzoGenesis -> ShelleyLedgerConfig AlonzoEra
forall era. TranslationContext era -> ShelleyLedgerConfig era
fixedShelleyLedgerConfig (AlonzoGenesis -> ShelleyLedgerConfig AlonzoEra)
-> Gen AlonzoGenesis -> Gen (ShelleyLedgerConfig AlonzoEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AlonzoGenesis
forall a. Arbitrary a => Gen a
arbitrary)
                        Gen
  (ShelleyLedgerConfig BabbageEra
   -> LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) EmptyMK
   -> EpochNo
   -> TestSetup
        (ShelleyBlock (TPraos Crypto) AlonzoEra)
        (ShelleyBlock (Praos Crypto) BabbageEra))
-> Gen (ShelleyLedgerConfig BabbageEra)
-> Gen
     (LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) EmptyMK
      -> EpochNo
      -> TestSetup
           (ShelleyBlock (TPraos Crypto) AlonzoEra)
           (ShelleyBlock (Praos Crypto) BabbageEra))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ShelleyLedgerConfig BabbageEra
-> Gen (ShelleyLedgerConfig BabbageEra)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyLedgerConfig BabbageEra
 -> Gen (ShelleyLedgerConfig BabbageEra))
-> ShelleyLedgerConfig BabbageEra
-> Gen (ShelleyLedgerConfig BabbageEra)
forall a b. (a -> b) -> a -> b
$ TranslationContext BabbageEra -> ShelleyLedgerConfig BabbageEra
forall era. TranslationContext era -> ShelleyLedgerConfig era
fixedShelleyLedgerConfig TranslationContext BabbageEra
NoGenesis BabbageEra
forall era. NoGenesis era
Genesis.NoGenesis)
                        Gen
  (LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) EmptyMK
   -> EpochNo
   -> TestSetup
        (ShelleyBlock (TPraos Crypto) AlonzoEra)
        (ShelleyBlock (Praos Crypto) BabbageEra))
-> Gen
     (LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) EmptyMK)
-> Gen
     (EpochNo
      -> TestSetup
           (ShelleyBlock (TPraos Crypto) AlonzoEra)
           (ShelleyBlock (Praos Crypto) BabbageEra))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) EmptyMK)
forall a. Arbitrary a => Gen a
arbitrary
                        Gen
  (EpochNo
   -> TestSetup
        (ShelleyBlock (TPraos Crypto) AlonzoEra)
        (ShelleyBlock (Praos Crypto) BabbageEra))
-> Gen EpochNo
-> Gen
     (TestSetup
        (ShelleyBlock (TPraos Crypto) AlonzoEra)
        (ShelleyBlock (Praos Crypto) BabbageEra))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> EpochNo
EpochNo (Word64 -> EpochNo) -> Gen Word64 -> Gen EpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary)

instance Arbitrary (TestSetup (ShelleyBlock (Praos Crypto) BabbageEra)
                              (ShelleyBlock (Praos Crypto) ConwayEra)) where
  arbitrary :: Gen
  (TestSetup
     (ShelleyBlock (Praos Crypto) BabbageEra)
     (ShelleyBlock (Praos Crypto) ConwayEra))
arbitrary = LedgerCfg (LedgerState (ShelleyBlock (Praos Crypto) BabbageEra))
-> LedgerCfg (LedgerState (ShelleyBlock (Praos Crypto) ConwayEra))
-> LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
-> EpochNo
-> TestSetup
     (ShelleyBlock (Praos Crypto) BabbageEra)
     (ShelleyBlock (Praos Crypto) ConwayEra)
ShelleyLedgerConfig BabbageEra
-> ShelleyLedgerConfig ConwayEra
-> LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
-> EpochNo
-> TestSetup
     (ShelleyBlock (Praos Crypto) BabbageEra)
     (ShelleyBlock (Praos Crypto) ConwayEra)
forall src dest.
LedgerConfig src
-> LedgerConfig dest
-> LedgerState src EmptyMK
-> EpochNo
-> TestSetup src dest
TestSetup (ShelleyLedgerConfig BabbageEra
 -> ShelleyLedgerConfig ConwayEra
 -> LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
 -> EpochNo
 -> TestSetup
      (ShelleyBlock (Praos Crypto) BabbageEra)
      (ShelleyBlock (Praos Crypto) ConwayEra))
-> Gen (ShelleyLedgerConfig BabbageEra)
-> Gen
     (ShelleyLedgerConfig ConwayEra
      -> LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
      -> EpochNo
      -> TestSetup
           (ShelleyBlock (Praos Crypto) BabbageEra)
           (ShelleyBlock (Praos Crypto) ConwayEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ShelleyLedgerConfig BabbageEra
-> Gen (ShelleyLedgerConfig BabbageEra)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyLedgerConfig BabbageEra
 -> Gen (ShelleyLedgerConfig BabbageEra))
-> ShelleyLedgerConfig BabbageEra
-> Gen (ShelleyLedgerConfig BabbageEra)
forall a b. (a -> b) -> a -> b
$ TranslationContext BabbageEra -> ShelleyLedgerConfig BabbageEra
forall era. TranslationContext era -> ShelleyLedgerConfig era
fixedShelleyLedgerConfig TranslationContext BabbageEra
NoGenesis BabbageEra
forall era. NoGenesis era
Genesis.NoGenesis)
                        Gen
  (ShelleyLedgerConfig ConwayEra
   -> LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
   -> EpochNo
   -> TestSetup
        (ShelleyBlock (Praos Crypto) BabbageEra)
        (ShelleyBlock (Praos Crypto) ConwayEra))
-> Gen (ShelleyLedgerConfig ConwayEra)
-> Gen
     (LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
      -> EpochNo
      -> TestSetup
           (ShelleyBlock (Praos Crypto) BabbageEra)
           (ShelleyBlock (Praos Crypto) ConwayEra))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TranslationContext ConwayEra -> ShelleyLedgerConfig ConwayEra
ConwayGenesis -> ShelleyLedgerConfig ConwayEra
forall era. TranslationContext era -> ShelleyLedgerConfig era
fixedShelleyLedgerConfig (ConwayGenesis -> ShelleyLedgerConfig ConwayEra)
-> Gen ConwayGenesis -> Gen (ShelleyLedgerConfig ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ConwayGenesis
forall a. Arbitrary a => Gen a
arbitrary)
                        Gen
  (LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
   -> EpochNo
   -> TestSetup
        (ShelleyBlock (Praos Crypto) BabbageEra)
        (ShelleyBlock (Praos Crypto) ConwayEra))
-> Gen
     (LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK)
-> Gen
     (EpochNo
      -> TestSetup
           (ShelleyBlock (Praos Crypto) BabbageEra)
           (ShelleyBlock (Praos Crypto) ConwayEra))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK)
forall a. Arbitrary a => Gen a
arbitrary
                        Gen
  (EpochNo
   -> TestSetup
        (ShelleyBlock (Praos Crypto) BabbageEra)
        (ShelleyBlock (Praos Crypto) ConwayEra))
-> Gen EpochNo
-> Gen
     (TestSetup
        (ShelleyBlock (Praos Crypto) BabbageEra)
        (ShelleyBlock (Praos Crypto) ConwayEra))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> EpochNo
EpochNo (Word64 -> EpochNo) -> Gen Word64 -> Gen EpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary)

{-------------------------------------------------------------------------------
    Generators
-------------------------------------------------------------------------------}

-- | A fixed ledger config should be sufficient as the updating of the ledger
-- tables on era transitions does not depend on the configurations of any of
-- the ledgers involved.
fixedShelleyLedgerConfig ::
     Core.TranslationContext era
  -> ShelleyLedgerConfig era
fixedShelleyLedgerConfig :: forall era. TranslationContext era -> ShelleyLedgerConfig era
fixedShelleyLedgerConfig TranslationContext era
translationContext =
  ShelleyGenesis
-> TranslationContext era
-> EpochInfo (Except PastHorizonException)
-> ShelleyLedgerConfig era
forall era.
ShelleyGenesis
-> TranslationContext era
-> EpochInfo (Except PastHorizonException)
-> ShelleyLedgerConfig era
mkShelleyLedgerConfig
    ShelleyGenesis
testShelleyGenesis
    TranslationContext era
translationContext
    (EpochSize -> SlotLength -> EpochInfo (Except PastHorizonException)
forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo (ShelleyGenesis -> EpochSize
sgEpochLength ShelleyGenesis
testShelleyGenesis) (Integer -> SlotLength
slotLengthFromSec Integer
2))