Add certificates to CLI interface in compatible transaction-sign

cabal.project

@@ -14,7 +14,7 @@ repository cardano-haskell-packages
 -- you need to run if you change them
 index-state:
   , hackage.haskell.org 2024-10-11T15:49:11Z
-  , cardano-haskell-packages 2024-11-12T08:40:13Z
+  , cardano-haskell-packages 2024-11-20T20:05:41Z
 
 packages:
   cardano-cli

cardano-cli/cardano-cli.cabal

@@ -116,6 +116,8 @@ library
     Cardano.CLI.EraBased.Run.StakePool
     Cardano.CLI.EraBased.Run.TextView
     Cardano.CLI.EraBased.Run.Transaction
+    Cardano.CLI.EraBased.Script.Mint.Read
+    Cardano.CLI.EraBased.Script.Mint.Types
     Cardano.CLI.EraBased.Transaction.HashCheck
     Cardano.CLI.Helpers
     Cardano.CLI.IO.Lazy
@@ -170,10 +172,12 @@ library
     Cardano.CLI.Types.Errors.KeyCmdError
     Cardano.CLI.Types.Errors.NodeCmdError
     Cardano.CLI.Types.Errors.NodeEraMismatchError
+    Cardano.CLI.Types.Errors.PlutusScriptDecodeError
     Cardano.CLI.Types.Errors.ProtocolParamsError
     Cardano.CLI.Types.Errors.QueryCmdError
     Cardano.CLI.Types.Errors.QueryCmdLocalStateQueryError
     Cardano.CLI.Types.Errors.RegistrationError
+    Cardano.CLI.Types.Errors.ScriptDataError
     Cardano.CLI.Types.Errors.ScriptDecodeError
     Cardano.CLI.Types.Errors.StakeAddressCmdError
     Cardano.CLI.Types.Errors.StakeAddressDelegationError
@@ -203,7 +207,7 @@ library
     binary,
     bytestring,
     canonical-json,
-    cardano-api ^>=10.2,
+    cardano-api ^>=10.3,
     cardano-binary,
     cardano-crypto,
     cardano-crypto-class ^>=2.1.2,
@@ -356,6 +360,7 @@ test-suite cardano-cli-test
     Test.Cli.Shelley.Run.Hash
     Test.Cli.Shelley.Run.Query
     Test.Cli.Shelley.Transaction.Build
+    Test.Cli.Shelley.Transaction.Compatible.Build
     Test.Cli.VerificationKey
 
   ghc-options:

cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 
 module Cardano.CLI.Compatible.Transaction
@@ -27,10 +28,14 @@ import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.BootstrapWitnessError
 import           Cardano.CLI.Types.Errors.TxCmdError
 import           Cardano.CLI.Types.Governance
+import           Cardano.CLI.Types.TxFeature
 
+import           Data.Bifunctor (first)
 import           Data.Foldable
 import           Data.Function
+import           Data.Maybe
 import           Data.Text (Text)
+import           GHC.Exts (IsList (..))
 import           Options.Applicative
 import qualified Options.Applicative as Opt
 
@@ -64,6 +69,7 @@ pCompatibleSignedTransaction env sbe =
     <*> many pWitnessSigningData
     <*> optional (pNetworkId env)
     <*> pTxFee
+    <*> many (pCertificateFile sbe ManualBalance)
     <*> pOutputFile
 
 pTxInOnly :: Parser TxIn
@@ -178,13 +184,15 @@ data CompatibleTransactionCmds era
       (Maybe NetworkId)
       !Coin
       -- ^ Tx fee
+      ![(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
+      -- ^ stake registering certs
       !(File () Out)
 
 renderCompatibleTransactionCmd :: CompatibleTransactionCmds era -> Text
 renderCompatibleTransactionCmd _ = ""
 
 data CompatibleTransactionError
-  = CompatibleTxOutError !TxCmdError
+  = CompatibleTxCmdError !TxCmdError
   | CompatibleWitnessError !ReadWitnessSigningDataError
   | CompatiblePParamsConversionError !ProtocolParametersConversionError
   | CompatibleBootstrapWitnessError !BootstrapWitnessError
@@ -193,10 +201,11 @@ data CompatibleTransactionError
   | CompatibleProposalError !ProposalError
   | CompatibleVoteError !VoteError
   | forall era. CompatibleVoteMergeError !(VotesMergingConflict era)
+  | CompatibleScriptWitnessError !ScriptWitnessError
 
 instance Error CompatibleTransactionError where
   prettyError = \case
-    CompatibleTxOutError e -> renderTxCmdError e
+    CompatibleTxCmdError e -> renderTxCmdError e
     CompatibleWitnessError e -> renderReadWitnessSigningDataError e
     CompatiblePParamsConversionError e -> prettyError e
     CompatibleBootstrapWitnessError e -> renderBootstrapWitnessError e
@@ -205,9 +214,12 @@ instance Error CompatibleTransactionError where
     CompatibleProposalError e -> pshow e
     CompatibleVoteError e -> pshow e
     CompatibleVoteMergeError e -> pshow e
+    CompatibleScriptWitnessError e -> renderScriptWitnessError e
 
 runCompatibleTransactionCmd
-  :: CompatibleTransactionCmds era -> ExceptT CompatibleTransactionError IO ()
+  :: forall era
+   . CompatibleTransactionCmds era
+  -> ExceptT CompatibleTransactionError IO ()
 runCompatibleTransactionCmd
   ( CreateCompatibleSignedTransaction
       sbe
@@ -219,12 +231,38 @@ runCompatibleTransactionCmd
       witnesses
       mNetworkId
       fee
+      certificates
       outputFp
     ) = do
     sks <- firstExceptT CompatibleWitnessError $ mapM (newExceptT . readWitnessSigningData) witnesses
 
-    allOuts <- firstExceptT CompatibleTxOutError $ mapM (toTxOutInAnyEra sbe) outs
+    allOuts <- firstExceptT CompatibleTxCmdError $ mapM (toTxOutInAnyEra sbe) outs
 
+    certFilesAndMaybeScriptWits <-
+      firstExceptT CompatibleScriptWitnessError $
+        readScriptWitnessFiles sbe certificates
+
+    certsAndMaybeScriptWits :: [(Certificate era, Maybe (ScriptWitness WitCtxStake era))] <-
+      shelleyBasedEraConstraints sbe $
+        sequence
+          [ fmap
+              (,mSwit)
+              ( firstExceptT CompatibleFileError . newExceptT $
+                  readFileTextEnvelope AsCertificate (File certFile)
+              )
+          | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits
+          ]
+
+    let refInputs =
+          [ refInput
+          | (_, Just sWit) <- certsAndMaybeScriptWits
+          , refInput <- maybeToList $ getScriptWitnessReferenceInput sWit
+          ]
+    -- TODO is this missing something? see EraBased.Run.Transaction L907
+    validatedRefInputs <- liftEither . first CompatibleTxCmdError $ validateTxInsReference refInputs
+    let txCerts = convertCertificates certsAndMaybeScriptWits
+
+    -- this body is only for witnesses
     apiTxBody <-
       firstExceptT CompatibleTxBodyError $
         hoistEither $
@@ -233,55 +271,95 @@ runCompatibleTransactionCmd
               & setTxIns (map (,BuildTxWith (KeyWitness KeyWitnessForSpending)) ins)
               & setTxOuts allOuts
               & setTxFee (TxFeeExplicit sbe fee)
+              & setTxCertificates txCerts
+              & setTxInsReference validatedRefInputs
 
     let (sksByron, sksShelley) = partitionSomeWitnesses $ map categoriseSomeSigningWitness sks
 
     byronWitnesses <-
-      firstExceptT CompatibleBootstrapWitnessError $
-        hoistEither (mkShelleyBootstrapWitnesses sbe mNetworkId apiTxBody sksByron)
+      firstExceptT CompatibleBootstrapWitnessError . hoistEither $
+        mkShelleyBootstrapWitnesses sbe mNetworkId apiTxBody sksByron
 
     let newShelleyKeyWits = map (makeShelleyKeyWitness sbe apiTxBody) sksShelley
         allKeyWits = newShelleyKeyWits ++ byronWitnesses
 
     (protocolUpdates, votes) <-
       caseShelleyToBabbageOrConwayEraOnwards
         ( const $ do
-            prop <- maybe (return $ NoPParamsUpdate sbe) readUpdateProposalFile mUpdateProposal
+            prop <- maybe (pure $ NoPParamsUpdate sbe) readUpdateProposalFile mUpdateProposal
             return (prop, NoVotes)
         )
         ( \w -> do
-            prop <- maybe (return $ NoPParamsUpdate sbe) readProposalProcedureFile mProposalProcedure
-            votesAndWits <- firstExceptT CompatibleVoteError $ newExceptT $ readVotingProceduresFiles w mVotes
+            prop <- maybe (pure $ NoPParamsUpdate sbe) readProposalProcedureFile mProposalProcedure
+            votesAndWits <-
+              firstExceptT CompatibleVoteError . newExceptT $
+                readVotingProceduresFiles w mVotes
             votingProcedures <-
-              firstExceptT CompatibleVoteMergeError $ hoistEither $ mkTxVotingProcedures votesAndWits
+              firstExceptT CompatibleVoteMergeError . hoistEither $
+                mkTxVotingProcedures votesAndWits
             return (prop, VotingProcedures w votingProcedures)
         )
         sbe
 
     signedTx <-
       firstExceptT CompatiblePParamsConversionError . hoistEither $
-        createCompatibleSignedTx sbe ins allOuts allKeyWits fee protocolUpdates votes
+        createCompatibleSignedTx sbe ins allOuts allKeyWits fee protocolUpdates votes txCerts
 
     firstExceptT CompatibleFileError $
       newExceptT $
         writeTxFileTextEnvelopeCddl sbe outputFp signedTx
+   where
+    -- TODO it's copied from EraBased/Run/Transaction
+    convertCertificates
+      :: [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
+      -> TxCertificates BuildTx era
+    convertCertificates certsAndScriptWitnesses =
+      TxCertificates sbe certs $ BuildTxWith reqWits
+     where
+      certs = map fst certsAndScriptWitnesses
+      reqWits = 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)
+
+    -- TODO it's copied from EraBased.Run.Transaction.
+    validateTxInsReference
+      :: [TxIn]
+      -> Either TxCmdError (TxInsReference era)
+    validateTxInsReference [] = return TxInsReferenceNone
+    validateTxInsReference allRefIns = do
+      forShelleyBasedEraInEonMaybe sbe (`TxInsReference` allRefIns)
+        & maybe (txFeatureMismatchPure (toCardanoEra sbe) TxFeatureReferenceInputs) Right
+
+    -- TODO it's copied from EraBased.Run.Transaction
+    txFeatureMismatchPure
+      :: CardanoEra era
+      -> TxFeature
+      -> Either TxCmdError a
+    txFeatureMismatchPure era feature =
+      Left (TxCmdTxFeatureMismatch (anyCardanoEra era) feature)
 
 readUpdateProposalFile
   :: Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)
   -> ExceptT CompatibleTransactionError IO (AnyProtocolUpdate era)
 readUpdateProposalFile (Featured sToB Nothing) =
-  return $ NoPParamsUpdate $ shelleyToBabbageEraToShelleyBasedEra sToB
+  return $ NoPParamsUpdate $ inject sToB
 readUpdateProposalFile (Featured sToB (Just updateProposalFile)) = do
   prop <- firstExceptT CompatibleFileError $ readTxUpdateProposal sToB updateProposalFile
   case prop of
-    TxUpdateProposalNone -> return $ NoPParamsUpdate $ shelleyToBabbageEraToShelleyBasedEra sToB
+    TxUpdateProposalNone -> return $ NoPParamsUpdate $ inject sToB
     TxUpdateProposal _ proposal -> return $ ProtocolUpdate sToB proposal
 
 readProposalProcedureFile
   :: Featured ConwayEraOnwards era [(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> ExceptT CompatibleTransactionError IO (AnyProtocolUpdate era)
 readProposalProcedureFile (Featured cEraOnwards []) =
-  let sbe = conwayEraOnwardsToShelleyBasedEra cEraOnwards
+  let sbe = inject cEraOnwards
    in return $ NoPParamsUpdate sbe
 readProposalProcedureFile (Featured cEraOnwards proposals) = do
   props <-

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

@@ -25,6 +25,7 @@ import qualified Cardano.Api.Experimental as Exp
 import           Cardano.Api.Ledger (Coin)
 import           Cardano.Api.Shelley
 
+import           Cardano.CLI.EraBased.Script.Mint.Types
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Governance
 
@@ -61,7 +62,7 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs
   , requiredSigners :: ![RequiredSigner]
   -- ^ Required signers
   , txouts :: ![TxOutAnyEra]
-  , mValue :: !(Maybe (Value, [ScriptWitnessFiles WitCtxMint]))
+  , mValue :: !(Maybe (Value, [CliMintScriptRequirements]))
   -- ^ Multi-Asset value with script witness
   , mValidityLowerBound :: !(Maybe SlotNo)
   -- ^ Transaction validity lower bound
@@ -111,7 +112,7 @@ data TransactionBuildCmdArgs era = TransactionBuildCmdArgs
   -- ^ Normal outputs
   , changeAddresses :: !TxOutChangeAddress
   -- ^ A change output
-  , mValue :: !(Maybe (Value, [ScriptWitnessFiles WitCtxMint]))
+  , mValue :: !(Maybe (Value, [CliMintScriptRequirements]))
   -- ^ Multi-Asset value with script witness
   , mValidityLowerBound :: !(Maybe SlotNo)
   -- ^ Transaction validity lower bound
@@ -157,7 +158,7 @@ data TransactionBuildEstimateCmdArgs era = TransactionBuildEstimateCmdArgs
   -- ^ Normal outputs
   , changeAddress :: !TxOutChangeAddress
   -- ^ A change output
-  , mValue :: !(Maybe (Value, [ScriptWitnessFiles WitCtxMint]))
+  , mValue :: !(Maybe (Value, [CliMintScriptRequirements]))
   -- ^ Multi-Asset value with script witness
   , mValidityLowerBound :: !(Maybe SlotNo)
   -- ^ Transaction validity lower bound