Skip to content

Commit

Permalink
Fix missing script proposals in transaction building
Browse files Browse the repository at this point in the history
  • Loading branch information
@carbolymer
carbolymer committed Jul 30, 2024
1 parent e4fdbbd commit 3ee255f
Show file tree
Hide file tree
Showing 2 changed files with 34 additions and 33 deletions.
7 changes: 3 additions & 4 deletions cardano-api/internal/Cardano/Api/Fees.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -249,10 +249,9 @@ estimateBalancedTxBody

proposalProcedures :: OSet.OSet (L.ProposalProcedure (ShelleyLedgerEra era))
proposalProcedures =
case unFeatured <$> txProposalProcedures txbodycontent1 of
Nothing -> OSet.empty
Just TxProposalProceduresNone -> OSet.empty
Just (TxProposalProcedures procedures _) -> procedures
maryEraOnwardsConstraints w $
maybe mempty (convProposalProcedures . unFeatured) $
txProposalProcedures txbodycontent1

totalDeposits :: L.Coin
totalDeposits =
Expand Down
60 changes: 31 additions & 29 deletions cardano-api/internal/Cardano/Api/Tx/Body.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,8 +16,6 @@
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}

{- HLINT ignore "Redundant bracket" -}

-- | Transaction bodies
module Cardano.Api.Tx.Body
( parseTxId
Expand Down Expand Up @@ -56,6 +54,7 @@ module Cardano.Api.Tx.Body
, setTxCertificates
, setTxUpdateProposal
, setTxProposalProcedures
, convProposalProcedures
, setTxVotingProcedures
, setTxMintValue
, setTxScriptValidity
Expand Down Expand Up @@ -1588,10 +1587,11 @@ validateTxBodyContent
} =
let witnesses = collectTxBodyScriptWitnesses sbe txBodContent
languages =
Set.fromList
fromList
[ toAlonzoLanguage (AnyPlutusScriptVersion v)
| (_, AnyScriptWitness (PlutusScriptWitness _ v _ _ _ _)) <- witnesses
]
:: Set Plutus.Language
in case sbe of
ShelleyBasedEraShelley -> do
validateTxIns txIns
Expand Down Expand Up @@ -2176,13 +2176,13 @@ classifyRangeError txout =
TxOut (AddressInEra (ShelleyAddressInEra sbe) ShelleyAddress{}) _ _ _ -> case sbe of {}

convTxIns :: TxIns BuildTx era -> Set (L.TxIn StandardCrypto)
convTxIns txIns = Set.fromList (map (toShelleyTxIn . fst) txIns)
convTxIns txIns = fromList (map (toShelleyTxIn . fst) txIns)

convCollateralTxIns :: TxInsCollateral era -> Set (Ledger.TxIn StandardCrypto)
convCollateralTxIns txInsCollateral =
case txInsCollateral of
TxInsCollateralNone -> Set.empty
TxInsCollateral _ txins -> Set.fromList (map toShelleyTxIn txins)
TxInsCollateral _ txins -> fromList (map toShelleyTxIn txins)

convReturnCollateral
:: ShelleyBasedEra era
Expand All @@ -2205,15 +2205,15 @@ convTxOuts
=> ShelleyBasedEra era
-> [TxOut ctx era]
-> Seq.StrictSeq (Ledger.TxOut ledgerera)
convTxOuts sbe txOuts = Seq.fromList $ map (toShelleyTxOutAny sbe) txOuts
convTxOuts sbe txOuts = fromList $ map (toShelleyTxOutAny sbe) txOuts

convCertificates
:: ShelleyBasedEra era
-> TxCertificates build era
-> Seq.StrictSeq (Shelley.TxCert (ShelleyLedgerEra era))
convCertificates _ = \case
TxCertificatesNone -> Seq.empty
TxCertificates _ cs _ -> Seq.fromList (map toShelleyCertificate cs)
TxCertificates _ cs _ -> fromList (map toShelleyCertificate cs)

convWithdrawals :: TxWithdrawals build era -> L.Withdrawals StandardCrypto
convWithdrawals txWithdrawals =
Expand Down Expand Up @@ -2266,7 +2266,7 @@ convExtraKeyWitnesses txExtraKeyWits =
case txExtraKeyWits of
TxExtraKeyWitnessesNone -> Set.empty
TxExtraKeyWitnesses _ khs ->
Set.fromList
fromList
[ Shelley.asWitness kh
| PaymentKeyHash kh <- khs
]
Expand Down Expand Up @@ -2294,7 +2294,7 @@ convScriptData sbe txOuts scriptWitnesses =
( \w ->
let redeemers =
Alonzo.Redeemers $
Map.fromList
fromList
[ (i, (toAlonzoData d, toAlonzoExUnits e))
| ( idx
, AnyScriptWitness
Expand All @@ -2306,7 +2306,7 @@ convScriptData sbe txOuts scriptWitnesses =

datums =
Alonzo.TxDats $
Map.fromList
fromList
[ (L.hashData d', d')
| d <- scriptdata
, let d' = toAlonzoData d
Expand Down Expand Up @@ -2350,7 +2350,7 @@ convPParamsToScriptIntegrityHash w txProtocolParams redeemers datums languages =

convLanguages :: [(ScriptWitnessIndex, AnyScriptWitness era)] -> Set Plutus.Language
convLanguages witnesses =
Set.fromList
fromList
[ toAlonzoLanguage (AnyPlutusScriptVersion v)
| (_, AnyScriptWitness (PlutusScriptWitness _ v _ _ _ _)) <- witnesses
]
Expand All @@ -2359,12 +2359,14 @@ convReferenceInputs :: TxInsReference build era -> Set (Ledger.TxIn StandardCryp
convReferenceInputs txInsReference =
case txInsReference of
TxInsReferenceNone -> mempty
TxInsReference _ refTxins -> Set.fromList $ map toShelleyTxIn refTxins
TxInsReference _ refTxins -> fromList $ map toShelleyTxIn refTxins

convProposalProcedures
:: TxProposalProcedures build era -> OSet (L.ProposalProcedure (ShelleyLedgerEra era))
convProposalProcedures TxProposalProceduresNone = OSet.empty
convProposalProcedures (TxProposalProcedures procedures _) = procedures
convProposalProcedures (TxProposalProcedures procedures ViewTx) = procedures
convProposalProcedures (TxProposalProcedures procedures (BuildTxWith proposalProceduresWithWitnesses)) =
procedures <> fromList (Map.keys proposalProceduresWithWitnesses)

convVotingProcedures :: TxVotingProcedures build era -> L.VotingProcedures (ShelleyLedgerEra era)
convVotingProcedures txVotingProcedures =
Expand Down Expand Up @@ -2604,7 +2606,7 @@ makeShelleyTransactionBody
datums :: Alonzo.TxDats StandardAlonzo
datums =
Alonzo.TxDats $
Map.fromList
fromList
[ (L.hashData d, d)
| d <- toAlonzoData <$> scriptdata
]
Expand All @@ -2630,7 +2632,7 @@ makeShelleyTransactionBody
redeemers :: Alonzo.Redeemers StandardAlonzo
redeemers =
Alonzo.Redeemers $
Map.fromList
fromList
[ (i, (toAlonzoData d, toAlonzoExUnits e))
| ( idx
, AnyScriptWitness
Expand All @@ -2642,7 +2644,7 @@ makeShelleyTransactionBody

languages :: Set Plutus.Language
languages =
Set.fromList
fromList
[ toAlonzoLanguage (AnyPlutusScriptVersion v)
| (_, AnyScriptWitness (PlutusScriptWitness _ v _ _ _ _)) <- witnesses
]
Expand Down Expand Up @@ -2684,7 +2686,7 @@ makeShelleyTransactionBody
& A.collateralInputsTxBodyL azOn
.~ case txInsCollateral of
TxInsCollateralNone -> Set.empty
TxInsCollateral _ txins -> Set.fromList (map toShelleyTxIn txins)
TxInsCollateral _ txins -> fromList (map toShelleyTxIn txins)
& A.referenceInputsTxBodyL bOn .~ convReferenceInputs txInsReference
& A.collateralReturnTxBodyL bOn .~ convReturnCollateral sbe txReturnCollateral
& A.totalCollateralTxBodyL bOn .~ convTotalCollateral txTotalCollateral
Expand Down Expand Up @@ -2729,7 +2731,7 @@ makeShelleyTransactionBody
datums :: Alonzo.TxDats StandardBabbage
datums =
Alonzo.TxDats $
Map.fromList
fromList
[ (L.hashData d', d')
| d <- scriptdata
, let d' = toAlonzoData d
Expand All @@ -2756,7 +2758,7 @@ makeShelleyTransactionBody
redeemers :: Alonzo.Redeemers StandardBabbage
redeemers =
Alonzo.Redeemers $
Map.fromList
fromList
[ (i, (toAlonzoData d, toAlonzoExUnits e))
| ( idx
, AnyScriptWitness
Expand All @@ -2768,7 +2770,7 @@ makeShelleyTransactionBody

languages :: Set Plutus.Language
languages =
Set.fromList $
fromList $
catMaybes
[ getScriptLanguage sw
| (_, AnyScriptWitness sw) <- witnesses
Expand Down Expand Up @@ -2818,7 +2820,7 @@ makeShelleyTransactionBody
& A.collateralInputsTxBodyL azOn
.~ case txInsCollateral of
TxInsCollateralNone -> Set.empty
TxInsCollateral _ txins -> Set.fromList (map toShelleyTxIn txins)
TxInsCollateral _ txins -> fromList (map toShelleyTxIn txins)
& A.referenceInputsTxBodyL bOn .~ convReferenceInputs txInsReference
& A.collateralReturnTxBodyL bOn .~ convReturnCollateral sbe txReturnCollateral
& A.totalCollateralTxBodyL bOn .~ convTotalCollateral txTotalCollateral
Expand All @@ -2833,8 +2835,8 @@ makeShelleyTransactionBody
& A.proposalProceduresTxBodyL cOn
.~ convProposalProcedures (maybe TxProposalProceduresNone unFeatured txProposalProcedures)
& A.currentTreasuryValueTxBodyL cOn
.~ (Ledger.maybeToStrictMaybe (unFeatured <$> txCurrentTreasuryValue))
& A.treasuryDonationTxBodyL cOn .~ (maybe (L.Coin 0) unFeatured txTreasuryDonation)
.~ Ledger.maybeToStrictMaybe (unFeatured <$> txCurrentTreasuryValue)
& A.treasuryDonationTxBodyL cOn .~ maybe (L.Coin 0) unFeatured txTreasuryDonation
-- TODO Conway: support optional network id in TxBodyContent
-- & L.networkIdTxBodyL .~ SNothing
)
Expand Down Expand Up @@ -2868,7 +2870,7 @@ makeShelleyTransactionBody
datums :: Alonzo.TxDats StandardConway
datums =
Alonzo.TxDats $
Map.fromList
fromList
[ (L.hashData d, d)
| d <- toAlonzoData <$> scriptdata
]
Expand All @@ -2894,7 +2896,7 @@ makeShelleyTransactionBody
redeemers :: Alonzo.Redeemers StandardConway
redeemers =
Alonzo.Redeemers $
Map.fromList
fromList
[ (i, (toAlonzoData d, toAlonzoExUnits e))
| ( idx
, AnyScriptWitness
Expand All @@ -2906,7 +2908,7 @@ makeShelleyTransactionBody

languages :: Set Plutus.Language
languages =
Set.fromList $
fromList $
catMaybes
[ getScriptLanguage sw
| (_, AnyScriptWitness sw) <- witnesses
Expand Down Expand Up @@ -3213,7 +3215,7 @@ orderStakeAddrs = sortBy (compare `on` (\(k, _, _) -> k))
toShelleyWithdrawal :: [(StakeAddress, L.Coin, a)] -> L.Withdrawals StandardCrypto
toShelleyWithdrawal withdrawals =
L.Withdrawals $
Map.fromList
fromList
[ (toShelleyStakeAddr stakeAddr, value)
| (stakeAddr, value, _) <- withdrawals
]
Expand Down Expand Up @@ -3245,9 +3247,9 @@ toAuxiliaryData sbe txMetadata txAuxScripts =
ShelleyBasedEraShelley ->
guard (not (Map.null ms)) $> L.ShelleyTxAuxData ms
ShelleyBasedEraAllegra ->
guard (not (Map.null ms && null ss)) $> L.AllegraTxAuxData ms (Seq.fromList ss)
guard (not (Map.null ms && null ss)) $> L.AllegraTxAuxData ms (fromList ss)
ShelleyBasedEraMary ->
guard (not (Map.null ms && null ss)) $> L.AllegraTxAuxData ms (Seq.fromList ss)
guard (not (Map.null ms && null ss)) $> L.AllegraTxAuxData ms (fromList ss)
ShelleyBasedEraAlonzo ->
guard (not (Map.null ms && null ss)) $> L.mkAlonzoTxAuxData ms ss
ShelleyBasedEraBabbage ->
Expand Down

0 comments on commit 3ee255f

Please sign in to comment.