Merge pull request #5733 from IntersectMBO/mgalazyn/refactor/testnet-…

…spo-functions

Refactor testnet SPO certificates functions

cardano-node/test/Test/Cardano/Node/Gen.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}

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,62 @@ 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
+  let tempAbsPath' = unTmpAbsPath tempAbsP
+      extraArgs = monoidForEraInEon @ConwayEraOnwards cEra $
+        const ["--key-reg-deposit-amt", show deposit]
+  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
     let tempAbsPath' = unTmpAbsPath tempAbsP
-
-    void $ execCli
-      [ anyEraToString anyCEra
+        extraArgs = monoidForEraInEon @ConwayEraOnwards cEra $
+          const ["--key-reg-deposit-amt", show deposit]
+    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
+    let tempAbsPath' = unTmpAbsPath tempAbsP
+        extraArgs = monoidForEraInEon @ConwayEraOnwards cEra $
+          const ["--key-reg-deposit-amt", show deposit]
+    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 +212,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 +270,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 +292,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 +329,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 +350,3 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions
               poolColdVkeyFp
               currentRegistedPoolsJson
   return (poolId, poolColdSkeyFp, poolColdVkeyFp, vrfSkeyFp, vrfVkeyFp)
-

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

@@ -122,3 +122,4 @@ 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
+

cardano-testnet/src/Testnet/Start/Cardano.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}

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

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -7,12 +6,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 +57,7 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
   TestnetRuntime
     { testnetMagic
     , poolNodes
-    , wallets
+    , wallets=wallet0:_
     , configurationFile
     }
     <- cardanoTestnetDefault fastTestnetOptions conf
@@ -111,7 +104,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 +113,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 +124,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 +154,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 +176,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

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

@@ -3,8 +3,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
 module Cardano.Testnet.Test.Cli.Conway.StakeSnapshot
   ( hprop_stakeSnapshot
   ) where

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DisambiguateRecordFields #-}
 {-# LANGUAGE GADTs #-}
@@ -127,6 +126,7 @@ hprop_kes_period_info = H.integrationRetryWorkspace 2 "kes-period-info" $ \tempA
     tempAbsPath
     (cardanoNodeEra cTestnetOptions)
     testDelegatorVkeyFp
+    2_000_000
     testDelegatorRegCertFp
 
   -- Test stake address deleg  cert
@@ -153,12 +153,12 @@ hprop_kes_period_info = H.integrationRetryWorkspace 2 "kes-period-info" $ \tempA
   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