diff --git a/CHANGELOG.md b/CHANGELOG.md index ecfb40bf62d..968a1ac3f4e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -21,6 +21,7 @@ changes. - Remove Commit client input since it is unused - Revisit types related to observations/posting transactions and make sure the fields are named appropriatelly + - Tested with `cardano-node 9.2.0` and `cardano-cli 9.4.1.0`. - **BREAKING** Rewrite of the commit script in aiken: @@ -28,6 +29,8 @@ changes. in a new maximum number of head participants being `8`. - Changes script hashes in `hydra-plutus` +- Fix the bug where commit endpoint drops withdraw redeemers [#1643](https://github.com/cardano-scaling/hydra/issues/1643) + ## [0.19.0] - 2024-09-13 - Tested with `cardano-node 9.1.1` and `cardano-cli 9.2.1.0` diff --git a/hydra-cardano-api/hydra-cardano-api.cabal b/hydra-cardano-api/hydra-cardano-api.cabal index 04e94a7c733..ae08ed5aa2e 100644 --- a/hydra-cardano-api/hydra-cardano-api.cabal +++ b/hydra-cardano-api/hydra-cardano-api.cabal @@ -61,6 +61,7 @@ library Hydra.Cardano.Api.ScriptData Hydra.Cardano.Api.ScriptDatum Hydra.Cardano.Api.ScriptHash + Hydra.Cardano.Api.StakeAddress Hydra.Cardano.Api.Tx Hydra.Cardano.Api.TxBody Hydra.Cardano.Api.TxId diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api.hs b/hydra-cardano-api/src/Hydra/Cardano/Api.hs index f6a3136d150..fbd78eb78ac 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api.hs @@ -141,6 +141,7 @@ import Hydra.Cardano.Api.ReferenceScript as Extras import Hydra.Cardano.Api.ScriptData as Extras import Hydra.Cardano.Api.ScriptDatum as Extras import Hydra.Cardano.Api.ScriptHash as Extras +import Hydra.Cardano.Api.StakeAddress as Extras import Hydra.Cardano.Api.Tx as Extras hiding (Tx) import Hydra.Cardano.Api.TxBody as Extras import Hydra.Cardano.Api.TxId as Extras diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/StakeAddress.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/StakeAddress.hs new file mode 100644 index 00000000000..2561118bd74 --- /dev/null +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/StakeAddress.hs @@ -0,0 +1,15 @@ +module Hydra.Cardano.Api.StakeAddress where + +import Hydra.Cardano.Api.Prelude + +-- | Construct a stake address from a Plutus script. +mkScriptStakeAddress :: + forall lang. + IsPlutusScriptLanguage lang => + NetworkId -> + PlutusScript lang -> + StakeAddress +mkScriptStakeAddress networkId script = + makeStakeAddress networkId $ StakeCredentialByScript $ hashScript $ PlutusScript version script + where + version = plutusScriptVersion @lang diff --git a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs index 4a7db82bd6a..fbcdca7670d 100644 --- a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs @@ -9,7 +9,7 @@ import Cardano.Api.UTxO qualified as UTxO import Cardano.Ledger.Alonzo.Core (EraTxAuxData (hashTxAuxData)) import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..)) import Cardano.Ledger.Api ( - ConwayPlutusPurpose (ConwaySpending), + ConwayPlutusPurpose (ConwayRewarding, ConwaySpending), Metadatum, auxDataHashTxBodyL, auxDataTxL, @@ -83,6 +83,7 @@ import Test.QuickCheck ( cover, forAll, forAllBlind, + oneof, property, vectorOf, (.&&.), @@ -186,6 +187,9 @@ spec = & counterexample "Validity range mismatch" , (blueprintBody ^. inputsTxBodyL) `propIsSubsetOf` (commitTxBody ^. inputsTxBodyL) & counterexample "Blueprint inputs missing" + , length (toLedgerTx blueprintTx ^. witsTxL . rdmrsTxWitsL & unRedeemers) + 1 + === length (toLedgerTx createdTx ^. witsTxL . rdmrsTxWitsL & unRedeemers) + & counterexample "Blueprint witnesses missing" , property ((`all` (blueprintBody ^. outputsTxBodyL)) (`notElem` (commitTxBody ^. outputsTxBodyL))) & counterexample "Blueprint outputs not discarded" @@ -233,6 +237,7 @@ genBlueprintTxWithUTxO = >>= addValidityRange >>= addRandomMetadata >>= addCollateralInput + >>= sometimesAddRewardRedeemer where spendingPubKeyOutput (utxo, txbody) = do utxoToSpend <- genUTxOAdaOnlyOfSize =<< choose (0, 3) @@ -287,6 +292,31 @@ genBlueprintTxWithUTxO = , txbody{txInsCollateral = TxInsCollateral $ toList (UTxO.inputSet utxoToSpend)} ) + sometimesAddRewardRedeemer (utxo, txbody) = + oneof + [ pure (utxo, txbody) + , do + lovelace <- arbitrary + let scriptWitness = mkScriptWitness alwaysSucceedingScript NoScriptDatumForStake redeemer + alwaysSucceedingScript = PlutusScriptSerialised $ Plutus.alwaysSucceedingNAryFunction 2 + redeemer = toScriptData (123 :: Integer) + stakeAddress = mkScriptStakeAddress testNetworkId alwaysSucceedingScript + pure + ( utxo + , txbody + & setTxWithdrawals + ( TxWithdrawals + shelleyBasedEra + [ + ( stakeAddress + , lovelace + , BuildTxWith $ ScriptWitness ScriptWitnessForStakeAddr scriptWitness + ) + ] + ) + ) + ] + genMetadata :: Gen TxMetadataInEra genMetadata = do genMetadata' @LedgerEra >>= \(ShelleyTxAuxData m) -> @@ -307,7 +337,18 @@ prop_interestingBlueprintTx = do & cover 1 (spendsFromPubKey (utxo, tx)) "blueprint spends pub key UTxO" & cover 1 (spendsFromPubKey (utxo, tx) && spendsFromScript (utxo, tx)) "blueprint spends from script AND pub key" & cover 1 (hasReferenceInputs tx) "blueprint has reference input" + & cover 1 (hasRewardRedeemer tx) "blueprint has reward redeemer" where + hasRewardRedeemer tx = + toLedgerTx tx ^. witsTxL . rdmrsTxWitsL + & unRedeemers @LedgerEra + & Map.keysSet + & any + ( \case + ConwayRewarding _ -> True + _ -> False + ) + hasReferenceInputs tx = not . null $ toLedgerTx tx ^. bodyTxL . referenceInputsTxBodyL diff --git a/hydra-tx/src/Hydra/Tx/Commit.hs b/hydra-tx/src/Hydra/Tx/Commit.hs index 723651e5a3a..d5cb4069d73 100644 --- a/hydra-tx/src/Hydra/Tx/Commit.hs +++ b/hydra-tx/src/Hydra/Tx/Commit.hs @@ -76,21 +76,22 @@ commitTx networkId scriptRegistry headId party commitBlueprintTx (initialInput, in tx & bodyTxL . inputsTxBodyL .~ newInputs & bodyTxL . referenceInputsTxBodyL <>~ Set.singleton (toLedgerTxIn initialScriptRef) - & witsTxL . rdmrsTxWitsL .~ mkRedeemers newRedeemers newInputs + & witsTxL . rdmrsTxWitsL + .~ Redeemers (fromList $ nonSpendingRedeemers tx) + <> Redeemers (fromList $ mkRedeemers newRedeemers newInputs) -- Make redeemers (with zeroed units) from a TxIn -> Data map and a set of transaction inputs mkRedeemers resolved inputs = - Redeemers . Map.fromList $ - foldl' - ( \newRedeemerData txin -> - let ix = fromIntegral $ Set.findIndex txin inputs - in case Map.lookup txin resolved of - Nothing -> newRedeemerData - Just d -> - (ConwaySpending (AsIx ix), (d, ExUnits 0 0)) : newRedeemerData - ) - [] - inputs + foldl' + ( \newRedeemerData txin -> + let ix = fromIntegral $ Set.findIndex txin inputs + in case Map.lookup txin resolved of + Nothing -> newRedeemerData + Just d -> + (ConwaySpending (AsIx ix), (d, ExUnits 0 0)) : newRedeemerData + ) + [] + inputs -- Create a TxIn -> Data map of all spending redeemers resolveSpendingRedeemers tx = @@ -103,6 +104,19 @@ commitTx networkId scriptRegistry headId party commitBlueprintTx (initialInput, ) (unRedeemers $ tx ^. witsTxL . rdmrsTxWitsL) + nonSpendingRedeemers tx = + Map.foldMapWithKey + ( \p (d, ex) -> + case redeemerPointerInverse (tx ^. bodyTxL) p of + SJust (ConwayMinting (AsIxItem i _)) -> [(ConwayMinting (AsIx i), (d, ex))] + SJust (ConwayRewarding (AsIxItem i _)) -> [(ConwayRewarding (AsIx i), (d, ex))] + SJust (ConwayCertifying (AsIxItem i _)) -> [(ConwayCertifying (AsIx i), (d, ex))] + SJust (ConwayProposing (AsIxItem i _)) -> [(ConwayProposing (AsIx i), (d, ex))] + SJust (ConwayVoting (AsIxItem i _)) -> [(ConwayVoting (AsIx i), (d, ex))] + SJust (ConwaySpending (AsIxItem _ _)) -> [] + SNothing -> [] + ) + (unRedeemers $ tx ^. witsTxL . rdmrsTxWitsL) initialScriptRef = fst (initialReference scriptRegistry)