From a1acc6129cd3a40c58f7e1d454b8bbde2798b319 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Wed, 22 Nov 2023 20:55:25 +0100 Subject: [PATCH] Refactor: move certificate witness lookup to cardano-api --- cabal.project | 2 +- cardano-cli/cardano-cli.cabal | 2 +- cardano-cli/src/Cardano/CLI/Read.hs | 4 +- .../CLI/Types/Errors/TxValidationError.hs | 50 +++---------------- flake.lock | 6 +-- 5 files changed, 13 insertions(+), 51 deletions(-) diff --git a/cabal.project b/cabal.project index c125e35a91..c9d830c8c2 100644 --- a/cabal.project +++ b/cabal.project @@ -14,7 +14,7 @@ repository cardano-haskell-packages -- you need to run if you change them index-state: , hackage.haskell.org 2023-11-09T23:50:15Z - , cardano-haskell-packages 2023-11-21T19:00:47Z + , cardano-haskell-packages 2023-11-24T10:15:21Z packages: cardano-cli diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 5f2f020a8f..114dc890f0 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -206,7 +206,7 @@ library , binary , bytestring , canonical-json - , cardano-api ^>= 8.34.0.0 + , cardano-api ^>= 8.34.1.0 , cardano-binary , cardano-crypto , cardano-crypto-class ^>= 2.1.2 diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index aebcdf61fd..8aa64e829e 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -337,9 +337,9 @@ readScriptWitness era (PlutusReferenceScriptWitnessFiles refTxIn error "readScriptWitness: Should not be possible to specify a simple script" PlutusScriptLanguage version -> do datum <- firstExceptT ScriptWitnessErrorScriptData - $ readScriptDatumOrFile datumOrFile + $ readScriptDatumOrFile datumOrFile redeemer <- firstExceptT ScriptWitnessErrorScriptData - $ readScriptRedeemerOrFile redeemerOrFile + $ readScriptRedeemerOrFile redeemerOrFile return $ PlutusScriptWitness sLangInEra version diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs index ca318cfa16..9b2cb8f033 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs @@ -35,7 +35,6 @@ module Cardano.CLI.Types.Errors.TxValidationError ) where import Cardano.Api -import qualified Cardano.Api.Ledger as L import Cardano.Api.Pretty import Cardano.Api.Shelley @@ -225,9 +224,8 @@ validateTxWithdrawals era withdrawals = do -> (StakeAddress, Lovelace, BuildTxWith BuildTx (Witness WitCtxStake era)) convert (sAddr, ll, mScriptWitnessFiles) = case mScriptWitnessFiles of - Just sWit -> do - (sAddr, ll, BuildTxWith $ ScriptWitness ScriptWitnessForStakeAddr sWit) - Nothing -> (sAddr,ll, BuildTxWith $ KeyWitness KeyWitnessForStakeAddr) + Just sWit -> (sAddr, ll, BuildTxWith $ ScriptWitness ScriptWitnessForStakeAddr sWit) + Nothing -> (sAddr, ll, BuildTxWith $ KeyWitness KeyWitnessForStakeAddr) newtype TxCertificatesValidationError = TxCertificatesValidationNotSupported AnyCardanoEra @@ -249,50 +247,14 @@ validateTxCertificates era certsAndScriptWitnesses = cardanoEraConstraints era $ reqWits = Map.fromList $ mapMaybe convert certsAndScriptWitnesses pure $ TxCertificates supported certs $ BuildTxWith reqWits where - -- We get the stake credential witness for a certificate that requires it. - -- NB: Only stake address deregistration and delegation requires - -- witnessing (witness can be script or key) - deriveStakeCredentialWitness - :: Certificate era - -> Maybe StakeCredential - deriveStakeCredentialWitness = fmap fromShelleyStakeCredential . \case - ShelleyRelatedCertificate stbEra shelleyCert -> shelleyToBabbageEraConstraints stbEra $ - case shelleyCert of - L.RegTxCert _sCred -> Nothing -- not required - L.UnRegTxCert sCred -> Just sCred - L.DelegStakeTxCert sCred _ -> Just sCred - L.RegPoolTxCert _ -> Nothing - L.RetirePoolTxCert _ _ -> Nothing - L.MirTxCert _ -> Nothing - L.GenesisDelegTxCert{} -> Nothing - - ConwayCertificate cEra conwayCert -> conwayEraOnwardsConstraints cEra $ - case conwayCert of - L.RegPoolTxCert _ -> Nothing - L.RetirePoolTxCert _ _ -> Nothing - L.RegTxCert _ -> Nothing - L.UnRegTxCert sCred -> Just sCred - L.RegDepositTxCert _ _ -> Nothing - L.UnRegDepositTxCert sCred _ -> Just sCred - L.DelegTxCert sCred _ -> Just sCred - L.RegDepositDelegTxCert sCred _ _ -> Just sCred - L.AuthCommitteeHotKeyTxCert{} -> Nothing - L.ResignCommitteeColdTxCert _ _ -> Nothing - L.RegDRepTxCert{} -> Nothing - L.UnRegDRepTxCert{} -> Nothing - L.UpdateDRepTxCert{} -> Nothing - convert :: (Certificate era, Maybe (ScriptWitness WitCtxStake era)) -> Maybe (StakeCredential, Witness WitCtxStake era) convert (cert, mScriptWitnessFiles) = do - sCred <- deriveStakeCredentialWitness cert - case mScriptWitnessFiles of - Just sWit -> do - Just ( sCred - , ScriptWitness ScriptWitnessForStakeAddr sWit - ) - Nothing -> Just (sCred, KeyWitness KeyWitnessForStakeAddr) + sCred <- selectStakeCredentialWitness cert + Just $ case mScriptWitnessFiles of + Just sWit -> (sCred, ScriptWitness ScriptWitnessForStakeAddr sWit) + Nothing -> (sCred, KeyWitness KeyWitnessForStakeAddr) newtype TxProtocolParametersValidationError = ProtocolParametersNotSupported AnyCardanoEra diff --git a/flake.lock b/flake.lock index 8efff985f0..2b504a28dd 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1700639964, - "narHash": "sha256-iQ48z5eqSHP8d7B8BBJtnXkVPIKPvdWc0GhIgy4j8cc=", + "lastModified": 1700821603, + "narHash": "sha256-BORkay1OBvfVPJ6mbKzhAO3TbRiYbRgqmjJBeMfvMjc=", "owner": "input-output-hk", "repo": "cardano-haskell-packages", - "rev": "eaf713ef8029332b9e4e23685fa157f26086da8b", + "rev": "1809a05dc4d7c3eae3b794fe608c29f8953cb13f", "type": "github" }, "original": {