Skip to content

Commit

Permalink
Upgrade cardano-api-10.8. Fix costs calculation for transaction with …
Browse files Browse the repository at this point in the history
…more than one certificates with the same stake credential and script witness.
  • Loading branch information
carbolymer committed Feb 3, 2025
1 parent 7146c85 commit 1fc22fe
Show file tree
Hide file tree
Showing 6 changed files with 11 additions and 52 deletions.
2 changes: 1 addition & 1 deletion cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@ repository cardano-haskell-packages
-- you need to run if you change them
index-state:
, hackage.haskell.org 2024-12-24T12:56:48Z
, cardano-haskell-packages 2025-01-15T09:59:24Z
, cardano-haskell-packages 2025-02-01T07:12:29Z

packages:
cardano-cli
Expand Down
2 changes: 1 addition & 1 deletion cardano-cli/cardano-cli.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -212,7 +212,7 @@ library
binary,
bytestring,
canonical-json,
cardano-api ^>=10.6,
cardano-api ^>=10.8,
cardano-binary,
cardano-crypto,
cardano-crypto-class ^>=2.1.2,
Expand Down
20 changes: 1 addition & 19 deletions cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,6 @@ 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

Expand Down Expand Up @@ -300,7 +299,7 @@ runCompatibleTransactionCmd
validatedRefInputs <-
liftEither . first CompatibleTxCmdError . validateTxInsReference $
certsRefInputs <> votesRefInputs <> proposalsRefInputs
let txCerts = convertCertificates certsAndMaybeScriptWits
let txCerts = mkTxCertificates sbe certsAndMaybeScriptWits

-- this body is only for witnesses
apiTxBody <-
Expand Down Expand Up @@ -331,23 +330,6 @@ runCompatibleTransactionCmd
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)
Expand Down
31 changes: 4 additions & 27 deletions cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -82,7 +82,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, mapMaybe, maybeToList)
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Text as Text
Expand Down Expand Up @@ -954,7 +954,7 @@ constructTxBodyContent
& setTxExtraKeyWits validatedReqSigners
& setTxProtocolParams (BuildTxWith $ LedgerProtocolParameters <$> mPparams)
& setTxWithdrawals (TxWithdrawals sbe $ map convertWithdrawals withdrawals)
& setTxCertificates (convertCertificates sbe certsAndMaybeScriptWits)
& setTxCertificates (mkTxCertificates sbe certsAndMaybeScriptWits)
& setTxUpdateProposal txUpdateProposal
& setTxMintValue validatedMintValue
& setTxScriptValidity validatedTxScriptValidity
Expand Down Expand Up @@ -1071,15 +1071,11 @@ runTxBuild
testEquality era nodeEra
& hoistMaybe (TxCmdTxNodeEraMismatchError $ NodeEraMismatchError era nodeEra)

let certs =
case convertCertificates sbe certsAndMaybeScriptWits of
TxCertificates _ cs _ -> cs
_ -> []

let certsToQuery = fst <$> certsAndMaybeScriptWits
(txEraUtxo, pparams, eraHistory, systemStart, stakePools, stakeDelegDeposits, drepDelegDeposits, _) <-
lift
( executeLocalStateQueryExpr localNodeConnInfo Consensus.VolatileTip $
queryStateForBalancedTx nodeEra allTxInputs certs
queryStateForBalancedTx nodeEra allTxInputs certsToQuery
)
& onLeft (left . TxCmdQueryConvenienceError . AcqFailure)
& onLeft (left . TxCmdQueryConvenienceError)
Expand Down Expand Up @@ -1140,25 +1136,6 @@ 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 = fromList $ mapMaybe convertCert certsAndScriptWitnesses
convertCert
:: (Certificate era, Maybe (ScriptWitness WitCtxStake era))
-> Maybe (StakeCredential, Witness WitCtxStake era)
convertCert (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
--
Expand Down
2 changes: 1 addition & 1 deletion cardano-cli/src/Cardano/CLI/Json/Friendly.hs
Original file line number Diff line number Diff line change
Expand Up @@ -626,7 +626,7 @@ friendlyPrices ExecutionUnitPrices{priceExecutionMemory, priceExecutionSteps} =
friendlyCertificates :: ShelleyBasedEra era -> TxCertificates ViewTx era -> Aeson.Value
friendlyCertificates sbe = \case
TxCertificatesNone -> Null
TxCertificates _ cs _ -> array $ map (friendlyCertificate sbe) cs
TxCertificates _ cs -> array $ map (friendlyCertificate sbe . fst) $ toList cs

friendlyCertificate :: ShelleyBasedEra era -> Certificate era -> Aeson.Value
friendlyCertificate sbe =
Expand Down
6 changes: 3 additions & 3 deletions flake.lock

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 1fc22fe

Please sign in to comment.