From 2ccb88b8aef5844fb010bc09e319f308ea52742e Mon Sep 17 00:00:00 2001 From: Daniel Firth Date: Sat, 7 Dec 2024 13:37:47 +0000 Subject: [PATCH] cardano-api: 10.3 --- hydra-cardano-api/hydra-cardano-api.cabal | 2 +- hydra-cardano-api/src/Hydra/Cardano/Api.hs | 9 ++-- .../src/Hydra/Cardano/Api/Pretty.hs | 4 +- .../src/Hydra/Cardano/Api/Value.hs | 9 ---- .../src/Hydra/Cardano/Api/Witness.hs | 2 +- hydra-node/src/Hydra/Chain/CardanoClient.hs | 2 +- hydra-node/src/Hydra/Chain/Direct/Tx.hs | 2 +- .../src/Hydra/Plutus/Extras.hs | 3 +- hydra-tx/hydra-tx.cabal | 1 + hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs | 16 +++---- hydra-tx/test/Hydra/Tx/Contract/FanOut.hs | 6 +-- hydra-tx/testlib/Test/Hydra/Tx/Mutation.hs | 43 +++++++------------ 12 files changed, 37 insertions(+), 62 deletions(-) diff --git a/hydra-cardano-api/hydra-cardano-api.cabal b/hydra-cardano-api/hydra-cardano-api.cabal index 85fe695a9ef..8847c16fed9 100644 --- a/hydra-cardano-api/hydra-cardano-api.cabal +++ b/hydra-cardano-api/hydra-cardano-api.cabal @@ -81,7 +81,7 @@ library , base >=4.16 , base16-bytestring , bytestring - , cardano-api ^>=10.2 + , cardano-api ^>=10.3 , cardano-binary , cardano-crypto-class , cardano-ledger-allegra diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api.hs b/hydra-cardano-api/src/Hydra/Cardano/Api.hs index b2c979a157d..5820e1c64a5 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api.hs @@ -202,7 +202,7 @@ pattern ShelleyAddressInAnyEra <- type BalancedTxBody = Cardano.Api.BalancedTxBody Era {-# COMPLETE BalancedTxBody #-} -pattern BalancedTxBody :: TxBodyContent BuildTx -> UnsignedTx Era -> TxOut CtxTx -> Coin -> BalancedTxBody +pattern BalancedTxBody :: TxBodyContent BuildTx -> TxBody -> TxOut CtxTx -> Coin -> BalancedTxBody pattern BalancedTxBody{balancedTxBodyContent, balancedTxBody, balancedTxChangeOutput, balancedTxFee} <- Cardano.Api.BalancedTxBody balancedTxBodyContent balancedTxBody balancedTxChangeOutput balancedTxFee where @@ -580,11 +580,10 @@ pattern TxMintValueNone <- Cardano.Api.TxMintNone pattern TxMintValue :: - Value -> - BuildTxWith buidl (Map PolicyId (ScriptWitness WitCtxMint)) -> + Map PolicyId [(AssetName, Quantity, BuildTxWith buidl (ScriptWitness WitCtxMint))] -> TxMintValue buidl -pattern TxMintValue{txMintValueInEra, txMintValueScriptWitnesses} <- - Cardano.Api.TxMintValue _ txMintValueInEra txMintValueScriptWitnesses +pattern TxMintValue{txMintValueInEra} <- + Cardano.Api.TxMintValue _ txMintValueInEra where TxMintValue = Cardano.Api.TxMintValue maryBasedEra diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/Pretty.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/Pretty.hs index 38e835916a9..797f89f0816 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/Pretty.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/Pretty.hs @@ -107,9 +107,7 @@ renderTxWithUTxO utxo (Tx body _wits) = ] mintLines = - [ "== MINT/BURN\n" <> case txMintValue content of - Api.TxMintValueNone -> "[]" - Api.TxMintValue val _ -> prettyValue 0 val + [ "== MINT/BURN\n" <> prettyValue 0 (txMintValueToValue $ txMintValue content) ] prettyValue n = diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/Value.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/Value.hs index 2ab7edb29b6..6080aa7b480 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/Value.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/Value.hs @@ -49,15 +49,6 @@ minUTxOValue pparams (TxOut addr val dat ref) = valueSize :: Value -> Int valueSize = length . toList --- | Access minted assets of a transaction, as an ordered association list. -txMintAssets :: Tx era -> [(AssetId, Quantity)] -txMintAssets = - asList . txMintValue . getTxBodyContent . getTxBody - where - asList = \case - TxMintNone -> [] - TxMintValue _ val _ -> toList val - -- * Type Conversions -- | Convert a cardano-ledger 'Value' into a cardano-api 'Value'. diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/Witness.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/Witness.hs index 9e3b75fd217..dda9e9e35c5 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/Witness.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/Witness.hs @@ -38,7 +38,7 @@ mkScriptReference txIn _script datum redeemer = PlutusScriptWitness (scriptLanguageInEra @lang @era) (plutusScriptVersion @lang) - (PReferenceScript txIn Nothing) + (PReferenceScript txIn) datum redeemer (ExecutionUnits 0 0) diff --git a/hydra-node/src/Hydra/Chain/CardanoClient.hs b/hydra-node/src/Hydra/Chain/CardanoClient.hs index fbf46328e4f..2a6ec10222f 100644 --- a/hydra-node/src/Hydra/Chain/CardanoClient.hs +++ b/hydra-node/src/Hydra/Chain/CardanoClient.hs @@ -102,7 +102,7 @@ buildTransaction networkId socket changeAddress utxoToSpend collateral outs = do eraHistory <- queryEraHistory networkId socket QueryTip stakePools <- queryStakePools networkId socket QueryTip pure $ - second ((\(UnsignedTx unsignedTx) -> fromLedgerTx unsignedTx) . balancedTxBody) $ + second (flip Tx [] . balancedTxBody) $ makeTransactionBodyAutoBalance shelleyBasedEra systemStart diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs index 83d05ce413f..f78578c79ab 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs @@ -228,7 +228,7 @@ observeInitTx tx = do mintedTokenNames pid = [ assetName - | (AssetId policyId assetName, q) <- txMintAssets tx + | (AssetId policyId assetName, q) <- toList $ txMintValueToValue $ txMintValue $ getTxBodyContent $ getTxBody tx , q == 1 -- NOTE: Only consider unique tokens , policyId == pid , assetName /= hydraHeadV1AssetName diff --git a/hydra-plutus-extras/src/Hydra/Plutus/Extras.hs b/hydra-plutus-extras/src/Hydra/Plutus/Extras.hs index bf0b4de8ddf..29105297447 100644 --- a/hydra-plutus-extras/src/Hydra/Plutus/Extras.hs +++ b/hydra-plutus-extras/src/Hydra/Plutus/Extras.hs @@ -10,6 +10,7 @@ import Hydra.Prelude import Hydra.Plutus.Extras.Time import Cardano.Api ( + IsPlutusScriptLanguage, PlutusScriptVersion, SerialiseAsRawBytes (serialiseToRawBytes), hashScript, @@ -77,7 +78,7 @@ wrapMintingPolicy f c = -- | Compute the on-chain 'ScriptHash' for a given serialised plutus script. Use -- this to refer to another validator script. -scriptValidatorHash :: PlutusScriptVersion lang -> SerialisedScript -> ScriptHash +scriptValidatorHash :: IsPlutusScriptLanguage lang => PlutusScriptVersion lang -> SerialisedScript -> ScriptHash scriptValidatorHash version = ScriptHash . toBuiltin diff --git a/hydra-tx/hydra-tx.cabal b/hydra-tx/hydra-tx.cabal index f0e842c32c1..83fafc97a5a 100644 --- a/hydra-tx/hydra-tx.cabal +++ b/hydra-tx/hydra-tx.cabal @@ -121,6 +121,7 @@ library testlib build-depends: , base , bytestring + , cardano-api:{internal} , cardano-crypto-class , cardano-ledger-alonzo , cardano-ledger-api diff --git a/hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs b/hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs index 255f2e11056..d6ecfb1ca15 100644 --- a/hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs +++ b/hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs @@ -117,20 +117,18 @@ addExtraRequiredSigners vks tx = -- | Mint tokens with given plutus minting script and redeemer. mintTokens :: ToScriptData redeemer => PlutusScript -> redeemer -> [(AssetName, Quantity)] -> TxBodyContent BuildTx -> TxBodyContent BuildTx mintTokens script redeemer assets tx = - tx{txMintValue = TxMintValue mintedTokens' mintedWitnesses'} + tx{txMintValue = TxMintValue mintedTokens'} where - (mintedTokens, mintedWitnesses) = + mintedTokens = case txMintValue tx of - TxMintValueNone -> - (mempty, mempty) - TxMintValue t (BuildTxWith m) -> - (t, m) + TxMintValueNone -> mempty + TxMintValue t -> t mintedTokens' = - mintedTokens <> fromList (fmap (first (AssetId policyId)) assets) + Map.union mintedTokens newTokens - mintedWitnesses' = - BuildTxWith $ mintedWitnesses <> Map.singleton policyId mintingWitness + newTokens = + Map.fromList $ [(policyId, fmap (\(x, y) -> (x, y, BuildTxWith mintingWitness)) assets)] mintingWitness = mkScriptWitness script NoScriptDatumForMint (toScriptData redeemer) diff --git a/hydra-tx/test/Hydra/Tx/Contract/FanOut.hs b/hydra-tx/test/Hydra/Tx/Contract/FanOut.hs index ec76f61ea69..991cf4ce618 100644 --- a/hydra-tx/test/Hydra/Tx/Contract/FanOut.hs +++ b/hydra-tx/test/Hydra/Tx/Contract/FanOut.hs @@ -146,8 +146,8 @@ genFanoutMutation (tx, _utxo) = ] where burntTokens = - case txMintValue $ txBodyContent $ txBody tx of - TxMintValueNone -> error "expected minted value" - TxMintValue v _ -> toList v + case toList . txMintValueToValue . txMintValue $ txBodyContent $ txBody tx of + [] -> error "expected minted value" + v -> v genSlotBefore (SlotNo slot) = SlotNo <$> choose (0, slot) diff --git a/hydra-tx/testlib/Test/Hydra/Tx/Mutation.hs b/hydra-tx/testlib/Test/Hydra/Tx/Mutation.hs index fbcfe716007..7e6426bde67 100644 --- a/hydra-tx/testlib/Test/Hydra/Tx/Mutation.hs +++ b/hydra-tx/testlib/Test/Hydra/Tx/Mutation.hs @@ -131,6 +131,7 @@ module Test.Hydra.Tx.Mutation where import Hydra.Cardano.Api import Cardano.Api.UTxO qualified as UTxO +import Cardano.Api.Plutus (DebugPlutusFailure(..)) import Cardano.Ledger.Alonzo.Scripts qualified as Ledger import Cardano.Ledger.Alonzo.TxWits qualified as Ledger import Cardano.Ledger.Api (AllegraEraTxBody (vldtTxBodyL), AsIx (..), inputsTxBodyL, mintTxBodyL, outputsTxBodyL, reqSignerHashesTxBodyL) @@ -213,7 +214,7 @@ propTransactionFailsPhase2 mExpectedError (tx, lookupUTxO) = where matchesErrorMessage :: Text -> ScriptExecutionError -> Bool matchesErrorMessage errMsg = \case - ScriptErrorEvaluationFailed _ errList -> errMsg `elem` errList + ScriptErrorEvaluationFailed (DebugPlutusFailure{dpfExecutionLogs}) -> errMsg `elem` dpfExecutionLogs _otherScriptExecutionError -> False -- * Mutations @@ -702,50 +703,36 @@ headTxIn = fst . Prelude.head . filter (isHeadOutput . snd) . UTxO.pairs -- | A 'Mutation' that changes the minted/burnt quantity of all tokens to a -- non-zero value different than the given one. changeMintedValueQuantityFrom :: Tx -> Integer -> Gen Mutation -changeMintedValueQuantityFrom tx exclude = - ChangeMintedValue - <$> case mintedValue of - TxMintValueNone -> - pure mempty - TxMintValue v _ -> do - someQuantity <- fromInteger <$> arbitrary `suchThat` (/= exclude) `suchThat` (/= 0) - pure . fromList $ map (second $ const someQuantity) $ toList v +changeMintedValueQuantityFrom tx exclude = do + someQuantity <- fromInteger <$> arbitrary `suchThat` (/= exclude) `suchThat` (/= 0) + pure $ ChangeMintedValue $ fromList $ map (second $ const someQuantity) $ toList mintedValue where - mintedValue = txMintValue $ txBodyContent $ txBody tx + mintedValue = txMintValueToValue $ txMintValue $ txBodyContent $ txBody tx -- | A 'Mutation' that changes the minted/burned quantity of tokens like this: -- - when no value is being minted/burned -> add a value -- - when tx is minting or burning values -> add more values on top of that changeMintedTokens :: Tx -> Value -> Gen Mutation changeMintedTokens tx mintValue = - ChangeMintedValue - <$> case mintedValue of - TxMintValueNone -> - pure mintValue - TxMintValue v _ -> - pure $ v <> mintValue + pure $ ChangeMintedValue $ mintedValue <> mintValue where - mintedValue = txMintValue $ txBodyContent $ txBody tx + mintedValue = txMintValueToValue $ txMintValue $ txBodyContent $ txBody tx -- | A `Mutation` that adds an `Arbitrary` participation token with some quantity. -- As usual the quantity can be positive for minting, or negative for burning. addPTWithQuantity :: Tx -> Quantity -> Gen Mutation addPTWithQuantity tx quantity = - ChangeMintedValue <$> do - case mintedValue of - TxMintValue v _ -> do + ChangeMintedValue <$> -- NOTE: We do not expect Ada or any other assets to be minted, so -- we can take the policy id from the head - case Prelude.head $ toList v of + case Prelude.head $ toList mintedValue of (AdaAssetId, _) -> error "unexpected mint of Ada" (AssetId pid _an, _) -> do -- Some arbitrary token name, which could correspond to a pub key hash pkh <- arbitrary - pure $ v <> fromList [(AssetId pid pkh, quantity)] - TxMintValueNone -> - pure mempty + pure $ mintedValue <> fromList [(AssetId pid pkh, quantity)] where - mintedValue = txMintValue $ txBodyContent $ txBody tx + mintedValue = txMintValueToValue $ txMintValue $ txBodyContent $ txBody tx -- | Replace first given 'PolicyId' with the second argument in the whole 'TxOut' value. replacePolicyIdWith :: PolicyId -> PolicyId -> TxOut a -> TxOut a @@ -967,9 +954,9 @@ replaceContesters contesters = \case removePTFromMintedValue :: TxOut CtxUTxO -> Tx -> Value removePTFromMintedValue output tx = - case txMintValue $ txBodyContent $ txBody tx of - TxMintValueNone -> error "expected minted value" - TxMintValue v _ -> fromList $ filter (not . isPT) $ toList v + case toList $ txMintValueToValue $ txMintValue $ txBodyContent $ txBody tx of + [] -> error "expected minted value" + v -> fromList $ filter (not . isPT) $ v where outValue = txOutValue output assetNames =