Skip to content

Commit

Permalink
cardano-api: 10.3
Browse files Browse the repository at this point in the history
  • Loading branch information
locallycompact committed Dec 7, 2024
1 parent 79794f9 commit 2ccb88b
Show file tree
Hide file tree
Showing 12 changed files with 37 additions and 62 deletions.
2 changes: 1 addition & 1 deletion hydra-cardano-api/hydra-cardano-api.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
9 changes: 4 additions & 5 deletions hydra-cardano-api/src/Hydra/Cardano/Api.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
4 changes: 1 addition & 3 deletions hydra-cardano-api/src/Hydra/Cardano/Api/Pretty.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
9 changes: 0 additions & 9 deletions hydra-cardano-api/src/Hydra/Cardano/Api/Value.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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'.
Expand Down
2 changes: 1 addition & 1 deletion hydra-cardano-api/src/Hydra/Cardano/Api/Witness.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
2 changes: 1 addition & 1 deletion hydra-node/src/Hydra/Chain/CardanoClient.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion hydra-node/src/Hydra/Chain/Direct/Tx.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 2 additions & 1 deletion hydra-plutus-extras/src/Hydra/Plutus/Extras.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@ import Hydra.Prelude
import Hydra.Plutus.Extras.Time

import Cardano.Api (
IsPlutusScriptLanguage,
PlutusScriptVersion,
SerialiseAsRawBytes (serialiseToRawBytes),
hashScript,
Expand Down Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions hydra-tx/hydra-tx.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -121,6 +121,7 @@ library testlib
build-depends:
, base
, bytestring
, cardano-api:{internal}
, cardano-crypto-class
, cardano-ledger-alonzo
, cardano-ledger-api
Expand Down
16 changes: 7 additions & 9 deletions hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
6 changes: 3 additions & 3 deletions hydra-tx/test/Hydra/Tx/Contract/FanOut.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
43 changes: 15 additions & 28 deletions hydra-tx/testlib/Test/Hydra/Tx/Mutation.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand Down

0 comments on commit 2ccb88b

Please sign in to comment.