From bec437889363486d1fccf082dd8ccb5ceb971ca6 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 | 56 ++++++++----------- 12 files changed, 44 insertions(+), 68 deletions(-) diff --git a/hydra-cardano-api/hydra-cardano-api.cabal b/hydra-cardano-api/hydra-cardano-api.cabal index b828b96dae1..9479be20a7e 100644 --- a/hydra-cardano-api/hydra-cardano-api.cabal +++ b/hydra-cardano-api/hydra-cardano-api.cabal @@ -80,7 +80,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 7811c024ef1..0124434a5c2 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api.hs @@ -201,7 +201,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 @@ -579,11 +579,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 492a479f581..80074c52186 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/Pretty.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/Pretty.hs @@ -104,9 +104,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 92427c32e70..8e219346f5e 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/Value.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/Value.hs @@ -48,15 +48,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 fbf72ad4ea5..5feddb73821 100644 --- a/hydra-node/src/Hydra/Chain/CardanoClient.hs +++ b/hydra-node/src/Hydra/Chain/CardanoClient.hs @@ -89,7 +89,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 c9395c70dd5..e801926fef0 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs @@ -214,7 +214,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 7b7d12f9b80..6d1ead18c48 100644 --- a/hydra-tx/hydra-tx.cabal +++ b/hydra-tx/hydra-tx.cabal @@ -119,6 +119,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..8b6c340fc97 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 7525f672d01..2aa2fce00f6 100644 --- a/hydra-tx/testlib/Test/Hydra/Tx/Mutation.hs +++ b/hydra-tx/testlib/Test/Hydra/Tx/Mutation.hs @@ -130,6 +130,7 @@ module Test.Hydra.Tx.Mutation where import Hydra.Cardano.Api +import Cardano.Api.Plutus (DebugPlutusFailure (..)) import Cardano.Api.UTxO qualified as UTxO import Cardano.Ledger.Alonzo.Scripts qualified as Ledger import Cardano.Ledger.Alonzo.TxWits qualified as Ledger @@ -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 @@ -692,50 +693,37 @@ alterTxOuts fn tx = -- | 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 - -- 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 - (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 + 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 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 $ 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 @@ -957,9 +945,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 =