Merge pull request #1598 from sgillespie/feature/test-proto-hf

Test: Hard Fork (Babbage -> Conway) with parameter update proposal

Author: sgillespie

cardano-chain-gen/cardano-chain-gen.cabal

@@ -44,6 +44,7 @@ library
                         Cardano.Mock.ChainDB
                         Cardano.Mock.ChainSync.Server
                         Cardano.Mock.ChainSync.State
+                        Cardano.Mock.Query
                         Cardano.Mock.Forging.Crypto
                         Cardano.Mock.Forging.Interpreter
                         Cardano.Mock.Forging.Tx.Alonzo
@@ -63,6 +64,7 @@ library
                       , bytestring
                       , cardano-binary
                       , cardano-crypto-class
+                      , cardano-db
                       , cardano-ledger-allegra
                       , cardano-ledger-alonzo
                       , cardano-ledger-babbage
@@ -78,6 +80,7 @@ library
                       , containers
                       , contra-tracer
                       , directory
+                      , esqueleto
                       , extra
                       , mtl
                       , microlens

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Babbage.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
@@ -44,6 +45,7 @@ module Cardano.Mock.Forging.Tx.Babbage (
   mkWitnesses,
   mkUTxOBabbage,
   mkUTxOCollBabbage,
+  mkParamUpdateTx,
   mkFullTx,
   emptyTxBody,
   emptyTx,
@@ -90,6 +92,7 @@ import Lens.Micro
 import Ouroboros.Consensus.Cardano.Block (LedgerState)
 import Ouroboros.Consensus.Shelley.Eras (StandardBabbage, StandardCrypto)
 import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock)
+import Prelude hiding (map)
 
 type BabbageUTxOIndex = UTxOIndex StandardBabbage
 
@@ -515,6 +518,37 @@ emptyTx =
     , auxiliaryData = maybeToStrictMaybe Nothing
     }
 
+mkParamUpdateTx :: Either ForgingError (AlonzoTx StandardBabbage)
+mkParamUpdateTx = Right (mkSimpleTx True txBody)
+  where
+    txBody =
+      BabbageTxBody
+        { btbInputs = mempty
+        , btbCollateral = mempty
+        , btbReferenceInputs = mempty
+        , btbOutputs = mempty
+        , btbCollateralReturn = SNothing
+        , btbTotalCollateral = SNothing
+        , btbCerts = mempty
+        , btbWithdrawals = Withdrawals mempty
+        , btbTxFee = Coin 0
+        , btbValidityInterval = ValidityInterval SNothing SNothing
+        , btbUpdate = SJust $ Update update (EpochNo 1)
+        , btbReqSignerHashes = mempty
+        , btbMint = mempty
+        , btbScriptIntegrityHash = SNothing
+        , btbAuxDataHash = SNothing
+        , btbTxNetworkId = SJust Testnet
+        }
+    update =
+      ProposedPPUpdates $
+        Map.fromList $
+          map (,paramsUpdate) registeredShelleyGenesisKeys
+    paramsUpdate =
+      Core.emptyPParamsUpdate
+        & ppuProtocolVersionL
+          .~ SJust (ProtVer (natVersion @9) 0)
+
 mkFullTx ::
   Int ->
   Integer ->

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway.hs

@@ -32,6 +32,7 @@ module Cardano.Mock.Forging.Tx.Conway (
   mkRegTxCert,
   mkUnRegTxCert,
   mkDelegTxCert,
+  Babbage.mkParamUpdateTx,
   mkFullTx,
   mkScriptMint,
   Babbage.mkScriptInp,

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Generic.hs

@@ -22,6 +22,8 @@ module Cardano.Mock.Forging.Tx.Generic (
   unregisteredAddresses,
   unregisteredStakeCredentials,
   unregisteredPools,
+  registeredByronGenesisKeys,
+  registeredShelleyGenesisKeys,
   consPoolParams,
   getPoolStakeCreds,
 ) where
@@ -249,6 +251,17 @@ unregisteredGenesisKeys =
   , KeyHash "33323876542397465497834256329487563428975634827956348975"
   ]
 
+registeredByronGenesisKeys :: [KeyHash 'Genesis StandardCrypto]
+registeredByronGenesisKeys =
+  [ KeyHash "1a3e49767796fd99b057ad54db3310fd640806fcb0927399bbca7b43"
+  ]
+
+registeredShelleyGenesisKeys :: [KeyHash 'Genesis StandardCrypto]
+registeredShelleyGenesisKeys =
+  [ KeyHash "30c3083efd794227fde2351a04500349d1b467556c30e35d6794a501"
+  , KeyHash "471cc34983f6a2fd7b4018e3147532185d69a448d6570d46019e58e6"
+  ]
+
 createStakeCredentials :: Int -> [StakeCredential StandardCrypto]
 createStakeCredentials n =
   fmap (KeyHashObj . KeyHash . mkDummyHash (Proxy @(ADDRHASH StandardCrypto))) [1 .. n]

cardano-chain-gen/src/Cardano/Mock/Query.hs

@@ -0,0 +1,43 @@
+{-# LANGUAGE TypeApplications #-}
+
+module Cardano.Mock.Query (
+  queryVersionMajorFromEpoch,
+  queryParamProposalFromEpoch,
+) where
+
+import qualified Cardano.Db as Db
+import Cardano.Prelude hiding (from)
+import Database.Esqueleto.Experimental
+import Prelude ()
+
+-- | Query protocol parameters from @EpochParam@ by epoch number. Note that epoch
+--   parameters are inserted at the beginning of the next epoch.
+--
+-- TODO[sgillespie]: It would probably be better to return @Db.EpochParam@, but
+-- persistent seems to be having trouble with the data:
+--
+--     PersistMarshalError "Couldn't parse field `govActionLifetime` from table
+--     `epoch_param`. Failed to parse Haskell type `Word64`; expected integer from
+--     database, but received: PersistRational (0 % 1).
+queryVersionMajorFromEpoch ::
+  MonadIO io =>
+  Word64 ->
+  ReaderT SqlBackend io (Maybe Word16)
+queryVersionMajorFromEpoch epochNo = do
+  res <- selectOne $ do
+    prop <- from $ table @Db.EpochParam
+    where_ (prop ^. Db.EpochParamEpochNo ==. val epochNo)
+    pure (prop ^. Db.EpochParamProtocolMajor)
+  pure $ unValue <$> res
+
+-- | Query protocol parameter proposals from @ParamProposal@ by epoch number.
+queryParamProposalFromEpoch ::
+  MonadIO io =>
+  Word64 ->
+  ReaderT SqlBackend io (Maybe Db.ParamProposal)
+queryParamProposalFromEpoch epochNo = do
+  res <- selectOne $ do
+    prop <- from $ table @Db.ParamProposal
+    where_ $ prop ^. Db.ParamProposalEpochNo ==. val (Just epochNo)
+    pure prop
+  pure $ entityVal <$> res

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway.hs

@@ -202,6 +202,7 @@ unitTests iom knownMigrations =
         "Hard Fork"
         [ test "fork from Babbage to Conway fixed epoch" Other.forkFixedEpoch
         , test "fork from Babbage to Conway and rollback" Other.rollbackFork
+        , test "fork with protocol change proposal" Other.forkParam
         ]
     ]
   where

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Other.hs

@@ -1,5 +1,9 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ExplicitNamespaces #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Test.Cardano.Db.Mock.Unit.Conway.Other (
   -- * Different configs
@@ -16,22 +20,25 @@ module Test.Cardano.Db.Mock.Unit.Conway.Other (
   -- * Hard fork
   forkFixedEpoch,
   rollbackFork,
+  forkParam,
 ) where
 
+import qualified Cardano.Db as Db
 import Cardano.DbSync.Era.Shelley.Generic.Util (unKeyHashRaw)
-import Cardano.Ledger.BaseTypes (EpochNo ())
+import Cardano.Ledger.BaseTypes (EpochNo (..))
 import Cardano.Ledger.Conway.TxCert (ConwayTxCert (..))
 import Cardano.Ledger.Core (PoolCert (..))
 import Cardano.Ledger.Credential (StakeCredential ())
 import Cardano.Ledger.Crypto (StandardCrypto ())
 import Cardano.Ledger.Keys (KeyHash (), KeyRole (..))
 import Cardano.Mock.ChainSync.Server (IOManager (), addBlock, rollback)
-import Cardano.Mock.Forging.Interpreter (forgeNext)
+import Cardano.Mock.Forging.Interpreter (forgeNext, getCurrentEpoch)
 import qualified Cardano.Mock.Forging.Tx.Babbage as Babbage
 import qualified Cardano.Mock.Forging.Tx.Conway as Conway
 import Cardano.Mock.Forging.Tx.Generic (resolvePool)
 import Cardano.Mock.Forging.Types
-import Cardano.Prelude
+import Cardano.Mock.Query (queryParamProposalFromEpoch, queryVersionMajorFromEpoch)
+import Cardano.Prelude hiding (from)
 import Cardano.SMASH.Server.PoolDataLayer (PoolDataLayer (..), dbToServantPoolId)
 import Cardano.SMASH.Server.Types (DBFail (..))
 import Data.List (last)
@@ -436,3 +443,62 @@ rollbackFork =
   where
     configDir = "config-conway-hf-epoch1"
     testLabel = "conwayRollbackFork"
+
+forkParam :: IOManager -> [(Text, Text)] -> Assertion
+forkParam =
+  withFullConfig configDir testLabel $ \interpreter mockServer dbSync -> do
+    startDBSync dbSync
+
+    -- Protocol params aren't added to the DB until the following epoch
+    epoch0 <- Api.fillUntilNextEpoch interpreter mockServer
+    -- Wait for it to sync
+    assertBlockNoBackoff dbSync (length epoch0)
+    -- Protocol major version should still match config
+    assertEqBackoff
+      dbSync
+      (queryCurrentMajVer interpreter)
+      (Just 7)
+      []
+      "Unexpected protocol major version"
+
+    -- Propose a parameter update
+    void $
+      Api.withBabbageFindLeaderAndSubmitTx interpreter mockServer $
+        const Babbage.mkParamUpdateTx
+    -- Wait for it to sync
+    assertBlockNoBackoff dbSync (1 + length epoch0)
+    -- Query protocol param proposals
+    assertEqBackoff
+      dbSync
+      (queryMajVerProposal interpreter)
+      (Just 9)
+      []
+      "Unexpected protocol major version proposal"
+
+    -- The fork will be applied on the first block of the next epoch
+    epoch1 <- Api.fillUntilNextEpoch interpreter mockServer
+    -- Wait for it to sync
+    assertBlockNoBackoff dbSync $ 1 + length (epoch0 <> epoch1)
+    -- Protocol major version should now be updated
+    assertEqBackoff
+      dbSync
+      (queryCurrentMajVer interpreter)
+      (Just 9)
+      []
+      "Unexpected protocol major version"
+
+    -- Add a simple Conway tx
+    void $
+      Api.withConwayFindLeaderAndSubmitTx interpreter mockServer $
+        Conway.mkPaymentTx (UTxOIndex 0) (UTxOIndex 1) 10_000 500
+    -- Wait for it to sync
+    assertBlockNoBackoff dbSync $ 2 + length (epoch0 <> epoch1)
+  where
+    testLabel = "conwayForkParam"
+    configDir = babbageConfigDir
+    queryCurrentMajVer interpreter = queryVersionMajorFromEpoch =<< getEpochNo interpreter
+    queryMajVerProposal interpreter = do
+      epochNo <- getEpochNo interpreter
+      prop <- queryParamProposalFromEpoch epochNo
+      pure (Db.paramProposalProtocolMajor =<< prop)
+    getEpochNo = fmap unEpochNo . liftIO . getCurrentEpoch

cardano-chain-gen/test/testfiles/config-conway/genesis.json

@@ -2,7 +2,7 @@
     "maxLovelaceSupply": 60000000,
     "securityParam": 10,
     "slotsPerKESPeriod": 129600,
-    "updateQuorum": 5,
+    "updateQuorum": 2,
     "activeSlotsCoeff": 0.2,
     "protocolParams": {
         "minUTxOValue": 0,
@@ -43,7 +43,16 @@
     },
     "networkId": "Testnet",
     "maxKESEvolutions": 60,
-    "genDelegs": { },
+    "genDelegs": {
+        "30c3083efd794227fde2351a04500349d1b467556c30e35d6794a501": {
+            "delegate": "3af50e522694318e8856d34021140817aa21d47ff62a4d0ddcba1924",
+            "vrf": "2846ed605f6629976ec92e9e65140c1cb3a95c563c996592c926a2ae7e5a461f"
+        },
+        "471cc34983f6a2fd7b4018e3147532185d69a448d6570d46019e58e6": {
+            "delegate": "1683652d05e83e25eb648a9543db33cf8ff1f7a2af9129d3a901dd4a",
+            "vrf": "4df7c5a5b30469756bd09db60cbe9b0cf1b2447e0c41122d130768c179b7d166"
+        }
+    },
     "slotLength": 1,
     "systemStart": "2021-11-18T20:22:02Z",
     "epochLength": 500,

cardano-chain-gen/test/testfiles/config/genesis.json

@@ -2,7 +2,7 @@
     "maxLovelaceSupply": 60000000,
     "securityParam": 10,
     "slotsPerKESPeriod": 129600,
-    "updateQuorum": 5,
+    "updateQuorum": 2,
     "activeSlotsCoeff": 0.2,
     "protocolParams": {
         "minUTxOValue": 0,
@@ -43,7 +43,16 @@
     },
     "networkId": "Testnet",
     "maxKESEvolutions": 60,
-    "genDelegs": { },
+    "genDelegs": {
+        "30c3083efd794227fde2351a04500349d1b467556c30e35d6794a501": {
+            "delegate": "3af50e522694318e8856d34021140817aa21d47ff62a4d0ddcba1924",
+            "vrf": "2846ed605f6629976ec92e9e65140c1cb3a95c563c996592c926a2ae7e5a461f"
+        },
+        "471cc34983f6a2fd7b4018e3147532185d69a448d6570d46019e58e6": {
+            "delegate": "1683652d05e83e25eb648a9543db33cf8ff1f7a2af9129d3a901dd4a",
+            "vrf": "4df7c5a5b30469756bd09db60cbe9b0cf1b2447e0c41122d130768c179b7d166"
+        }
+    },
     "slotLength": 1,
     "systemStart": "2021-11-18T20:22:02Z",
     "epochLength": 500,