Derive the dreps, pools and stake credentials to deregister from the

certificates in the transaction
IntersectMBO · Apr 25, 2024 · 4719b85 · 4719b85
1 parent 8c80def
commit 4719b85
Show file tree

Hide file tree

Showing 5 changed files with 147 additions and 64 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs
@@ -22,14 +22,12 @@ module Cardano.CLI.EraBased.Commands.Transaction
   ) where
 
 import           Cardano.Api.Ledger (Coin)
-import qualified Cardano.Api.Ledger as L
 import           Cardano.Api.Shelley
 
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Governance
 
 import           Data.Map.Strict (Map)
-import           Data.Set (Set)
 import           Data.Text (Text)
 
 data TransactionCmds era
@@ -126,15 +124,15 @@ data TransactionBuildCmdArgs era = TransactionBuildCmdArgs
   , scriptFiles             :: ![ScriptFile]
     -- ^ Auxiliary scripts
   , metadataFiles           :: ![MetadataFile]
-  , mUpdateProposalFile    :: !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)))
+  , mUpdateProposalFile     :: !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)))
   , voteFiles               :: ![(VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
   , proposalFiles           :: ![(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
   , buildOutputOptions      :: !TxBuildOutputOptions
   } deriving Show
 
 -- | Like 'TransactionBuildCmd' but does not require explicit access to a running node
 data TransactionBuildEstimateCmdArgs era = TransactionBuildEstimateCmdArgs
-  { eon                     :: !(ShelleyBasedEra era)
+  { eon                     :: !(MaryEraOnwards era)
   , mScriptValidity         :: !(Maybe ScriptValidity)
     -- ^ Mark script as expected to pass or fail validation
   , shelleyWitnesses        :: !Int
@@ -152,8 +150,6 @@ data TransactionBuildEstimateCmdArgs era = TransactionBuildEstimateCmdArgs
     -- ^ Transaction inputs for collateral, only key witnesses, no scripts.
   , mReturnCollateral       :: !(Maybe TxOutShelleyBasedEra)
     -- ^ Return collateral
-  , totalCollateral         :: !Coin
-    -- ^ Total collateral
   , txouts                  :: ![TxOutAnyEra]
     -- ^ Normal outputs
   , changeAddress           :: !TxOutChangeAddress
@@ -168,14 +164,8 @@ data TransactionBuildEstimateCmdArgs era = TransactionBuildEstimateCmdArgs
     -- ^ Certificates with potential script witness
   , withdrawals             :: ![(StakeAddress, Coin, Maybe (ScriptWitnessFiles WitCtxStake))]
     -- ^ Withdrawals with potential script witness
-  , drepsToDeregister       :: !(Map (L.Credential L.DRepRole L.StandardCrypto) L.Coin)
-    -- ^ Map of all deposits for drep credentials that are being
-    --   unregistered in this transaction
-  , stakeCredentialsToDeregister :: !(Map StakeCredential L.Coin)
-    -- ^ Map of all deposits for stake credentials that are being
-    --   unregistered in this transaction)
-  , plutusExecutionUnits     :: !(Map ScriptWitnessIndex ExecutionUnits)
-    -- ^ Plutus script execution units
+  , plutusCollateralAndExecutionUnits :: !(Maybe (Coin, Map ScriptWitnessIndex ExecutionUnits))
+    -- ^ Total collateral and plutus script execution units
   , totalReferenceScriptSize :: !(Maybe Int)
     -- ^ Size of all reference scripts in bytes
   , metadataSchema           :: !TxMetadataJsonSchema
@@ -185,7 +175,6 @@ data TransactionBuildEstimateCmdArgs era = TransactionBuildEstimateCmdArgs
   , mUpdateProposalFile      :: !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)))
   , voteFiles                :: ![(VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
   , proposalFiles            :: ![(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
-  , poolsToDeregister        :: !(Set PoolId)
   , txBodyOutFile            :: !(TxBodyFile Out)
   }
 

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs
@@ -3196,6 +3196,20 @@ pAlwaysNoConfidence =
     , Opt.help "Always vote no confidence"
     ]
 
+pDrepRefund :: Parser (DRepHashSource, L.Coin)
+pDrepRefund =
+  (,) <$> pDRepHashSource
+      <*> pDepositRefund
+
+pDepositRefund :: Parser L.Coin
+pDepositRefund =
+  Opt.option (readerFromParsecParser parseLovelace) $ mconcat
+    [ Opt.long "deposit-refund"
+    , Opt.metavar "LOVELACE"
+    , Opt.help "Deposit refund amount."
+    ]
+
+
 pDRepHashSource :: Parser DRepHashSource
 pDRepHashSource =
   asum

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs
@@ -49,7 +49,7 @@ pTransactionCmds era envCli =
                 ]
             ]
     , pTransactionBuildCmd era envCli
-    , pTransactionBuildEstimateCmd era envCli
+    , forShelleyBasedEraInEon era Nothing (`pTransactionBuildEstimateCmd` envCli)
     , Just
         $ subParser "sign"
         $ Opt.info (pTransactionSign envCli)
@@ -186,14 +186,14 @@ pTransactionBuildCmd era envCli = do
           <*> (OutputTxBodyOnly <$> pTxBodyFileOut <|> pCalculatePlutusScriptCost)
 
 -- | Estimate the transaction fees without access to a live node.
-pTransactionBuildEstimateCmd :: ShelleyBasedEra era -> EnvCli -> Maybe (Parser (TransactionCmds era))
+pTransactionBuildEstimateCmd :: MaryEraOnwards era -> EnvCli -> Maybe (Parser (TransactionCmds era))
 pTransactionBuildEstimateCmd era _envCli = do
   pure
     $ subParser "build-estimate"
     $ Opt.info (pCmd era)
     $ Opt.progDescDoc
     $ Just $ mconcat
-        [ pretty @String "Build a balanced transaction without access to a live node (automatically calculates fees)"
+        [ pretty @String "Build a balanced transaction without access to a live node (automatically estimates fees)"
         , line
         , line
         , H.yellow $ mconcat
@@ -204,10 +204,11 @@ pTransactionBuildEstimateCmd era _envCli = do
             ]
         ]
   where
-    pCmd :: ShelleyBasedEra era -> Parser (TransactionCmds era)
-    pCmd sbe =
+    pCmd :: MaryEraOnwards era -> Parser (TransactionCmds era)
+    pCmd w = do
+     let sbe = maryEraOnwardsToShelleyBasedEra w
      fmap TransactionBuildEstimateCmd $
-        TransactionBuildEstimateCmdArgs sbe
+        TransactionBuildEstimateCmdArgs w
           <$> optional pScriptValidity
           <*> pNumberOfShelleyKeyWitnesses
           <*> optional pNumberOfByronKeyWitnesses
@@ -218,19 +219,15 @@ pTransactionBuildEstimateCmd era _envCli = do
           <*> many pRequiredSigner
           <*> many pTxInCollateral
           <*> optional pReturnCollateral
-          <*> pTotalCollateral
           <*> many pTxOut
           <*> pChangeAddress
           <*> optional (pMintMultiAsset AutoBalance)
           <*> optional pInvalidBefore
           <*> pInvalidHereafter sbe
           <*> many (pCertificateFile AutoBalance)
           <*> many (pWithdrawal AutoBalance)
-          <*> pure mempty -- TODO: Dreps to deregister
-          <*> pure mempty -- TODO: Stake credentials to deregister
-          <*> pure mempty -- TOOD: Plutus execution units (Map ScriptWitnessIndex ExecutionUnits)
+          <*> optional ((,) <$> pTotalCollateral <*>  pure mempty) -- TOOD: Plutus execution units (Map ScriptWitnessIndex ExecutionUnits)
           <*> pure Nothing -- TODO: Total ref scripts size
-          --- dreps to register TODO:LEft off here
           <*> pTxMetadataJsonSchema
           <*> many (pScriptFor
                       "auxiliary-script-file"
@@ -240,7 +237,6 @@ pTransactionBuildEstimateCmd era _envCli = do
           <*> pFeatured (shelleyBasedToCardanoEra sbe) (optional pUpdateProposalFile)
           <*> pVoteFiles sbe AutoBalance
           <*> pProposalFiles sbe AutoBalance
-          <*> pure mempty -- TODO: Pools to deregister
           <*> pTxBodyFileOut