From 6e4a5ee6b312c3aa9f32a65fc5d45ccf167e3882 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Tue, 7 May 2024 15:46:02 +0200 Subject: [PATCH] Refactor: more --- .../src/Testnet/Components/DReps.hs | 120 ++++++++++++------ cardano-testnet/src/Testnet/Components/SPO.hs | 6 +- cardano-testnet/src/Testnet/Start/Cardano.hs | 48 ++++--- cardano-testnet/src/Testnet/Types.hs | 13 +- 4 files changed, 122 insertions(+), 65 deletions(-) diff --git a/cardano-testnet/src/Testnet/Components/DReps.hs b/cardano-testnet/src/Testnet/Components/DReps.hs index d67191059f8..7e8d37e9c56 100644 --- a/cardano-testnet/src/Testnet/Components/DReps.hs +++ b/cardano-testnet/src/Testnet/Components/DReps.hs @@ -37,8 +37,7 @@ import Data.Text (Text) import qualified Data.Text as Text import Data.Word (Word32) import GHC.IO.Exception (ExitCode (..)) -import GHC.Stack (HasCallStack) -import qualified GHC.Stack as GHC +import GHC.Stack import Lens.Micro ((^?)) import System.FilePath (()) @@ -47,9 +46,7 @@ import Testnet.Components.Query (EpochStateView, findLargestUtxoForPay import qualified Testnet.Process.Cli as H import qualified Testnet.Process.Run as H import Testnet.Start.Types (anyEraToString) -import Testnet.Types (KeyPair (..), - PaymentKeyInfo (paymentKeyInfoAddr, paymentKeyInfoPair), PaymentKeyPair (..), - SomeKeyPair (..), StakingKeyPair (..)) +import Testnet.Types import Hedgehog (MonadTest, evalMaybe) import qualified Hedgehog.Extras as H @@ -58,19 +55,23 @@ import qualified Hedgehog.Extras as H -- -- Returns the generated 'PaymentKeyPair' containing paths to the verification and -- signing key files. -generateDRepKeyPair :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) +generateDRepKeyPair + :: MonadTest m + => MonadCatch m + => MonadIO m + => HasCallStack => H.ExecConfig -- ^ Specifies the CLI execution configuration. -> FilePath -- ^ Base directory path where keys will be stored. -> String -- ^ Name for the subfolder that will be created under 'work' folder to store the output keys. - -> m PaymentKeyPair + -> m (KeyPair PaymentKey) generateDRepKeyPair execConfig work prefix = do baseDir <- H.createDirectoryIfMissing $ work prefix - let dRepKeyPair = PaymentKeyPair { paymentVKey = baseDir "verification.vkey" - , paymentSKey = baseDir "signature.skey" - } + let dRepKeyPair = KeyPair { verificationKey = File $ baseDir "verification.vkey" + , signingKey = File $ baseDir "signature.skey" + } void $ H.execCli' execConfig [ "conway", "governance", "drep", "key-gen" - , "--verification-key-file", paymentVKey dRepKeyPair - , "--signing-key-file", paymentSKey dRepKeyPair + , "--verification-key-file", unFile $ verificationKey dRepKeyPair + , "--signing-key-file", unFile $ signingKey dRepKeyPair ] return dRepKeyPair @@ -84,11 +85,14 @@ data Certificate -- Returns the generated @File DRepRegistrationCertificate In@ file path to the -- registration certificate. generateRegistrationCertificate - :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) + :: MonadTest m + => MonadCatch m + => MonadIO m + => HasCallStack => H.ExecConfig -- ^ Specifies the CLI execution configuration. -> FilePath -- ^ Base directory path where the certificate file will be stored. -> String -- ^ Prefix for the output certificate file name. The extension will be @.regcert@. - -> PaymentKeyPair -- ^ Payment key pair associated with the DRep. Can be generated using + -> KeyPair PaymentKey -- ^ Payment key pair associated with the DRep. Can be generated using -- 'generateDRepKeyPair'. -> Integer -- ^ Deposit amount required for DRep registration. The right amount -- can be obtained using 'getMinDRepDeposit'. @@ -96,7 +100,7 @@ generateRegistrationCertificate generateRegistrationCertificate execConfig work prefix drepKeyPair depositAmount = do let dRepRegistrationCertificate = File (work prefix <> ".regcert") void $ H.execCli' execConfig [ "conway", "governance", "drep", "registration-certificate" - , "--drep-verification-key-file", paymentVKey drepKeyPair + , "--drep-verification-key-file", unFile $ verificationKey drepKeyPair , "--key-reg-deposit-amt", show @Integer depositAmount , "--out-file", unFile dRepRegistrationCertificate ] @@ -110,7 +114,10 @@ data TxBody -- -- Returns the generated @File TxBody In@ file path to the transaction body. createCertificatePublicationTxBody - :: (H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m) + :: H.MonadAssertion m + => MonadTest m + => MonadCatch m + => MonadIO m => H.ExecConfig -- ^ Specifies the CLI execution configuration. -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained -- using the 'getEpochStateView' function. @@ -142,7 +149,10 @@ data VoteFile -- -- Returns a list of generated @File VoteFile In@ representing the paths to -- the generated voting files. -generateVoteFiles :: (MonadTest m, MonadIO m, MonadCatch m) +generateVoteFiles + :: MonadTest m + => MonadIO m + => MonadCatch m => H.ExecConfig -- ^ Specifies the CLI execution configuration. -> FilePath -- ^ Base directory path where the voting files and directories will be -- stored. @@ -150,7 +160,7 @@ generateVoteFiles :: (MonadTest m, MonadIO m, MonadCatch m) -- the output voting files. -> String -- ^ Transaction ID string of the governance action. -> Word32 -- ^ Index of the governance action. - -> [(PaymentKeyPair, [Char])] -- ^ List of tuples where each tuple contains a 'PaymentKeyPair' + -> [(KeyPair PaymentKey, [Char])] -- ^ List of tuples where each tuple contains a 'PaymentKeyPair' -- representing the DRep key pair and a 'String' representing the -- vote type (i.e: "yes", "no", or "abstain"). -> m [File VoteFile In] @@ -163,7 +173,7 @@ generateVoteFiles execConfig work prefix governanceActionTxId governanceActionIn , "--" ++ vote , "--governance-action-tx-id", governanceActionTxId , "--governance-action-index", show @Word32 governanceActionIndex - , "--drep-verification-key-file", paymentVKey drepKeyPair + , "--drep-verification-key-file", unFile (verificationKey drepKeyPair) , "--out-file", unFile path ] return path @@ -176,7 +186,10 @@ generateVoteFiles execConfig work prefix governanceActionTxId governanceActionIn -- -- Returns the generated @File TxBody In@ file path to the transaction body. createVotingTxBody - :: (H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m) + :: H.MonadAssertion m + => MonadTest m + => MonadCatch m + => MonadIO m => H.ExecConfig -- ^ Specifies the CLI execution configuration. -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained -- using the 'getEpochStateView' function. @@ -210,27 +223,33 @@ data SignedTx -- This function takes five parameters: -- -- Returns the generated @File SignedTx In@ file path to the signed transaction file. -signTx :: (MonadTest m, MonadCatch m, MonadIO m, KeyPair k) +signTx + :: MonadTest m + => MonadCatch m + => MonadIO m => H.ExecConfig -- ^ Specifies the CLI execution configuration. -> AnyCardanoEra -- ^ Specifies the current Cardano era. -> FilePath -- ^ Base directory path where the signed transaction file will be stored. -> String -- ^ Prefix for the output signed transaction file name. The extension will be @.tx@. -> File TxBody In -- ^ Transaction body to be signed, obtained using 'createCertificatePublicationTxBody' or similar. - -> [k] -- ^ List of payment key pairs used for signing the transaction. + -> [SomeKeyPair] -- ^ List of payment key pairs used for signing the transaction. -> m (File SignedTx In) signTx execConfig cEra work prefix txBody signatoryKeyPairs = do let signedTx = File (work prefix <> ".tx") void $ H.execCli' execConfig $ [ anyEraToString cEra, "transaction", "sign" , "--tx-body-file", unFile txBody - ] ++ (concat [["--signing-key-file", secretKey kp] | kp <- signatoryKeyPairs]) ++ + ] ++ (concat [["--signing-key-file", unFile . signingKey $ kp] | SomeKeyPair kp <- signatoryKeyPairs]) ++ [ "--out-file", unFile signedTx ] return signedTx -- | Submits a signed transaction using @cardano-cli@. submitTx - :: (MonadTest m, MonadCatch m, MonadIO m) + :: HasCallStack + => MonadTest m + => MonadCatch m + => MonadIO m => H.ExecConfig -- ^ Specifies the CLI execution configuration. -> AnyCardanoEra -- ^ Specifies the current Cardano era. -> File SignedTx In -- ^ Signed transaction to be submitted, obtained using 'signTx'. @@ -247,23 +266,26 @@ submitTx execConfig cEra signedTx = -- If the submission succeeds unexpectedly, it raises a failure message that is -- meant to be caught by @Hedgehog@. failToSubmitTx - :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) + :: MonadTest m + => MonadCatch m + => MonadIO m + => HasCallStack => H.ExecConfig -- ^ Specifies the CLI execution configuration. -> AnyCardanoEra -- ^ Specifies the current Cardano era. -> File SignedTx In -- ^ Signed transaction to be submitted, obtained using 'signTx'. -> String -- ^ Substring of the error to check for to ensure submission failed for -- the right reason. -> m () -failToSubmitTx execConfig cEra signedTx reasonForFailure = GHC.withFrozenCallStack $ do +failToSubmitTx execConfig cEra signedTx reasonForFailure = withFrozenCallStack $ do (exitCode, _, stderr) <- H.execFlexAny' execConfig "cardano-cli" "CARDANO_CLI" [ anyEraToString cEra, "transaction", "submit" , "--tx-file", unFile signedTx ] case exitCode of -- Did it fail? - ExitSuccess -> H.failMessage GHC.callStack "Transaction submission was expected to fail but it succeeded" + ExitSuccess -> H.failMessage callStack "Transaction submission was expected to fail but it succeeded" _ -> if reasonForFailure `isInfixOf` stderr -- Did it fail for the expected reason? then return () - else H.failMessage GHC.callStack $ "Transaction submission failed for the wrong reason (not " ++ + else H.failMessage callStack $ "Transaction submission failed for the wrong reason (not " ++ show reasonForFailure ++ "): " ++ stderr -- | Retrieves the transaction ID (governance action ID) from a signed @@ -271,7 +293,10 @@ failToSubmitTx execConfig cEra signedTx reasonForFailure = GHC.withFrozenCallSta -- -- Returns the transaction ID (governance action ID) as a 'String'. retrieveTransactionId - :: (MonadTest m, MonadCatch m, MonadIO m) + :: HasCallStack + => MonadTest m + => MonadCatch m + => MonadIO m => H.ExecConfig -- ^ Specifies the CLI execution configuration. -> File SignedTx In -- ^ Signed transaction to be submitted, obtained using 'signTx'. -> m String @@ -286,7 +311,12 @@ retrieveTransactionId execConfig signedTxBody = do -- generating a fresh key pair in the process. -- -- Returns the key pair for the DRep as a 'PaymentKeyPair'. -registerDRep :: (MonadCatch m, MonadIO m, MonadTest m, H.MonadAssertion m) +registerDRep + :: HasCallStack + => MonadCatch m + => MonadIO m + => MonadTest m + => H.MonadAssertion m => H.ExecConfig -- ^ Specifies the CLI execution configuration. -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained -- using the 'getEpochStateView' function. @@ -295,7 +325,7 @@ registerDRep :: (MonadCatch m, MonadIO m, MonadTest m, H.MonadAssertion m) -> FilePath -- ^ Name for the subfolder that will be created under 'work' folder to store the output keys. -> PaymentKeyInfo -- ^ Payment key information associated with the transaction, -- as returned by 'cardanoTestnetDefault'. - -> m PaymentKeyPair + -> m (KeyPair PaymentKey) registerDRep execConfig epochStateView ceo work prefix wallet = do let sbe = conwayEraOnwardsToShelleyBasedEra ceo era = toCardanoEra sbe @@ -310,7 +340,7 @@ registerDRep execConfig epochStateView ceo work prefix wallet = do drepRegTxBody <- createCertificatePublicationTxBody execConfig epochStateView sbe baseDir "reg-cert-txbody" drepRegCert wallet drepSignedRegTx <- signTx execConfig cEra baseDir "signed-reg-tx" - drepRegTxBody [drepKeyPair, paymentKeyInfoPair wallet] + drepRegTxBody [SomeKeyPair drepKeyPair, SomeKeyPair $ paymentKeyInfoPair wallet] submitTx execConfig cEra drepSignedRegTx return drepKeyPair @@ -318,7 +348,11 @@ registerDRep execConfig epochStateView ceo work prefix wallet = do -- | Delegate to a Delegate Representative (DRep) by creating and submitting -- a vote delegation certificate transaction using @cardano-cli@. delegateToDRep - :: (MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m) + :: HasCallStack + => MonadTest m + => MonadIO m + => H.MonadAssertion m + => MonadCatch m => H.ExecConfig -- ^ Specifies the CLI execution configuration. -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained -> FilePath -- ^ Path to the node configuration file as returned by 'cardanoTestnetDefault'. @@ -327,12 +361,12 @@ delegateToDRep -> FilePath -- ^ Base directory path where generated files will be stored. -> String -- ^ Name for the subfolder that will be created under 'work' folder. -> PaymentKeyInfo -- ^ Wallet that will pay for the transaction. - -> StakingKeyPair -- ^ Staking key pair used for delegation. - -> PaymentKeyPair -- ^ Delegate Representative (DRep) key pair ('PaymentKeyPair') to which delegate. + -> KeyPair StakingKey -- ^ Staking key pair used for delegation. + -> KeyPair PaymentKey -- ^ Delegate Representative (DRep) key pair ('PaymentKeyPair') to which delegate. -> m () -delegateToDRep execConfig epochStateView configurationFile socketPath sbe work prefix - payingWallet skeyPair@(StakingKeyPair vKeyFile _sKeyFile) - (PaymentKeyPair drepVKey _drepSKey) = do +delegateToDRep execConfig epochStateView configurationFile' socketPath sbe work prefix + payingWallet skeyPair@KeyPair{verificationKey=File vKeyFile} + KeyPair{verificationKey=File drepVKey} = do let era = toCardanoEra sbe cEra = AnyCardanoEra era @@ -354,7 +388,7 @@ delegateToDRep execConfig epochStateView configurationFile socketPath sbe work p -- Sign transaction repRegSignedRegTx1 <- signTx execConfig cEra baseDir "signed-reg-tx" - repRegTxBody1 [ SomeKeyPair (paymentKeyInfoPair payingWallet) + repRegTxBody1 [ SomeKeyPair $ paymentKeyInfoPair payingWallet , SomeKeyPair skeyPair] -- Submit transaction @@ -362,7 +396,7 @@ delegateToDRep execConfig epochStateView configurationFile socketPath sbe work p -- Wait two epochs (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView - void $ waitUntilEpoch (File configurationFile) (File socketPath) (EpochNo (epochAfterProp + 2)) + void $ waitUntilEpoch (File configurationFile') (File socketPath) (EpochNo (epochAfterProp + 2)) -- | This function obtains the identifier for the last enacted parameter update proposal -- if any. @@ -370,7 +404,11 @@ delegateToDRep execConfig epochStateView configurationFile socketPath sbe work p -- If no previous proposal was enacted, the function returns 'Nothing'. -- If there was a previous enacted proposal, the function returns a tuple with its transaction -- identifier (as a 'String') and the action index (as a 'Word32'). -getLastPParamUpdateActionId :: (MonadTest m, MonadCatch m, MonadIO m) +getLastPParamUpdateActionId + :: HasCallStack + => MonadTest m + => MonadCatch m + => MonadIO m => H.ExecConfig -- ^ Specifies the CLI execution configuration. -> m (Maybe (String, Word32)) getLastPParamUpdateActionId execConfig = do diff --git a/cardano-testnet/src/Testnet/Components/SPO.hs b/cardano-testnet/src/Testnet/Components/SPO.hs index 22379b42a9c..9aac71fed19 100644 --- a/cardano-testnet/src/Testnet/Components/SPO.hs +++ b/cardano-testnet/src/Testnet/Components/SPO.hs @@ -41,12 +41,12 @@ import System.FilePath.Posix (()) import Testnet.Components.DReps (VoteFile) import Testnet.Filepath -import Testnet.Process.Cli hiding (File, unFile) +import Testnet.Process.Cli import qualified Testnet.Process.Run as H import Testnet.Process.Run (execCli, execCli', execCli_) import Testnet.Property.Utils import Testnet.Start.Types -import Testnet.Types (PoolNodeKeys (poolNodeKeysColdVkey)) +import Testnet.Types import Hedgehog import Hedgehog.Extras (ExecConfig) @@ -433,7 +433,7 @@ generateVoteFiles ceo execConfig work prefix governanceActionTxId governanceActi , "--" ++ vote , "--governance-action-tx-id", governanceActionTxId , "--governance-action-index", show @Word32 governanceActionIndex - , "--cold-verification-key-file", poolNodeKeysColdVkey spoKeys + , "--cold-verification-key-file", verificationKeyFp $ poolNodeKeysCold spoKeys , "--out-file", unFile path ] return path diff --git a/cardano-testnet/src/Testnet/Start/Cardano.hs b/cardano-testnet/src/Testnet/Start/Cardano.hs index 237db9dd7b6..b2f8ae34c16 100644 --- a/cardano-testnet/src/Testnet/Start/Cardano.hs +++ b/cardano-testnet/src/Testnet/Start/Cardano.hs @@ -12,7 +12,6 @@ module Testnet.Start.Cardano , cardanoDefaultTestnetNodeOptions , TestnetRuntime (..) - , PaymentKeyPair(..) , cardanoTestnet , cardanoTestnetDefault @@ -276,12 +275,21 @@ cardanoTestnet poolKeys <- H.noteShow $ flip fmap [1..numPoolNodes] $ \n -> PoolNodeKeys - { poolNodeKeysColdVkey = tmpAbsPath "pools" "cold" <> show n <> ".vkey" - , poolNodeKeysColdSkey = tmpAbsPath "pools" "cold" <> show n <> ".skey" - , poolNodeKeysVrfVkey = tmpAbsPath "pools" "vrf" <> show n <> ".vkey" - , poolNodeKeysVrfSkey = tmpAbsPath "pools" "vrf" <> show n <> ".skey" - , poolNodeKeysStakingVkey = tmpAbsPath "pools" "staking-reward" <> show n <> ".vkey" - , poolNodeKeysStakingSkey = tmpAbsPath "pools" "staking-reward" <> show n <> ".skey" + { poolNodeKeysCold = + KeyPair + { verificationKey = File $ tmpAbsPath "pools" "cold" <> show n <> ".vkey" + , signingKey = File $ tmpAbsPath "pools" "cold" <> show n <> ".skey" + } + , poolNodeKeysVrf = + KeyPair + { verificationKey = File $ tmpAbsPath "pools" "vrf" <> show n <> ".vkey" + , signingKey = File $ tmpAbsPath "pools" "vrf" <> show n <> ".skey" + } + , poolNodeKeysStaking = + KeyPair + { verificationKey = File $ tmpAbsPath "pools" "staking-reward" <> show n <> ".vkey" + , signingKey = File $ tmpAbsPath "pools" "staking-reward" <> show n <> ".skey" + } } let makeUTxOVKeyFp :: Int -> FilePath makeUTxOVKeyFp n = tmpAbsPath "utxo-keys" "utxo" <> show n "utxo.vkey" @@ -304,22 +312,22 @@ cardanoTestnet paymentAddr <- H.readFile paymentAddrFile pure $ PaymentKeyInfo - { paymentKeyInfoPair = PaymentKeyPair - { paymentSKey = paymentSKeyFile - , paymentVKey = paymentVKeyFile + { paymentKeyInfoPair = KeyPair + { signingKey = File paymentSKeyFile + , verificationKey = File paymentVKeyFile } , paymentKeyInfoAddr = Text.pack paymentAddr } _delegators <- forM [1..3] $ \(idx :: Int) -> do pure $ Delegator - { paymentKeyPair = PaymentKeyPair - { paymentSKey = tmpAbsPath "stake-delegator-keys/payment" <> show idx <> ".skey" - , paymentVKey = tmpAbsPath "stake-delegator-keys/payment" <> show idx <> ".vkey" + { paymentKeyPair = KeyPair + { signingKey = File $ tmpAbsPath "stake-delegator-keys/payment" <> show idx <> ".skey" + , verificationKey = File $ tmpAbsPath "stake-delegator-keys/payment" <> show idx <> ".vkey" } - , stakingKeyPair = StakingKeyPair - { stakingSKey = tmpAbsPath "stake-delegator-keys/staking" <> show idx <> ".skey" - , stakingVKey = tmpAbsPath "stake-delegator-keys/staking" <> show idx <> ".vkey" + , stakingKeyPair = KeyPair + { signingKey = File $ tmpAbsPath "stake-delegator-keys/staking" <> show idx <> ".skey" + , verificationKey = File $ tmpAbsPath "stake-delegator-keys/staking" <> show idx <> ".vkey" } } @@ -386,8 +394,8 @@ cardanoTestnet H.noteShowIO_ DTC.getCurrentTime forM_ wallets $ \wallet -> do - H.cat $ paymentSKey $ paymentKeyInfoPair wallet - H.cat $ paymentVKey $ paymentKeyInfoPair wallet + H.cat . unFile . signingKey $ paymentKeyInfoPair wallet + H.cat . unFile . verificationKey $ paymentKeyInfoPair wallet let runtime = TestnetRuntime { configurationFile @@ -404,8 +412,8 @@ cardanoTestnet execConfig <- H.mkExecConfig tempBaseAbsPath node1sprocket testnetMagic forM_ wallets $ \wallet -> do - H.cat $ paymentSKey $ paymentKeyInfoPair wallet - H.cat $ paymentVKey $ paymentKeyInfoPair wallet + H.cat . unFile . signingKey $ paymentKeyInfoPair wallet + H.cat . unFile . verificationKey $ paymentKeyInfoPair wallet utxos <- execCli' execConfig [ "query", "utxo" diff --git a/cardano-testnet/src/Testnet/Types.hs b/cardano-testnet/src/Testnet/Types.hs index 265854f0800..6e2fe0e64d8 100644 --- a/cardano-testnet/src/Testnet/Types.hs +++ b/cardano-testnet/src/Testnet/Types.hs @@ -3,7 +3,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} @@ -20,6 +19,9 @@ module Testnet.Types , PoolNodeKeys(..) , Delegator(..) , KeyPair(..) + , verificationKeyFp + , signingKeyFp + , SomeKeyPair(..) , VKey , SKey , ColdPoolKey @@ -75,6 +77,15 @@ data KeyPair k = KeyPair deriving instance Show (KeyPair k) deriving instance Eq (KeyPair k) +verificationKeyFp :: KeyPair k -> FilePath +verificationKeyFp = unFile . verificationKey + +signingKeyFp :: KeyPair k -> FilePath +signingKeyFp = unFile . verificationKey + +data SomeKeyPair = forall a. SomeKeyPair (KeyPair a) +deriving instance Show SomeKeyPair + -- | Verification key tag data VKey k