Test submission of a certificate multiple times in a transaction

cardano-testnet/cardano-testnet.cabal

@@ -173,6 +173,7 @@ test-suite cardano-testnet-test
                         Cardano.Testnet.Test.Cli.Babbage.Transaction
                         Cardano.Testnet.Test.Cli.Conway.DRepRetirement
                         Cardano.Testnet.Test.Cli.Conway.Plutus
+                        Cardano.Testnet.Test.Cli.Conway.RepeatedCertificatesInTransaction
                         Cardano.Testnet.Test.Cli.Conway.StakeSnapshot
                         Cardano.Testnet.Test.Cli.KesPeriodInfo
                         Cardano.Testnet.Test.Cli.Queries

cardano-testnet/src/Testnet/Components/SPO.hs

@@ -1,14 +1,16 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
 
 module Testnet.Components.SPO
   ( checkStakeKeyRegistered
-  , convertToEraFlag
   , createScriptStakeRegistrationCertificate
   , createStakeDelegationCertificate
   , createStakeKeyRegistrationCertificate
+  , createStakeKeyDeregistrationCertificate
   , decodeEraUTxO
   , registerSingleSpo
   ) where
@@ -115,12 +117,12 @@ createStakeDelegationCertificate
   -> String -- ^ Pool id
   -> FilePath
   -> m ()
-createStakeDelegationCertificate tempAbsP anyCera delegatorStakeVerKey poolId outputFp =
+createStakeDelegationCertificate tempAbsP (AnyCardanoEra cEra) delegatorStakeVerKey poolId outputFp =
   GHC.withFrozenCallStack $ do
     let tempAbsPath' = unTmpAbsPath tempAbsP
-    void $ execCli
-      [ "stake-address", "delegation-certificate"
-      , convertToEraFlag anyCera
+    execCli_
+      [ eraToString cEra
+      , "stake-address", "stake-delegation-certificate"
       , "--stake-verification-key-file", delegatorStakeVerKey
       , "--stake-pool-id", poolId
       , "--out-file", tempAbsPath' </> outputFp
@@ -131,44 +133,71 @@ createStakeKeyRegistrationCertificate
   => TmpAbsolutePath
   -> AnyCardanoEra
   -> FilePath -- ^ Stake verification key file
+  -> Int -- ^ deposit amount used only in Conway
   -> FilePath -- ^ Output file path
   -> m ()
-createStakeKeyRegistrationCertificate tempAbsP anyCEra stakeVerKey outputFp =
-  GHC.withFrozenCallStack $ do
-    let tempAbsPath' = unTmpAbsPath tempAbsP
-
-    void $ execCli
-      [ "stake-address", "registration-certificate"
-      , convertToEraFlag anyCEra
-      , "--stake-verification-key-file", stakeVerKey
-      , "--out-file", tempAbsPath' </> outputFp
-      ]
+createStakeKeyRegistrationCertificate tempAbsP (AnyCardanoEra cEra) stakeVerKey deposit outputFp = GHC.withFrozenCallStack $ do
+  sbe <- requireEon cEra
+  let tempAbsPath' = unTmpAbsPath tempAbsP
+      extraArgs = caseShelleyToBabbageOrConwayEraOnwards
+                    (const [])
+                    (const ["--key-reg-deposit-amt", show deposit])
+                    sbe
+  execCli_ $
+    [ eraToString cEra
+    , "stake-address", "registration-certificate"
+    , "--stake-verification-key-file", stakeVerKey
+    , "--out-file", tempAbsPath' </> outputFp
+    ]
+    <> extraArgs
 
 createScriptStakeRegistrationCertificate
   :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
   => TmpAbsolutePath
   -> AnyCardanoEra
   -> FilePath -- ^ Script file
-  -> Int -- ^ Registration deposit amount
+  -> Int -- ^ Registration deposit amount used only in Conway
   -> FilePath -- ^ Output file path
   -> m ()
-createScriptStakeRegistrationCertificate tempAbsP anyCEra scriptFile deposit outputFp =
+createScriptStakeRegistrationCertificate tempAbsP (AnyCardanoEra cEra) scriptFile deposit outputFp =
   GHC.withFrozenCallStack $ do
+    sbe <- requireEon cEra
     let tempAbsPath' = unTmpAbsPath tempAbsP
-
-    void $ execCli
-      [ anyEraToString anyCEra
+        extraArgs = caseShelleyToBabbageOrConwayEraOnwards
+                      (const [])
+                      (const ["--key-reg-deposit-amt", show deposit])
+                      sbe
+    execCli_ $
+      [ eraToString cEra
       , "stake-address", "registration-certificate"
       , "--stake-script-file", scriptFile
-      , "--key-reg-deposit-amt", show deposit
       , "--out-file", tempAbsPath' </> outputFp
       ]
+      <> extraArgs
 
-
--- TODO: Remove me and replace with new era based commands
--- i.e "conway", "babbage" etc
-convertToEraFlag :: AnyCardanoEra -> String
-convertToEraFlag era = "--" <> anyEraToString era  <> "-era"
+createStakeKeyDeregistrationCertificate
+  :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
+  => TmpAbsolutePath
+  -> AnyCardanoEra
+  -> FilePath -- ^ Stake verification key file
+  -> Int -- ^ deposit amount used only in Conway
+  -> FilePath -- ^ Output file path
+  -> m ()
+createStakeKeyDeregistrationCertificate tempAbsP (AnyCardanoEra cEra) stakeVerKey deposit outputFp =
+  GHC.withFrozenCallStack $ do
+    sbe <- requireEon cEra
+    let tempAbsPath' = unTmpAbsPath tempAbsP
+        extraArgs = caseShelleyToBabbageOrConwayEraOnwards
+                      (const [])
+                      (const ["--key-reg-deposit-amt", show deposit])
+                      sbe
+    execCli_ $
+      [ eraToString cEra
+      , "stake-address" , "deregistration-certificate"
+      , "--stake-verification-key-file", stakeVerKey
+      , "--out-file", tempAbsPath' </> outputFp
+      ]
+      <> extraArgs
 
 -- | Related documentation: https://github.com/input-output-hk/cardano-node-wiki/blob/main/docs/stake-pool-operations/8_register_stakepool.md
 registerSingleSpo
@@ -192,7 +221,6 @@ registerSingleSpo
 registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions execConfig
                   (fundingInput, fundingSigninKey, changeAddr) = GHC.withFrozenCallStack $ do
   let testnetMag = cardanoTestnetMagic cTestnetOptions
-      eraFlag= convertToEraFlag $ cardanoNodeEra cTestnetOptions
 
   workDir <- H.note tempAbsPath'
 
@@ -251,11 +279,12 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions
 
   -- 5. Create registration certificate
   let poolRegCertFp = spoReqDir </> "registration.cert"
+  let era = cardanoNodeEra cTestnetOptions
 
   -- The pledge, pool cost and pool margin can all be 0
   execCli_
-    [ "stake-pool", "registration-certificate"
-    , "--babbage-era"
+    [ anyEraToString era
+    , "stake-pool", "registration-certificate"
     , "--testnet-magic", show @Int testnetMag
     , "--pool-pledge", "0"
     , "--pool-cost", "0"
@@ -272,15 +301,14 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions
 
   -- Create pledger registration certificate
 
-  createStakeKeyRegistrationCertificate
-    tap
-    (cardanoNodeEra cTestnetOptions)
+  createStakeKeyRegistrationCertificate tap era
     poolOwnerstakeVkeyFp
+    2_000_000
     (workDir </> "pledger.regcert")
 
   void $ execCli' execConfig
-    [ "transaction", "build"
-    , eraFlag
+    [ anyEraToString era
+    , "transaction", "build"
     , "--change-address", changeAddr
     , "--tx-in", Text.unpack $ renderTxIn fundingInput
     , "--tx-out", poolowneraddresswstakecred <> "+" <> show @Int 5_000_000
@@ -310,7 +338,7 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions
            ]
   -- TODO: Currently we can't propagate the error message thrown by checkStakeKeyRegistered when using byDurationM
   -- Instead we wait 15 seconds
-  threadDelay 15_000000
+  threadDelay 15_000_000
   -- Check the pledger/owner stake key was registered
   delegsAndRewards <-
     checkStakeKeyRegistered
@@ -331,4 +359,3 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions
               poolColdVkeyFp
               currentRegistedPoolsJson
   return (poolId, poolColdSkeyFp, poolColdVkeyFp, vrfSkeyFp, vrfVkeyFp)
-

cardano-testnet/src/Testnet/Property/Utils.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Testnet.Property.Utils
   ( integration
@@ -19,6 +20,7 @@ module Testnet.Property.Utils
   , getShelleyGenesisHash
 
   , decodeEraUTxO
+  , requireEon
   ) where
 
 import           Cardano.Api
@@ -36,6 +38,7 @@ import           Data.Aeson.Key
 import           Data.Aeson.KeyMap hiding (map)
 import qualified Data.ByteString as BS
 import           Data.Text (Text)
+import           Data.Typeable
 import           Data.Word
 import           GHC.Stack
 import qualified GHC.Stack as GHC
@@ -44,6 +47,8 @@ import qualified System.Environment as IO
 import           System.Info (os)
 import qualified System.IO.Unsafe as IO
 
+import           Testnet.Start.Types
+
 import qualified Hedgehog as H
 import qualified Hedgehog.Extras as H
 import           Hedgehog.Internal.Property (MonadTest)
@@ -122,3 +127,18 @@ runInBackground act = void . H.evalM $ allocate (H.async act) cleanUp
 
 decodeEraUTxO :: (IsShelleyBasedEra era, MonadTest m) => ShelleyBasedEra era -> Aeson.Value -> m (UTxO era)
 decodeEraUTxO _ = H.jsonErrorFail . Aeson.fromJSON
+
+
+requireEon :: forall eon era m. Eon eon
+           => HasCallStack
+           => Typeable (eon era)
+           => MonadTest m
+           => CardanoEra era -- ^ node era
+           -> m (eon era)
+requireEon era = withFrozenCallStack $
+  maybe
+    (H.note_ errorMessage >> H.failure)
+    pure
+    (forEraMaybeEon era)
+  where
+    errorMessage = "Cannot witness '" <> show (typeRep (Proxy @(eon era)))  <> "' in " <> eraToString era <> " era."

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/LeadershipSchedule.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DisambiguateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
@@ -135,6 +134,7 @@ hprop_leadershipSchedule = H.integrationRetryWorkspace 2 "babbage-leadership-sch
     tempAbsPath
     (cardanoNodeEra cTestnetOptions)
     testDelegatorVkeyFp
+    2_000_000
     testDelegatorRegCertFp
 
   -- Test stake address deleg  cert
@@ -161,12 +161,12 @@ hprop_leadershipSchedule = H.integrationRetryWorkspace 2 "babbage-leadership-sch
   UTxO utxo2 <- H.noteShowM $ decodeEraUTxO sbe utxo2Json
   txin2 <- H.noteShow =<< H.headM (Map.keys utxo2)
 
-  let eraFlag = convertToEraFlag $ cardanoNodeEra cTestnetOptions
+  let eraString = anyEraToString $ cardanoNodeEra cTestnetOptions
       delegRegTestDelegatorTxBodyFp = work </> "deleg-register-test-delegator.txbody"
 
   void $ execCli' execConfig
-    [ "transaction", "build"
-    , eraFlag
+    [ eraString
+    , "transaction", "build"
     , "--change-address", testDelegatorPaymentAddr -- NB: A large balance ends up at our test delegator's address
     , "--tx-in", Text.unpack $ renderTxIn txin2
     , "--tx-out", utxoAddr <> "+" <> show @Int 5_000_000

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/Transaction.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DisambiguateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/DRepRetirement.hs

@@ -7,12 +7,6 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
-#if __GLASGOW_HASKELL__ >= 908
-{-# OPTIONS_GHC -Wno-x-partial #-}
-#endif
-
-{- HLINT ignore "Use head" -}
-
 module Cardano.Testnet.Test.Cli.Conway.DRepRetirement
   ( hprop_drep_retirement
   ) where
@@ -64,7 +58,7 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
   TestnetRuntime
     { testnetMagic
     , poolNodes
-    , wallets
+    , wallets=wallet0:_
     , configurationFile
     }
     <- cardanoTestnetDefault fastTestnetOptions conf
@@ -111,7 +105,7 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
        , "--out-file", drepCertFile n
        ]
 
-  txin1 <- findLargestUtxoForPaymentKey epochStateView sbe $ wallets !! 0
+  txin1 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0
 
   -- Submit registration certificates
   drepRegTxbodyFp <- H.note $ work </> "drep.registration.txbody"
@@ -120,7 +114,7 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
   H.noteM_ $ H.execCli' execConfig
     [ "conway", "transaction", "build"
     , "--tx-in", Text.unpack $ renderTxIn txin1
-    , "--change-address", Text.unpack $ paymentKeyInfoAddr $ wallets !! 0
+    , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet0
     , "--certificate-file", drepCertFile 1
     , "--certificate-file", drepCertFile 2
     , "--certificate-file", drepCertFile 3
@@ -131,7 +125,7 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
   H.noteM_ $ H.execCli' execConfig
     [ "conway", "transaction", "sign"
     , "--tx-body-file", drepRegTxbodyFp
-    , "--signing-key-file", paymentSKey $ paymentKeyInfoPair $ wallets !! 0
+    , "--signing-key-file", paymentSKey $ paymentKeyInfoPair wallet0
     , "--signing-key-file", drepSKeyFp 1
     , "--signing-key-file", drepSKeyFp 2
     , "--signing-key-file", drepSKeyFp 3
@@ -161,20 +155,20 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
 
   H.noteM_ $ H.execCli' execConfig
     [ "conway", "query", "utxo"
-    , "--address", Text.unpack $ paymentKeyInfoAddr $ wallets !! 0
+    , "--address", Text.unpack $ paymentKeyInfoAddr wallet0
     , "--cardano-mode"
     , "--out-file", work </> "utxo-11.json"
     ]
 
-  txin2 <- findLargestUtxoForPaymentKey epochStateView sbe $ wallets !! 0
+  txin2 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0
 
   drepRetirementRegTxbodyFp <- H.note $ work </> "drep.retirement.txbody"
   drepRetirementRegTxSignedFp <- H.note $ work </> "drep.retirement.tx"
 
   H.noteM_ $ H.execCli' execConfig
     [ "conway", "transaction", "build"
     , "--tx-in", Text.unpack $ renderTxIn txin2
-    , "--change-address", Text.unpack $ paymentKeyInfoAddr $ wallets !! 0
+    , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet0
     , "--certificate-file", dreprRetirementCertFile
     , "--witness-override", "2"
     , "--out-file", drepRetirementRegTxbodyFp
@@ -183,7 +177,7 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
   H.noteM_ $ H.execCli' execConfig
     [ "conway", "transaction", "sign"
     , "--tx-body-file", drepRetirementRegTxbodyFp
-    , "--signing-key-file", paymentSKey $ paymentKeyInfoPair $ wallets !! 0
+    , "--signing-key-file", paymentSKey $ paymentKeyInfoPair wallet0
     , "--signing-key-file", drepSKeyFp 1
     , "--out-file", drepRetirementRegTxSignedFp
     ]

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs

@@ -10,7 +10,6 @@
 {- HLINT ignore "Redundant id" -}
 {- HLINT ignore "Redundant return" -}
 {- HLINT ignore "Use head" -}
-{- HLINT ignore "Use let" -}
 
 module Cardano.Testnet.Test.Cli.Conway.Plutus
   ( hprop_plutus_v3