Remove validateTxCertificates

IntersectMBO · Jun 17, 2024 · cf4e491 · cf4e491
1 parent f38352f
commit cf4e491
Show file tree

Hide file tree

Showing 2 changed files with 21 additions and 37 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs
@@ -68,7 +68,7 @@ import           Data.Function ((&))
 import qualified Data.List as List
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
-import           Data.Maybe (catMaybes, fromMaybe)
+import           Data.Maybe (catMaybes, fromMaybe, mapMaybe)
 import           Data.Set (Set)
 import qualified Data.Set as Set
 import qualified Data.Text as Text
@@ -660,7 +660,7 @@ constructTxBodyContent sbe mScriptValidity mPparams inputsAndMaybeScriptWits rea
   let txFee = TxFeeExplicit sbe fee
   validatedLowerBound <- first TxCmdNotSupportedInEraValidationError $ validateTxValidityLowerBound sbe mLowerBound
   validatedReqSigners <- first TxCmdNotSupportedInEraValidationError $ validateRequiredSigners sbe reqSigners
-  validatedTxCerts    <- first TxCmdNotSupportedInEraValidationError $ validateTxCertificates sbe certsAndMaybeScriptWits
+  -- validatedTxCerts    <- first TxCmdNotSupportedInEraValidationError $ validateTxCertificates sbe certsAndMaybeScriptWits
   validatedMintValue <- createTxMintValue sbe valuesWithScriptWits
   validatedTxScriptValidity <- first TxCmdNotSupportedInEraValidationError $ validateTxScriptValidity sbe mScriptValidity
   validatedVotingProcedures <- first TxCmdTxGovDuplicateVotes $ convertToTxVotingProcedures votingProcedures
@@ -679,7 +679,7 @@ constructTxBodyContent sbe mScriptValidity mPparams inputsAndMaybeScriptWits rea
              & setTxExtraKeyWits validatedReqSigners
              & setTxProtocolParams (BuildTxWith $ LedgerProtocolParameters <$> mPparams)
              & setTxWithdrawals (TxWithdrawals sbe $ map convertWithdrawals withdrawals)
-             & setTxCertificates validatedTxCerts
+             & setTxCertificates (convertCertificates sbe certsAndMaybeScriptWits)
              & setTxUpdateProposal txUpdateProposal
              & setTxMintValue validatedMintValue
              & setTxScriptValidity validatedTxScriptValidity)
@@ -696,10 +696,6 @@ constructTxBodyContent sbe mScriptValidity mPparams inputsAndMaybeScriptWits rea
       Just sWit -> (sAddr, ll, BuildTxWith $ ScriptWitness ScriptWitnessForStakeAddr sWit)
       Nothing   -> (sAddr, ll, BuildTxWith $ KeyWitness KeyWitnessForStakeAddr)
 
-
-
-
-
 runTxBuild :: ()
   => ShelleyBasedEra era
   -> SocketPath
@@ -775,13 +771,8 @@ runTxBuild
   Refl <- testEquality era nodeEra
     & hoistMaybe (TxCmdTxNodeEraMismatchError $ NodeEraMismatchError era nodeEra)
 
-  validatedTxCerts
-     <- hoistEither
-          . first TxCmdNotSupportedInEraValidationError
-          $ validateTxCertificates sbe certsAndMaybeScriptWits
-
   let certs =
-        case validatedTxCerts of
+        case convertCertificates sbe certsAndMaybeScriptWits of
           TxCertificates _ cs _ -> cs
           _ -> []
 
@@ -830,6 +821,23 @@ runTxBuild
 
   return balancedTxBody
 
+convertCertificates :: ()
+  => ShelleyBasedEra era
+  -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
+  -> TxCertificates BuildTx era
+convertCertificates sbe certsAndScriptWitnesses =
+  TxCertificates sbe certs $ BuildTxWith reqWits
+  where
+    certs = map fst certsAndScriptWitnesses
+    reqWits = Map.fromList $ mapMaybe convert certsAndScriptWitnesses
+    convert :: (Certificate era, Maybe (ScriptWitness WitCtxStake era))
+               -> Maybe (StakeCredential, Witness WitCtxStake era)
+    convert (cert, mScriptWitnessFiles) = do
+      sCred <- selectStakeCredentialWitness cert
+      Just $ case mScriptWitnessFiles of
+        Just sWit -> (sCred, ScriptWitness ScriptWitnessForStakeAddr sWit)
+        Nothing   -> (sCred, KeyWitness KeyWitnessForStakeAddr)
+
 -- ----------------------------------------------------------------------------
 -- Transaction body validation and conversion
 --

diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs
@@ -14,7 +14,6 @@ module Cardano.CLI.Types.Errors.TxValidationError
   , convertToTxVotingProcedures
   , validateScriptSupportedInEra
   , validateTxAuxScripts
-  , validateTxCertificates
   , validateRequiredSigners
   , validateTxReturnCollateral
   , validateTxScriptValidity
@@ -138,29 +137,6 @@ validateRequiredSigners sbe reqSigs = do
   supported <- conjureWitness (toCardanoEra sbe) $ TxNotSupportedInAnyCardanoEraValidationError "Transaction required signers"
   pure $ TxExtraKeyWitnesses supported reqSigs
 
--- TODO: Because we have separated Byron related transaction
--- construction into separate commands, we can remove
--- Either TxNotSupportedInEraValidationError
-validateTxCertificates
-  :: ShelleyBasedEra era
-  -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
-  -> Either (TxNotSupportedInEraValidationError era) (TxCertificates BuildTx era)
-validateTxCertificates _ [] = return TxCertificatesNone
-validateTxCertificates sbe certsAndScriptWitnesses = shelleyBasedEraConstraints sbe $ do
-  supported <- conjureWitness (toCardanoEra sbe) $ TxNotSupportedInAnyCardanoEraValidationError "Transaction certificates"
-  let certs = map fst certsAndScriptWitnesses
-      reqWits = Map.fromList $ mapMaybe convert certsAndScriptWitnesses
-  pure $ TxCertificates supported certs $ BuildTxWith reqWits
-  where
-    convert
-      :: (Certificate era, Maybe (ScriptWitness WitCtxStake era))
-      -> Maybe (StakeCredential, Witness WitCtxStake era)
-    convert (cert, mScriptWitnessFiles) = do
-      sCred <- selectStakeCredentialWitness cert
-      Just $ case mScriptWitnessFiles of
-        Just sWit -> (sCred, ScriptWitness ScriptWitnessForStakeAddr sWit)
-        Nothing   -> (sCred, KeyWitness KeyWitnessForStakeAddr)
-
 validateTxScriptValidity
   :: ShelleyBasedEra era
   -> Maybe ScriptValidity