cardano-testnet: Test DRep retirement in an integration test

cardano-testnet/cardano-testnet.cabal

@@ -170,6 +170,7 @@ test-suite cardano-testnet-test
   other-modules:        Cardano.Testnet.Test.Cli.Babbage.LeadershipSchedule
                         Cardano.Testnet.Test.Cli.Babbage.StakeSnapshot
                         Cardano.Testnet.Test.Cli.Babbage.Transaction
+                        Cardano.Testnet.Test.Cli.Conway.DRepRetirement
                         Cardano.Testnet.Test.Cli.Conway.StakeSnapshot
                         Cardano.Testnet.Test.Cli.KesPeriodInfo
                         Cardano.Testnet.Test.Cli.QuerySlotNumber
@@ -210,6 +211,7 @@ test-suite cardano-testnet-test
                       , time
                       , transformers
                       , transformers-except
+                      , vector
 
   ghc-options:          -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T
 

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

@@ -0,0 +1,272 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Cardano.Testnet.Test.Cli.Conway.DRepRetirement
+  ( hprop_drep_retirement
+  ) where
+
+import           Cardano.Api
+
+import           Cardano.Testnet
+
+import           Prelude
+
+import           Control.Monad
+import qualified Data.Map.Strict as Map
+import qualified Data.Text as Text
+import           GHC.Stack (HasCallStack)
+import           System.FilePath ((</>))
+
+import           Hedgehog
+import qualified Hedgehog.Extras as H
+import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
+import qualified Testnet.Process.Cli as P
+import qualified Testnet.Process.Run as H
+
+import           Control.Concurrent (threadDelay)
+import           Control.Monad.IO.Class
+import qualified Data.Aeson as Aeson
+import           Data.Maybe (fromJust)
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TL
+import qualified Data.Vector as V
+import qualified Hedgehog as H
+import           Testnet.Components.SPO
+import qualified Testnet.Property.Utils as H
+import           Testnet.Runtime
+
+-- | The goal of this test is to check the property 'DRep Registration/DeRegistration', coming from this document:
+-- https://docs.google.com/document/d/1qS5Z7vTNZTlvP66sLuYyhGkjU4rAsO92urDHnEkvJMQ/edit?pli=1#heading=h.9pj6u2uc0i4q
+--
+-- Run this test alone with this command:
+-- 'DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/DRepRetirement/''
+hprop_drep_retirement :: Property
+hprop_drep_retirement = H.integrationRetryWorkspace 2 "propose-new-constitution" $ \tempAbsBasePath' -> do
+  -- Start a local test net
+  conf@Conf { tempAbsPath } <- H.noteShowM $ mkConf tempAbsBasePath'
+  let tempAbsPath' = unTmpAbsPath tempAbsPath
+      tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath
+
+  work <- H.createDirectoryIfMissing $ tempAbsPath' </> "work"
+
+  let sbe = ShelleyBasedEraConway
+      era = toCardanoEra sbe
+      cEra = AnyCardanoEra era
+      fastTestnetOptions = cardanoDefaultTestnetOptions
+        { cardanoEpochLength = 100 -- 100ms epoch
+        , cardanoSlotLength = 0.1  -- 1/10s slot (100ms)
+        , cardanoNodeEra = cEra
+        }
+
+  _testnetRuntime@TestnetRuntime
+    { testnetMagic
+    , poolNodes
+    , wallets
+    }
+    <- cardanoTestnet fastTestnetOptions conf
+
+  poolNode1 <- H.headM poolNodes
+
+  poolSprocket1 <- H.noteShow $ nodeSprocket $ poolRuntime poolNode1
+
+  execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1
+
+  let socketName' = IO.sprocketName poolSprocket1
+      socketBase = IO.sprocketBase poolSprocket1 -- /tmp
+      socketPath = socketBase </> socketName'
+
+  H.note_ $ "Sprocket: " <> show poolSprocket1
+  H.note_ $ "Abs path: " <> tempAbsBasePath'
+  H.note_ $ "Socketpath: " <> socketPath
+
+  -- Create Conway constitution
+  gov <- H.createDirectoryIfMissing $ work </> "governance"
+
+  let stakeVkeyFp = gov </> "stake.vkey"
+      stakeSKeyFp = gov </> "stake.skey"
+
+  _ <- P.cliStakeAddressKeyGen tempAbsPath'
+         $ P.KeyNames { P.verificationKeyFile = stakeVkeyFp
+                      , P.signingKeyFile = stakeSKeyFp
+                      }
+
+  let drepVkeyFp :: Int -> FilePath
+      drepVkeyFp n = gov </> "drep-keys" <>"drep" <> show n <> ".vkey"
+
+      drepSKeyFp :: Int -> FilePath
+      drepSKeyFp n = gov </> "drep-keys" <>"drep" <> show n <> ".skey"
+
+  -- Create DReps -- TODO: Refactor with shelleyKeyGen
+  forM_ [1..3] $ \n -> do
+   H.execCli' execConfig
+     [ "conway", "governance", "drep", "key-gen"
+     , "--verification-key-file", drepVkeyFp n
+     , "--signing-key-file", drepSKeyFp n
+     ]
+
+  -- Create Drep registration certificates
+  let drepCertFile :: Int -> FilePath
+      drepCertFile n = gov </> "drep-keys" <>"drep" <> show n <> ".regcert"
+  forM_ [1..3] $ \n -> do
+    H.execCli' execConfig
+       [ "conway", "governance", "drep", "registration-certificate"
+       , "--drep-verification-key-file", drepVkeyFp n
+       , "--key-reg-deposit-amt", show @Int 0
+       , "--out-file", drepCertFile n
+       ]
+
+  -- Retrieve UTxOs for registration submission
+  void $ H.execCli' execConfig
+    [ "conway", "query", "utxo"
+    , "--address", Text.unpack $ paymentKeyInfoAddr $ head wallets
+    , "--cardano-mode"
+    , "--testnet-magic", show @Int testnetMagic
+    , "--out-file", work </> "utxo-1.json"
+    ]
+
+  utxo1Json <- H.leftFailM . H.readJsonFile $ work </> "utxo-1.json"
+  UTxO utxo1 <- H.noteShowM $ H.noteShowM $ decodeEraUTxO sbe utxo1Json
+  txin1 <- H.noteShow =<< H.headM (Map.keys utxo1)
+
+  -- Submit registration certificates
+  drepRegTxbodyFp <- H.note $ work </> "drep.registration.txbody"
+  drepRegTxSignedFp <- H.note $ work </> "drep.registration.tx"
+
+  void $ H.execCli' execConfig
+    [ "conway", "transaction", "build"
+    , "--testnet-magic", show @Int testnetMagic
+    , "--change-address", Text.unpack $ paymentKeyInfoAddr $ head wallets
+    , "--tx-in", Text.unpack $ renderTxIn txin1
+    , "--tx-out", Text.unpack (paymentKeyInfoAddr (wallets !! 1)) <> "+" <> show @Int 5_000_000
+    , "--certificate-file", drepCertFile 1
+    , "--certificate-file", drepCertFile 2
+    , "--certificate-file", drepCertFile 3
+    , "--witness-override", show @Int 4
+    , "--out-file", drepRegTxbodyFp
+    ]
+
+  void $ H.execCli' execConfig
+    [ "conway", "transaction", "sign"
+    , "--testnet-magic", show @Int testnetMagic
+    , "--tx-body-file", drepRegTxbodyFp
+    , "--signing-key-file", paymentSKey $ paymentKeyInfoPair $ head wallets
+    , "--signing-key-file", drepSKeyFp 1
+    , "--signing-key-file", drepSKeyFp 2
+    , "--signing-key-file", drepSKeyFp 3
+    , "--out-file", drepRegTxSignedFp
+    ]
+
+  void $ H.execCli' execConfig
+    [ "conway", "transaction", "submit"
+    , "--testnet-magic", show @Int testnetMagic
+    , "--tx-file", drepRegTxSignedFp
+    ]
+
+  -- Record state after registrations
+  liftIO $ threadDelay (5 * 1_000_000) -- Wait 5 seconds
+
+  dRepState <- H.execCli' execConfig
+    [ "conway", "query", "drep-state"
+    , "--testnet-magic", show @Int testnetMagic
+    ]
+  let dRepStateJson :: Aeson.Value = fromJust . Aeson.decode $ TL.encodeUtf8 . TL.pack $ dRepState
+      sizeBefore = 3
+  assertIsAesonArray sizeBefore dRepStateJson
+
+  -- Deregister first DRep
+  let dreprRetirementCertFile = gov </> "drep-keys" <> "drep1.retirementcert"
+
+  void $ H.execCli' execConfig
+     [ "conway", "governance", "drep", "retirement-certificate"
+     , "--drep-verification-key-file", drepVkeyFp 1
+     , "--deposit-amt", show @Int 0
+     , "--out-file", dreprRetirementCertFile
+     ]
+
+  void $ H.execCli' execConfig
+     [ "conway", "governance", "drep", "retirement-certificate"
+     , "--drep-verification-key-file", drepVkeyFp 1
+     , "--deposit-amt", show @Int 0
+     , "--out-file", dreprRetirementCertFile
+     ]
+
+  void $ H.execCli' execConfig
+    [ "conway", "query", "utxo"
+    , "--address", Text.unpack $ paymentKeyInfoAddr $ head wallets
+    , "--cardano-mode"
+    , "--testnet-magic", show @Int testnetMagic
+    , "--out-file", work </> "utxo-11.json"
+    ]
+
+  utxo11Json <- H.leftFailM . H.readJsonFile $ work </> "utxo-11.json"
+  UTxO utxo11 <- H.noteShowM $ H.noteShowM $ decodeEraUTxO sbe utxo11Json
+  txin11 <- H.noteShow =<< H.headM (Map.keys utxo11)
+
+  drepRetirementRegTxbodyFp <- H.note $ work </> "drep.retirement.txbody"
+  drepRetirementRegTxSignedFp <- H.note $ work </> "drep.retirement.tx"
+
+  void $ H.execCli' execConfig
+    [ "conway", "transaction", "build"
+    , "--testnet-magic", show @Int testnetMagic
+    , "--change-address", Text.unpack $ paymentKeyInfoAddr $ head wallets
+    , "--tx-in", Text.unpack $ renderTxIn txin11
+    , "--certificate-file", dreprRetirementCertFile
+    , "--witness-override", "2"
+    , "--out-file", drepRetirementRegTxbodyFp
+    ]
+
+  void $ H.execCli' execConfig
+    [ "conway", "transaction", "sign"
+    , "--testnet-magic", show @Int testnetMagic
+    , "--tx-body-file", drepRetirementRegTxbodyFp
+    , "--signing-key-file", paymentSKey $ paymentKeyInfoPair $ head wallets
+    , "--signing-key-file", drepSKeyFp 1
+    , "--out-file", drepRetirementRegTxSignedFp
+    ]
+
+  void $ H.execCli' execConfig
+    [ "conway", "transaction", "submit"
+    , "--testnet-magic", show @Int testnetMagic
+    , "--tx-file", drepRetirementRegTxSignedFp
+    ]
+
+  -- Get state after deregistration
+  liftIO $ threadDelay (5 * 1_000_000) -- Wait 5 seconds
+
+  dRepState2 <- H.execCli' execConfig
+    [ "conway", "query", "drep-state"
+    , "--testnet-magic", show @Int testnetMagic
+    ]
+  let dRepState2Json :: Aeson.Value = fromJust . Aeson.decode $ TL.encodeUtf8 . TL.pack $ dRepState2
+
+  -- Check it's the list of DReps shrank by one
+  assertIsAesonArray (sizeBefore - 1) dRepState2Json
+
+
+-- | Assert that an @Aeson.Value@ value is an array, with the given size
+-- Fail otherwise.
+assertIsAesonArray
+  :: (MonadTest m, HasCallStack)
+  => Int -- ^ The expected length
+  -> Aeson.Value -- ^ The Aeson value to check for being an array of size @len@
+  -> m ()
+assertIsAesonArray len v =
+  case v of
+    Aeson.Object _ -> goError "Object"
+    Aeson.Array a | V.length a == len -> H.success
+    Aeson.Array a  -> do
+      H.note_ $
+        "Expected Aeson Array to be of size " <> show len
+          <> ", but size is " <> show (V.length a)
+      H.failure
+    Aeson.String _ -> goError "String"
+    Aeson.Number _ -> goError "Number"
+    Aeson.Bool _   -> goError "Bool"
+    Aeson.Null     -> goError "Null"
+  where
+    goError got = do
+      H.note_ $ "Expected an Aeson Array, got a " <> got <> " instead"
+      H.failure

cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs

@@ -8,6 +8,7 @@ import qualified Cardano.Crypto.Init as Crypto
 import qualified Cardano.Testnet.Test.Cli.Babbage.LeadershipSchedule
 import qualified Cardano.Testnet.Test.Cli.Babbage.StakeSnapshot
 import qualified Cardano.Testnet.Test.Cli.Babbage.Transaction
+import qualified Cardano.Testnet.Test.Cli.Conway.DRepRetirement as DRepRetirement
 import qualified Cardano.Testnet.Test.Cli.KesPeriodInfo
 import qualified Cardano.Testnet.Test.Cli.QuerySlotNumber
 import qualified Cardano.Testnet.Test.FoldBlocks
@@ -35,6 +36,7 @@ tests = pure $ T.testGroup "test/Spec.hs"
           , T.testGroup "Governance"
             -- [ H.ignoreOnMacAndWindows "ProposeAndRatifyNewConstitution" LedgerEvents.hprop_ledger_events_propose_new_constitution
             [ H.ignoreOnWindows "InfoAction" LedgerEvents.hprop_ledger_events_info_action
+            , H.ignoreOnWindows "DRepRetirement" DRepRetirement.hprop_drep_retirement
             ]
           ]
       , T.testGroup "CLI"