Transaction: propagate ShelleyBasedEra instead of CardanoEra

cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs

@@ -660,8 +660,7 @@ constructTxBodyContent sbe mScriptValidity mPparams inputsAndMaybeScriptWits rea
                        reqSigners fee txAuxScripts txMetadata txUpdateProposal
                        votingProcedures proposals mCurrentTreasuryValue mTreasuryDonation
                        = do
-  let era = toCardanoEra sbe -- TODO: Propagate SBE
-      allReferenceInputs = getAllReferenceInputs
+  let allReferenceInputs = getAllReferenceInputs
                              inputsAndMaybeScriptWits
                              (snd valuesWithScriptWits)
                              certsAndMaybeScriptWits
@@ -672,17 +671,17 @@ constructTxBodyContent sbe mScriptValidity mPparams inputsAndMaybeScriptWits rea
 
   validatedCollateralTxIns <- validateTxInsCollateral sbe txinsc
   validatedRefInputs <- validateTxInsReference sbe allReferenceInputs
-  validatedTotCollateral <- first TxCmdNotSupportedInEraValidationError $ validateTxTotalCollateral era mTotCollateral
-  validatedRetCol        <- first TxCmdNotSupportedInEraValidationError $ validateTxReturnCollateral era mReturnCollateral
+  validatedTotCollateral <- first TxCmdNotSupportedInEraValidationError $ validateTxTotalCollateral sbe mTotCollateral
+  validatedRetCol        <- first TxCmdNotSupportedInEraValidationError $ validateTxReturnCollateral sbe mReturnCollateral
   let txFee = TxFeeExplicit sbe fee
-  validatedLowerBound <- first TxCmdNotSupportedInEraValidationError $ validateTxValidityLowerBound era mLowerBound
-  validatedReqSigners <- first TxCmdNotSupportedInEraValidationError $ validateRequiredSigners era reqSigners
-  validatedTxWtdrwls  <- first TxCmdNotSupportedInEraValidationError $ validateTxWithdrawals era withdrawals
-  validatedTxCerts    <- first TxCmdNotSupportedInEraValidationError $ validateTxCertificates era certsAndMaybeScriptWits
+  validatedLowerBound <- first TxCmdNotSupportedInEraValidationError $ validateTxValidityLowerBound sbe mLowerBound
+  validatedReqSigners <- first TxCmdNotSupportedInEraValidationError $ validateRequiredSigners sbe reqSigners
+  validatedTxWtdrwls  <- first TxCmdNotSupportedInEraValidationError $ validateTxWithdrawals sbe withdrawals
+  validatedTxCerts    <- first TxCmdNotSupportedInEraValidationError $ validateTxCertificates sbe certsAndMaybeScriptWits
   validatedMintValue <- createTxMintValue sbe valuesWithScriptWits
-  validatedTxScriptValidity <- first TxCmdNotSupportedInEraValidationError $ validateTxScriptValidity era mScriptValidity
+  validatedTxScriptValidity <- first TxCmdNotSupportedInEraValidationError $ validateTxScriptValidity sbe mScriptValidity
   validatedVotingProcedures <- first TxCmdTxGovDuplicateVotes $ convertToTxVotingProcedures votingProcedures
-  validatedPParams    <- first TxCmdNotSupportedInEraValidationError $ validateProtocolParameters era (LedgerProtocolParameters <$> mPparams)
+  validatedPParams          <- first TxCmdNotSupportedInEraValidationError $ validateProtocolParameters sbe (LedgerProtocolParameters <$> mPparams)
   validatedCurrentTreasuryValue <- first TxCmdNotSupportedInEraValidationError (validateTxCurrentTreasuryValue sbe mCurrentTreasuryValue)
   validatedTreasuryDonation     <- first TxCmdNotSupportedInEraValidationError (validateTxTreasuryDonation sbe mTreasuryDonation)
   return $ shelleyBasedEraConstraints sbe $ (defaultTxBodyContent sbe
@@ -705,8 +704,8 @@ constructTxBodyContent sbe mScriptValidity mPparams inputsAndMaybeScriptWits rea
              & setTxMintValue validatedMintValue
              & setTxScriptValidity validatedTxScriptValidity)
              -- TODO: Create set* function for proposal procedures and voting procedures
-             { txProposalProcedures = forEraInEonMaybe era (`Featured` convToTxProposalProcedures proposals)
-             , txVotingProcedures = forEraInEonMaybe era (`Featured` validatedVotingProcedures)
+             { txProposalProcedures = forShelleyBasedEraInEonMaybe sbe (`Featured` convToTxProposalProcedures proposals)
+             , txVotingProcedures = forShelleyBasedEraInEonMaybe sbe (`Featured` validatedVotingProcedures)
              }
              & setTxCurrentTreasuryValue validatedCurrentTreasuryValue
              & setTxTreasuryDonation validatedTreasuryDonation
@@ -793,7 +792,7 @@ runTxBuild
   validatedTxCerts
      <- hoistEither
           . first TxCmdNotSupportedInEraValidationError
-          $ validateTxCertificates era certsAndMaybeScriptWits
+          $ validateTxCertificates sbe certsAndMaybeScriptWits
 
   let certs =
         case validatedTxCerts of

cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs

@@ -89,12 +89,12 @@ instance Error (TxNotSupportedInEraValidationError era) where
     where
       go a cEra = pretty a <+> "not supported in" <+> viaShow cEra
 
-validateTxTotalCollateral :: CardanoEra era
+validateTxTotalCollateral :: ShelleyBasedEra era
                           -> Maybe L.Coin
                           -> Either (TxNotSupportedInEraValidationError era) (TxTotalCollateral era)
 validateTxTotalCollateral _ Nothing = return TxTotalCollateralNone
-validateTxTotalCollateral era (Just coll) = do
-  supported <- conjureWitness era $ TxNotSupportedInAnyCardanoEraValidationError "Transaction collateral"
+validateTxTotalCollateral sbe (Just coll) = do
+  supported <- conjureWitness (toCardanoEra sbe) $ TxNotSupportedInAnyCardanoEraValidationError "Transaction collateral"
   pure $ TxTotalCollateral supported coll
 
 validateTxCurrentTreasuryValue :: ()
@@ -123,20 +123,20 @@ validateTxTreasuryDonation sbe mTreasuryDonation =
         (\cOnwards -> Right $ Just $ Featured cOnwards unTxTreasuryDonation )
         sbe
 
-validateTxReturnCollateral :: CardanoEra era
+validateTxReturnCollateral :: ShelleyBasedEra era
                            -> Maybe (TxOut CtxTx era)
                            -> Either (TxNotSupportedInEraValidationError era) (TxReturnCollateral CtxTx era)
 validateTxReturnCollateral _ Nothing = return TxReturnCollateralNone
-validateTxReturnCollateral era (Just retColTxOut) = do
-  supported <- conjureWitness era $ TxNotSupportedInAnyCardanoEraValidationError "Transaction return collateral"
+validateTxReturnCollateral sbe (Just retColTxOut) = do
+  supported <- conjureWitness (toCardanoEra sbe) $ TxNotSupportedInAnyCardanoEraValidationError "Transaction return collateral"
   pure $ TxReturnCollateral supported retColTxOut
 
-validateTxValidityLowerBound :: CardanoEra era
+validateTxValidityLowerBound :: ShelleyBasedEra era
                              -> Maybe SlotNo
                              -> Either (TxNotSupportedInEraValidationError era) (TxValidityLowerBound era)
 validateTxValidityLowerBound _ Nothing = return TxValidityNoLowerBound
-validateTxValidityLowerBound era (Just slot) = do
-  supported <- conjureWitness era $ TxNotSupportedInAnyCardanoEraValidationError "Transaction validity lower bound"
+validateTxValidityLowerBound sbe (Just slot) = do
+  supported <- conjureWitness (toCardanoEra sbe) $ TxNotSupportedInAnyCardanoEraValidationError "Transaction validity lower bound"
   pure $ TxValidityLowerBound supported slot
 
 data TxAuxScriptsValidationError
@@ -161,22 +161,21 @@ validateTxAuxScripts era scripts = do
   pure $ TxAuxScripts supported scriptsInEra
 
 validateRequiredSigners
-  :: CardanoEra era
+  :: ShelleyBasedEra era
   -> [Hash PaymentKey]
   -> Either (TxNotSupportedInEraValidationError era) (TxExtraKeyWitnesses era)
 validateRequiredSigners _ [] = return TxExtraKeyWitnessesNone
-validateRequiredSigners era reqSigs = do
-  supported <- conjureWitness era $ TxNotSupportedInAnyCardanoEraValidationError "Transaction required signers"
+validateRequiredSigners sbe reqSigs = do
+  supported <- conjureWitness (toCardanoEra sbe) $ TxNotSupportedInAnyCardanoEraValidationError "Transaction required signers"
   pure $ TxExtraKeyWitnesses supported reqSigs
 
 validateTxWithdrawals
-  :: forall era.
-     CardanoEra era
+  :: ShelleyBasedEra era
   -> [(StakeAddress, L.Coin, Maybe (ScriptWitness WitCtxStake era))]
   -> Either (TxNotSupportedInEraValidationError era) (TxWithdrawals BuildTx era)
 validateTxWithdrawals _ [] = return TxWithdrawalsNone
-validateTxWithdrawals era withdrawals = do
-  supported <- conjureWitness era $ TxNotSupportedInAnyCardanoEraValidationError "Transaction withdrawals"
+validateTxWithdrawals sbe withdrawals = do
+  supported <- conjureWitness (toCardanoEra sbe) $ TxNotSupportedInAnyCardanoEraValidationError "Transaction withdrawals"
   let convWithdrawals = map convert withdrawals
   pure $ TxWithdrawals supported convWithdrawals
  where
@@ -189,16 +188,15 @@ validateTxWithdrawals era withdrawals = do
       Nothing   -> (sAddr, ll, BuildTxWith $ KeyWitness KeyWitnessForStakeAddr)
 
 -- TODO: Because we have separated Byron related transaction
--- construction into separate commands, we can parameterize this
--- on ShelleyBasedEra era and remove Either TxCertificatesValidationError
+-- construction into separate commands, we can remove
+-- Either TxNotSupportedInEraValidationError
 validateTxCertificates
-  :: forall era.
-     CardanoEra era
+  :: ShelleyBasedEra era
   -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
   -> Either (TxNotSupportedInEraValidationError era) (TxCertificates BuildTx era)
 validateTxCertificates _ [] = return TxCertificatesNone
-validateTxCertificates era certsAndScriptWitnesses = cardanoEraConstraints era $ do
-  supported <- conjureWitness era $ TxNotSupportedInAnyCardanoEraValidationError "Transaction certificates"
+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
@@ -213,21 +211,21 @@ validateTxCertificates era certsAndScriptWitnesses = cardanoEraConstraints era $
         Nothing   -> (sCred, KeyWitness KeyWitnessForStakeAddr)
 
 validateProtocolParameters
-  :: CardanoEra era
+  :: ShelleyBasedEra era
   -> Maybe (LedgerProtocolParameters era)
   -> Either (TxNotSupportedInEraValidationError era) (BuildTxWith BuildTx (Maybe (LedgerProtocolParameters era)))
 validateProtocolParameters _ Nothing = return (BuildTxWith Nothing)
-validateProtocolParameters era (Just pparams) = do
-  _ <- conjureWitness @ShelleyBasedEra era $ TxNotSupportedInAnyCardanoEraValidationError "Transaction protocol parameters"
+validateProtocolParameters sbe (Just pparams) = do
+  _ <- conjureWitness @ShelleyBasedEra (toCardanoEra sbe) $ TxNotSupportedInAnyCardanoEraValidationError "Transaction protocol parameters"
   pure . BuildTxWith $ Just pparams
 
 validateTxScriptValidity
-  :: CardanoEra era
+  :: ShelleyBasedEra era
   -> Maybe ScriptValidity
   -> Either (TxNotSupportedInEraValidationError era) (TxScriptValidity era)
 validateTxScriptValidity _ Nothing = pure TxScriptValidityNone
-validateTxScriptValidity era (Just scriptValidity) = do
-  supported <- conjureWitness era $ TxNotSupportedInAnyCardanoEraValidationError "Transaction script validity"
+validateTxScriptValidity sbe (Just scriptValidity) = do
+  supported <- conjureWitness (toCardanoEra sbe) $ TxNotSupportedInAnyCardanoEraValidationError "Transaction script validity"
   pure $ TxScriptValidity supported scriptValidity
 
 -- TODO legacy. This can be deleted when legacy commands are removed.
@@ -241,6 +239,8 @@ validateUpdateProposalFile era = \case
     supported <- conjureWitness era $ TxNotSupportedInAnyCardanoEraValidationError "Transaction update proposal"
     pure $ Just $ Featured supported $ Just updateProposal
 
+-- TODO make this function take a ShelleyBasedEra when the last
+-- CardanoEra caller is removed (there remains only one).
 conjureWitness :: Eon eon
                => CardanoEra era -- ^ era to try to conjure eon from
                -> (AnyCardanoEra -> e)  -- ^ error wrapper function