Add roundtrip tests for LedgerConfig

Co-authored-by: Javier Sagredo <[email protected]>
IntersectMBO · Feb 20, 2025 · 0f3d678 · 0f3d678
1 parent 41f707b
commit 0f3d678
Show file tree

Hide file tree

Showing 5 changed files with 232 additions and 20 deletions.
diff --git a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/Consensus/Byron/Generators.hs b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/Consensus/Byron/Generators.hs
@@ -14,7 +14,8 @@ import           Cardano.Chain.Block (ABlockOrBoundary (..),
                      ABlockOrBoundaryHdr (..))
 import qualified Cardano.Chain.Block as CC.Block
 import qualified Cardano.Chain.Byron.API as API
-import           Cardano.Chain.Common (KeyHash)
+import           Cardano.Chain.Common (Address, BlockCount (..), CompactAddress,
+                     KeyHash, Lovelace)
 import qualified Cardano.Chain.Delegation as CC.Del
 import qualified Cardano.Chain.Delegation.Validation.Activation as CC.Act
 import qualified Cardano.Chain.Delegation.Validation.Interface as CC.DI
@@ -26,12 +27,20 @@ import qualified Cardano.Chain.Update as CC.Update
 import qualified Cardano.Chain.Update.Validation.Interface as CC.UPI
 import qualified Cardano.Chain.Update.Validation.Registration as CC.Reg
 import qualified Cardano.Chain.UTxO as CC.UTxO
-import           Cardano.Crypto (ProtocolMagicId (..))
+import           Cardano.Crypto (ProtocolMagicId (..),
+                     RequiresNetworkMagic (..))
 import           Cardano.Crypto.Hashing (Hash)
+import           Cardano.Crypto.Signing
+import qualified Cardano.Crypto.Wallet as Wallet
 import           Cardano.Ledger.Binary (decCBOR, encCBOR)
 import           Control.Monad (replicateM)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Char8 as BSC8
 import           Data.Coerce (coerce)
 import qualified Data.Map.Strict as Map
+import           Data.String (IsString (fromString))
+import qualified Data.Text as T
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Byron.Ledger
 import           Ouroboros.Consensus.Byron.Protocol
@@ -72,6 +81,82 @@ epochSlots = EpochSlots 100
 protocolMagicId :: ProtocolMagicId
 protocolMagicId = ProtocolMagicId 100
 
+instance Arbitrary CC.Genesis.Config where
+  arbitrary = CC.Genesis.Config
+    <$> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+
+instance Arbitrary CC.Genesis.GenesisData where
+  arbitrary = CC.Genesis.GenesisData
+    <$> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+
+instance Arbitrary CC.Genesis.GenesisKeyHashes where
+  arbitrary = CC.Genesis.GenesisKeyHashes <$> arbitrary
+
+instance Arbitrary CC.Genesis.GenesisDelegation where
+  arbitrary = (CC.Genesis.mkGenesisDelegation <$> arbitrary)
+    `suchThatMap` (either (const Nothing) Just)
+
+instance Arbitrary (CC.Del.ACertificate ()) where
+  arbitrary = CC.Del.signCertificate
+    <$> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+
+instance Arbitrary SafeSigner where
+  arbitrary = do
+    seed <- BS.pack <$> sequence (replicate 32 arbitrary)
+    passPhrase <- BS.pack <$> sequence (replicate passphraseLength arbitrary)
+    let xprv = Wallet.generate seed passPhrase
+    return $ SafeSigner (SigningKey xprv) (PassPhrase (fromString (BSC8.unpack passPhrase)))
+
+instance Arbitrary VerificationKey where
+  arbitrary = either (error . show) id . parseFullVerificationKey <$>
+    (T.pack . BSC8.unpack . B64.encode <$> arbitraryKey)
+    where
+      -- The key must be 64 bytes
+      arbitraryKey = BS.pack <$> sequence (replicate 64 arbitrary)
+
+instance Arbitrary CC.Genesis.GenesisNonAvvmBalances where
+  arbitrary = CC.Genesis.GenesisNonAvvmBalances <$> arbitrary
+
+instance Arbitrary Address where
+  arbitrary = hedgehog CC.genAddress
+
+instance Arbitrary Lovelace where
+  arbitrary = hedgehog CC.genLovelace
+
+instance Arbitrary CC.Genesis.GenesisAvvmBalances where
+  arbitrary = CC.Genesis.GenesisAvvmBalances <$> arbitrary
+
+instance Arbitrary CompactRedeemVerificationKey where
+  arbitrary = hedgehog CC.genCompactRedeemVerificationKey
+
+instance Arbitrary BlockCount where
+  arbitrary = hedgehog CC.genBlockCount
+
+instance Arbitrary RequiresNetworkMagic where
+  arbitrary = hedgehog CC.genRequiresNetworkMagic
+
+instance Arbitrary ProtocolMagicId where
+  arbitrary = hedgehog CC.genProtocolMagicId
+
+instance Arbitrary CC.UTxO.UTxOConfiguration where
+  arbitrary = CC.UTxO.UTxOConfiguration <$> arbitrary
+
+instance Arbitrary CompactAddress where
+  arbitrary = hedgehog CC.genCompactAddress
+
 -- | A 'ByronBlock' that is never an EBB.
 newtype RegularBlock = RegularBlock { unRegularBlock :: ByronBlock }
   deriving (Eq, Show)

diff --git a/...boros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/Generators.hs b/...boros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/Generators.hs
@@ -21,34 +21,39 @@
 --
 -- We combine the Byron and Shelley-based instances defined elsewhere into
 -- Cardano instances by picking randomly from one of the eras.
-module Test.Consensus.Cardano.Generators (module Test.Consensus.Byron.Generators) where
+module Test.Consensus.Cardano.Generators () where
 
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (catMaybes, fromMaybe)
 import           Data.Proxy
 import           Data.SOP.BasicFunctors
+import           Data.SOP.Counting (Exactly (..))
 import           Data.SOP.Index
 import           Data.SOP.NonEmpty
 import           Data.SOP.Sing
 import           Data.SOP.Strict
 import           Ouroboros.Consensus.Block
+import           Ouroboros.Consensus.Byron.ByronHFC
 import           Ouroboros.Consensus.Byron.Ledger
 import           Ouroboros.Consensus.Cardano.Block
-import           Ouroboros.Consensus.Cardano.Node (CardanoHardForkConstraints)
+import           Ouroboros.Consensus.Cardano.CanHardFork
+import           Ouroboros.Consensus.Cardano.Node ()
 import           Ouroboros.Consensus.HardFork.Combinator
 import           Ouroboros.Consensus.HardFork.Combinator.Serialisation
 import qualified Ouroboros.Consensus.HardFork.History as History
 import           Ouroboros.Consensus.HeaderValidation
 import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.Node.Serialisation (Some (..))
 import           Ouroboros.Consensus.Protocol.TPraos (TPraos)
+import           Ouroboros.Consensus.Shelley.HFEras ()
 import           Ouroboros.Consensus.Shelley.Ledger
 import           Ouroboros.Consensus.Shelley.Ledger.Block ()
 import           Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
 import           Ouroboros.Consensus.TypeFamilyWrappers
+import           Test.Cardano.Ledger.Alonzo.Arbitrary ()
 import           Test.Cardano.Ledger.Alonzo.Serialisation.Generators ()
 import           Test.Cardano.Ledger.Conway.Arbitrary ()
-import           Test.Consensus.Byron.Generators
+import           Test.Consensus.Byron.Generators ()
 import           Test.Consensus.Cardano.MockCrypto
 import           Test.Consensus.Protocol.Serialisation.Generators ()
 import           Test.Consensus.Shelley.Generators
@@ -543,19 +548,6 @@ instance Arbitrary History.EraEnd where
       , return History.EraUnbounded
       ]
 
-instance Arbitrary History.SafeZone where
-  arbitrary = oneof
-      [ History.StandardSafeZone <$> arbitrary
-      , return History.UnsafeIndefiniteSafeZone
-      ]
-
-instance Arbitrary History.EraParams where
-  arbitrary = History.EraParams
-      <$> (EpochSize <$> arbitrary)
-      <*> arbitrary
-      <*> arbitrary
-      <*> (GenesisWindow <$> arbitrary)
-
 instance Arbitrary History.EraSummary where
   arbitrary = History.EraSummary
       <$> arbitrary
@@ -705,3 +697,63 @@ instance c ~ MockCryptoCompatByron
               <$> (getHardForkEnabledNodeToClientVersion <$> arbitrary)
               <*> (SomeResult (QueryHardFork GetCurrentEra) <$> arbitrary)
           ]
+
+{------------------------------------------------------------------------------
+  Ledger Config
+------------------------------------------------------------------------------}
+
+
+-- | See 'encodeNodeToClientNP' and 'decodeNodeToClientNP'.
+instance CardanoHardForkConstraints c
+      => Arbitrary (WithVersion
+                     (HardForkNodeToClientVersion (CardanoEras c))
+                     (HardForkLedgerConfig (CardanoEras c))
+                   ) where
+  arbitrary = WithVersion
+      -- Use a version that enables all eras. We assume that all eras are
+      -- enabled in the maximum supported version.
+      (snd $ fromMaybe err $ Map.lookupMax $ supportedNodeToClientVersions (Proxy @(CardanoBlock c)))
+      <$> arbitrary
+    where
+      err = error "Expected at least 1 supported note-to-client version, but `supportedNodeToClientVersions` has none"
+
+instance CardanoHardForkConstraints c
+      => Arbitrary (HardForkLedgerConfig (CardanoEras c)) where
+  arbitrary = HardForkLedgerConfig <$> arbitrary <*> arbitrary
+
+instance SListI xs => Arbitrary (History.Shape xs) where
+  arbitrary = History.Shape . Exactly <$> hsequenceK (hpure (K arbitrary))
+
+instance (CardanoHardForkConstraints c)
+      => Arbitrary (PerEraLedgerConfig (CardanoEras c)) where
+  arbitrary = do
+    byronPLC   <- WrapPartialLedgerConfig <$> arbitrary
+    shelleyPLC <- WrapPartialLedgerConfig <$> arbitrary
+    allegraPLC <- WrapPartialLedgerConfig <$> arbitrary
+    maryPLC    <- WrapPartialLedgerConfig <$> arbitrary
+    alonzoPLC  <- WrapPartialLedgerConfig <$> arbitrary
+    babbagePLC <- WrapPartialLedgerConfig <$> arbitrary
+    conwayPLC  <- WrapPartialLedgerConfig <$> arbitrary
+    return $ PerEraLedgerConfig $
+      byronPLC
+      :* shelleyPLC
+      :* allegraPLC
+      :* maryPLC
+      :* alonzoPLC
+      :* babbagePLC
+      :* conwayPLC
+      :* Nil
+
+instance Arbitrary ByronPartialLedgerConfig where
+  arbitrary = ByronPartialLedgerConfig <$> arbitrary <*> arbitrary
+
+instance Arbitrary (ShelleyLedgerConfig era)
+      => Arbitrary (ShelleyPartialLedgerConfig era) where
+  arbitrary = ShelleyPartialLedgerConfig <$> arbitrary <*> arbitrary
+
+instance Arbitrary TriggerHardFork where
+  arbitrary = oneof [
+      TriggerHardForkAtVersion <$> arbitrary
+    , TriggerHardForkAtEpoch <$> arbitrary
+    , pure TriggerHardForkNotDuringThisExecution
+    ]
diff --git a/...os-consensus-diffusion/src/unstable-mock-testlib/Test/Consensus/Ledger/Mock/Generators.hs b/...os-consensus-diffusion/src/unstable-mock-testlib/Test/Consensus/Ledger/Mock/Generators.hs
@@ -25,7 +25,6 @@ import qualified Ouroboros.Consensus.Mock.Ledger.State as L
 import qualified Ouroboros.Consensus.Mock.Ledger.UTxO as L
 import           Ouroboros.Consensus.Mock.Node.Serialisation ()
 import           Ouroboros.Consensus.Protocol.BFT
-import           Test.ChainGenerators ()
 import           Test.Crypto.Hash ()
 import           Test.QuickCheck
 import           Test.Util.Orphans.Arbitrary ()
@@ -108,6 +107,16 @@ instance (SimpleCrypto c, Typeable ext) => Arbitrary (SomeResult (SimpleBlock c
 instance Arbitrary (LedgerState (SimpleBlock c ext)) where
   arbitrary = SimpleLedgerState <$> arbitrary
 
+instance Arbitrary ByteSize32 where
+  arbitrary = ByteSize32 <$> arbitrary
+
+instance Arbitrary L.MockConfig where
+  arbitrary = L.MockConfig <$> arbitrary
+
+instance ( Arbitrary (MockLedgerConfig c ext)
+         ) => Arbitrary (SimpleLedgerConfig c ext) where
+  arbitrary = SimpleLedgerConfig <$> arbitrary <*> arbitrary <*> arbitrary
+
 instance HashAlgorithm (SimpleHash c) => Arbitrary (AnnTip (SimpleBlock c ext)) where
   arbitrary = do
       annTipSlotNo  <- SlotNo  <$> arbitrary

diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/Arbitrary.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/Arbitrary.hs
@@ -45,6 +45,7 @@ import           Ouroboros.Consensus.HardFork.Combinator (HardForkBlock,
 import           Ouroboros.Consensus.HardFork.Combinator.State (Current (..),
                      Past (..))
 import           Ouroboros.Consensus.HardFork.History (Bound (..))
+import           Ouroboros.Consensus.HardFork.History.EraParams
 import           Ouroboros.Consensus.HeaderValidation (TipInfo)
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Query
@@ -61,6 +62,7 @@ import           Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Layout
 import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index as Index
 import           Ouroboros.Consensus.TypeFamilyWrappers
 import           Ouroboros.Network.SizeInBytes
+import           Test.Cardano.Ledger.Binary.Arbitrary ()
 import           Test.Cardano.Slotting.Arbitrary ()
 import           Test.QuickCheck hiding (Fixed (..))
 import           Test.QuickCheck.Instances ()
@@ -265,6 +267,19 @@ instance (All (Arbitrary `Compose` f) xs, IsNonEmpty xs)
           ]
   shrink = hctraverse' (Proxy @(Arbitrary `Compose` f)) shrink
 
+{-------------------------------------------------------------------------------
+  Configuration
+-------------------------------------------------------------------------------}
+
+instance Arbitrary EraParams where
+  arbitrary = EraParams <$> arbitrary <*> arbitrary <*> arbitrary <*> (GenesisWindow <$> arbitrary)
+
+instance Arbitrary SafeZone where
+  arbitrary = oneof
+      [ StandardSafeZone <$> arbitrary
+      , return UnsafeIndefiniteSafeZone
+      ]
+
 {-------------------------------------------------------------------------------
   Telescope & HardForkState
 -------------------------------------------------------------------------------}