Add governance action deposits to stake-address-info query

cabal.project

@@ -60,3 +60,10 @@ write-ghc-environment-files: always
 -- Do NOT add more source-repository-package stanzas here unless they are strictly
 -- temporary! Please read the section in CONTRIBUTING about updating dependencies.
 
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/cardano-api
+  tag: 6f8d4cad30416f8e74090e7ad3cb3a249c0eb68a
+  --sha256: sha256-Qx/mALvadNt8wwD+z4r4kPRgdSAJi+WAnTK2M57qop0=
+  subdir:
+    cardano-api

cardano-cli/cardano-cli.cabal

@@ -117,8 +117,13 @@ library
     Cardano.CLI.EraBased.Run.StakePool
     Cardano.CLI.EraBased.Run.TextView
     Cardano.CLI.EraBased.Run.Transaction
+    Cardano.CLI.EraBased.Script.Certificate.Read
+    Cardano.CLI.EraBased.Script.Certificate.Types
     Cardano.CLI.EraBased.Script.Mint.Read
     Cardano.CLI.EraBased.Script.Mint.Types
+    Cardano.CLI.EraBased.Script.Spend.Read
+    Cardano.CLI.EraBased.Script.Spend.Types
+    Cardano.CLI.EraBased.Script.Types
     Cardano.CLI.EraBased.Transaction.HashCheck
     Cardano.CLI.Helpers
     Cardano.CLI.IO.Lazy
@@ -364,6 +369,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
@@ -21,16 +22,24 @@ import           Cardano.Api.Shelley hiding (VotingProcedures)
 import           Cardano.CLI.Environment
 import           Cardano.CLI.EraBased.Options.Common hiding (pRefScriptFp, pTxOutDatum)
 import           Cardano.CLI.EraBased.Run.Transaction
+import           Cardano.CLI.EraBased.Script.Certificate.Read
+import           Cardano.CLI.EraBased.Script.Certificate.Types
+import           Cardano.CLI.EraBased.Script.Types
 import           Cardano.CLI.Parser
 import           Cardano.CLI.Read
 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 qualified Data.Map.Strict as Map
+import           Data.Maybe
 import           Data.Text (Text)
+import           GHC.Exts (IsList (..))
 import           Options.Applicative
 import qualified Options.Applicative as Opt
 
@@ -59,11 +68,12 @@ pCompatibleSignedTransaction env sbe =
     <$> many pTxInOnly
     <*> many (pTxOutEraAware sbe)
     <*> pFeatured (toCardanoEra sbe) (optional pUpdateProposalFile)
-    <*> pFeatured (toCardanoEra sbe) (many (pProposalFile sbe ManualBalance))
+    <*> pFeatured (toCardanoEra sbe) (many (pProposalFile ManualBalance))
     <*> pVoteFiles sbe ManualBalance
     <*> many pWitnessSigningData
     <*> optional (pNetworkId env)
     <*> pTxFee
+    <*> many (pCertificateFile ManualBalance)
     <*> pOutputFile
 
 pTxInOnly :: Parser TxIn
@@ -178,13 +188,15 @@ data CompatibleTransactionCmds era
       (Maybe NetworkId)
       !Coin
       -- ^ Tx fee
+      ![(CertificateFile, Maybe CliCertificateScriptRequirements)]
+      -- ^ stake registering certs
       !(File () Out)
 
 renderCompatibleTransactionCmd :: CompatibleTransactionCmds era -> Text
 renderCompatibleTransactionCmd _ = ""
 
 data CompatibleTransactionError
-  = CompatibleTxOutError !TxCmdError
+  = CompatibleTxCmdError !TxCmdError
   | CompatibleWitnessError !ReadWitnessSigningDataError
   | CompatiblePParamsConversionError !ProtocolParametersConversionError
   | CompatibleBootstrapWitnessError !BootstrapWitnessError
@@ -193,10 +205,12 @@ data CompatibleTransactionError
   | CompatibleProposalError !ProposalError
   | CompatibleVoteError !VoteError
   | forall era. CompatibleVoteMergeError !(VotesMergingConflict era)
+  | CompatibleScriptWitnessError !ScriptWitnessError
+  | CompatibleScriptWitnessReadError !(FileError CliScriptWitnessError)
 
 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 +219,13 @@ instance Error CompatibleTransactionError where
     CompatibleProposalError e -> pshow e
     CompatibleVoteError e -> pshow e
     CompatibleVoteMergeError e -> pshow e
+    CompatibleScriptWitnessError e -> renderScriptWitnessError e
+    CompatibleScriptWitnessReadError e -> prettyError e
 
 runCompatibleTransactionCmd
-  :: CompatibleTransactionCmds era -> ExceptT CompatibleTransactionError IO ()
+  :: forall era
+   . CompatibleTransactionCmds era
+  -> ExceptT CompatibleTransactionError IO ()
 runCompatibleTransactionCmd
   ( CreateCompatibleSignedTransaction
       sbe
@@ -219,12 +237,72 @@ 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 CompatibleScriptWitnessReadError $
+        readCertificateScriptWitnesses sbe certificates
+
+    certsAndMaybeScriptWits :: [(Certificate era, Maybe (ScriptWitness WitCtxStake era))] <-
+      shelleyBasedEraConstraints sbe $
+        sequence
+          [ fmap
+              (,cswScriptWitness <$> mSwit)
+              ( firstExceptT CompatibleFileError . newExceptT $
+                  readFileTextEnvelope AsCertificate (File certFile)
+              )
+          | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits
+          ]
+
+    (protocolUpdates, votes) :: (AnyProtocolUpdate era, AnyVote era) <-
+      caseShelleyToBabbageOrConwayEraOnwards
+        ( const $ do
+            prop <- maybe (pure $ NoPParamsUpdate sbe) readUpdateProposalFile mUpdateProposal
+            return (prop, NoVotes)
+        )
+        ( \w -> do
+            prop <- maybe (pure $ NoPParamsUpdate sbe) readProposalProcedureFile mProposalProcedure
+            votesAndWits <-
+              firstExceptT CompatibleVoteError . newExceptT $
+                readVotingProceduresFiles w mVotes
+            votingProcedures <-
+              firstExceptT CompatibleVoteMergeError . hoistEither $
+                mkTxVotingProcedures votesAndWits
+            return (prop, VotingProcedures w votingProcedures)
+        )
+        sbe
+
+    let certsRefInputs =
+          [ refInput
+          | (_, Just sWit) <- certsAndMaybeScriptWits
+          , refInput <- maybeToList $ getScriptWitnessReferenceInput sWit
+          ]
+
+        votesRefInputs =
+          [ refInput
+          | VotingProcedures _ (TxVotingProcedures _ (BuildTxWith voteMap)) <- [votes]
+          , sWit <- Map.elems voteMap
+          , refInput <- maybeToList $ getScriptWitnessReferenceInput sWit
+          ]
+
+        proposalsRefInputs =
+          [ refInput
+          | ProposalProcedures _ (TxProposalProcedures _ (BuildTxWith proposalMap)) <- [protocolUpdates]
+          , sWit <- Map.elems proposalMap
+          , refInput <- maybeToList $ getScriptWitnessReferenceInput sWit
+          ]
+
+    validatedRefInputs <-
+      liftEither . first CompatibleTxCmdError . validateTxInsReference $
+        certsRefInputs <> votesRefInputs <> proposalsRefInputs
+    let txCerts = convertCertificates certsAndMaybeScriptWits
+
+    -- this body is only for witnesses
     apiTxBody <-
       firstExceptT CompatibleTxBodyError $
         hoistEither $
@@ -233,39 +311,52 @@ 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
-            return (prop, NoVotes)
-        )
-        ( \w -> do
-            prop <- maybe (return $ NoPParamsUpdate sbe) readProposalProcedureFile mProposalProcedure
-            votesAndWits <- firstExceptT CompatibleVoteError $ newExceptT $ readVotingProceduresFiles w mVotes
-            votingProcedures <-
-              firstExceptT CompatibleVoteMergeError $ hoistEither $ mkTxVotingProcedures votesAndWits
-            return (prop, VotingProcedures w votingProcedures)
-        )
-        sbe
-
     signedTx <-
       firstExceptT CompatiblePParamsConversionError . hoistEither $
-        -- FIXME https://github.com/IntersectMBO/cardano-cli/pull/972
-        createCompatibleSignedTx sbe ins allOuts allKeyWits fee protocolUpdates votes TxCertificatesNone
+        createCompatibleSignedTx sbe ins allOuts allKeyWits fee protocolUpdates votes txCerts
 
     firstExceptT CompatibleFileError $
       newExceptT $
         writeTxFileTextEnvelopeCddl sbe outputFp signedTx
+   where
+    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 . (sCred,) $ case mScriptWitnessFiles of
+          Just sWit -> ScriptWitness ScriptWitnessForStakeAddr sWit
+          Nothing -> KeyWitness KeyWitnessForStakeAddr
+
+    validateTxInsReference
+      :: [TxIn]
+      -> Either TxCmdError (TxInsReference era)
+    validateTxInsReference [] = return TxInsReferenceNone
+    validateTxInsReference allRefIns = do
+      let era = toCardanoEra era
+          eraMismatchError = Left $ TxCmdTxFeatureMismatch (anyCardanoEra era) TxFeatureReferenceInputs
+      w <- maybe eraMismatchError Right $ forEraMaybeEon era
+      pure $ TxInsReference w allRefIns
 
 readUpdateProposalFile
   :: Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)

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

@@ -25,7 +25,9 @@ import qualified Cardano.Api.Experimental as Exp
 import           Cardano.Api.Ledger (Coin)
 import           Cardano.Api.Shelley
 
+import           Cardano.CLI.EraBased.Script.Certificate.Types (CliCertificateScriptRequirements)
 import           Cardano.CLI.EraBased.Script.Mint.Types
+import           Cardano.CLI.EraBased.Script.Spend.Types (CliSpendScriptRequirements)
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Governance
 
@@ -49,7 +51,7 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs
   { eon :: !(ShelleyBasedEra era)
   , mScriptValidity :: !(Maybe ScriptValidity)
   -- ^ Mark script as expected to pass or fail validation
-  , txIns :: ![(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
+  , txIns :: ![(TxIn, Maybe CliSpendScriptRequirements)]
   -- ^ Transaction inputs with optional spending scripts
   , readOnlyRefIns :: ![TxIn]
   -- ^ Read only reference inputs
@@ -70,7 +72,7 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs
   -- ^ Transaction validity upper bound
   , fee :: !Coin
   -- ^ Transaction fee
-  , certificates :: ![(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
+  , certificates :: ![(CertificateFile, Maybe CliCertificateScriptRequirements)]
   -- ^ Certificates with potential script witness
   , withdrawals :: ![(StakeAddress, Coin, Maybe (ScriptWitnessFiles WitCtxStake))]
   , metadataSchema :: !TxMetadataJsonSchema
@@ -96,7 +98,7 @@ data TransactionBuildCmdArgs era = TransactionBuildCmdArgs
   -- ^ Mark script as expected to pass or fail validation
   , mOverrideWitnesses :: !(Maybe Word)
   -- ^ Override the required number of tx witnesses
-  , txins :: ![(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
+  , txins :: ![(TxIn, Maybe CliSpendScriptRequirements)]
   -- ^ Transaction inputs with optional spending scripts
   , readOnlyReferenceInputs :: ![TxIn]
   -- ^ Read only reference inputs
@@ -118,7 +120,7 @@ data TransactionBuildCmdArgs era = TransactionBuildCmdArgs
   -- ^ Transaction validity lower bound
   , mValidityUpperBound :: !(TxValidityUpperBound era)
   -- ^ Transaction validity upper bound
-  , certificates :: ![(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
+  , certificates :: ![(CertificateFile, Maybe CliCertificateScriptRequirements)]
   -- ^ Certificates with potential script witness
   , withdrawals :: ![(StakeAddress, Coin, Maybe (ScriptWitnessFiles WitCtxStake))]
   -- ^ Withdrawals with potential script witness
@@ -144,7 +146,7 @@ data TransactionBuildEstimateCmdArgs era = TransactionBuildEstimateCmdArgs
   , mByronWitnesses :: !(Maybe Int)
   , protocolParamsFile :: !ProtocolParamsFile
   , totalUTxOValue :: !Value
-  , txins :: ![(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
+  , txins :: ![(TxIn, Maybe CliSpendScriptRequirements)]
   -- ^ Transaction inputs with optional spending scripts
   , readOnlyReferenceInputs :: ![TxIn]
   -- ^ Read only reference inputs
@@ -164,7 +166,7 @@ data TransactionBuildEstimateCmdArgs era = TransactionBuildEstimateCmdArgs
   -- ^ Transaction validity lower bound
   , mValidityUpperBound :: !(TxValidityUpperBound era)
   -- ^ Transaction validity upper bound
-  , certificates :: ![(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
+  , certificates :: ![(CertificateFile, Maybe CliCertificateScriptRequirements)]
   -- ^ Certificates with potential script witness
   , withdrawals :: ![(StakeAddress, Coin, Maybe (ScriptWitnessFiles WitCtxStake))]
   -- ^ Withdrawals with potential script witness