diff --git a/hydra-cluster/test/Test/DirectChainSpec.hs b/hydra-cluster/test/Test/DirectChainSpec.hs index ccf97e2b07e..def86716047 100644 --- a/hydra-cluster/test/Test/DirectChainSpec.hs +++ b/hydra-cluster/test/Test/DirectChainSpec.hs @@ -524,10 +524,10 @@ externalCommit :: HeadId -> UTxO' (TxOut CtxUTxO) -> IO () -externalCommit node hydraClient externalSk headId utxoToCommit' = do - let utxoToCommit = utxoToTxOutWithWitness utxoToCommit' - blueprintTx = mkBlueprintTx utxoToCommit - utxo = utxoFromTxOutWithWitness utxoToCommit +externalCommit node hydraClient externalSk headId utxoToCommit = do + let utxoToCommit' = utxoToTxOutWithWitness utxoToCommit + blueprintTx = mkBlueprintTx utxoToCommit' + utxo = utxoFromTxOutWithWitness utxoToCommit' commitTx <- draftCommitTx headId utxo blueprintTx let signedTx = signTx externalSk commitTx submitTx node signedTx diff --git a/hydra-node/src/Hydra/Chain/Direct/Handlers.hs b/hydra-node/src/Hydra/Chain/Direct/Handlers.hs index c2db2275e4a..2d7d107162b 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Handlers.hs @@ -193,14 +193,14 @@ finalizeTx TinyWallet{sign, coverFee} ctx utxo userUTxO partialTx = do throwIO (NoFuelUTXOFound :: PostTxError Tx) Left ErrNotEnoughFunds{} -> throwIO (NotEnoughFuel :: PostTxError Tx) - Left ErrScriptExecutionFailed{scriptFailure = (redeemerPtr, scriptFailure)} -> do - let postTxError = - ScriptFailedInWallet + Left ErrScriptExecutionFailed{scriptFailure = (redeemerPtr, scriptFailure)} -> + throwIO + (ScriptFailedInWallet { redeemerPtr = show redeemerPtr , failureReason = show scriptFailure } :: PostTxError Tx - throwIO postTxError + ) Left e -> throwIO ( InternalWalletError diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs index a80041768d7..f1f23ad0bcf 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs @@ -18,6 +18,7 @@ import Cardano.Ledger.Alonzo.TxAuxData (hashAlonzoTxAuxData) import Cardano.Ledger.Api ( AlonzoPlutusPurpose (..), AsIndex (..), + Data, Redeemers (..), auxDataHashTxBodyL, auxDataTxL, @@ -266,26 +267,57 @@ commitTx networkId scriptRegistry headId party utxoToCommit blueprintTx (initial blueprintRedeemer = unRedeemers $ toLedgerTx blueprintTx ^. witsTxL . rdmrsTxWitsL reAssociatedTxIns = reAssociateOldInputs currentInputs commitInputs blueprintRedeemer wits = - existingWits - & rdmrsTxWitsL .~ rebuildRedeemers reAssociatedTxIns (initialInput, initialRedeemer) + witsTxL + .~ ( existingWits + & rdmrsTxWitsL .~ rebuildRedeemers reAssociatedTxIns (initialInput, initialRedeemer) + ) in - fromLedgerTx $ ledgerBlueprintTx & witsTxL .~ wits + fromLedgerTx $ ledgerBlueprintTx & wits where + -- Re-Associate the redeemer indices present in some tx with the same inputs but different + -- indices in the current tx. + -- + -- We need this in order to be able to find the the _old_ tx redeemer and re-add + -- it to the tx witnesses using the appropriate index of the _new_ tx input + -- because of the 'TxIn' re-ordering. + reAssociateOldInputs :: + Set (Ledger.TxIn StandardCrypto) -> + Set TxIn -> + Map (AlonzoPlutusPurpose AsIndex era) a -> + [(Ledger.TxIn StandardCrypto, Int, Maybe a)] + reAssociateOldInputs newInputs oldInputs oldTxRedeemers = + ( \txin -> + let currentIndex = Set.findIndex txin newInputs + in case fromLedgerTxIn txin `Set.lookupIndex` oldInputs of + Nothing -> (txin, currentIndex, Nothing) + -- if we found the 'TxIn' in the old inputs, we need to get the + -- redeemer value from the old tx and re-associate it with the new + Just ix -> + ( txin + , currentIndex + , Map.lookup (AlonzoSpending (AsIndex $ fromIntegral ix)) oldTxRedeemers + ) + ) + <$> toList newInputs + + rebuildRedeemers :: [(Ledger.TxIn StandardCrypto, Int, Maybe (Data LedgerEra, ExUnits))] -> (TxIn, HashableScriptData) -> Redeemers LedgerEra rebuildRedeemers associatedTxIns (initialInput', initialRedeemer') = Redeemers $ insertRedeemers Map.empty (toList associatedTxIns) where - insertRedeemers r [] = r - insertRedeemers r ((txin, i, mBlueprintRedeemer) : rest) = - let key = AlonzoSpending (AsIndex $ fromIntegral i) - in case mBlueprintRedeemer of - Nothing -> - -- make sure to add the initial redeemer to the commit tx - -- if the input is matched - if txin == toLedgerTxIn initialInput' - then insertRedeemers (Map.insert key (toLedgerData @LedgerEra initialRedeemer', ExUnits 0 0) r) (fromList rest) - else insertRedeemers r (fromList rest) - Just blueprintRedeemer -> - insertRedeemers (Map.insert key blueprintRedeemer r) (fromList rest) + insertRedeemers r associatedRedeemers = + case associatedRedeemers of + [] -> r + ((txin, i, mBlueprintRedeemer) : rest) -> + let key = AlonzoSpending (AsIndex $ fromIntegral i) + in case mBlueprintRedeemer of + Nothing -> + -- make sure to add the initial redeemer to the commit tx + -- if the input is matched + if txin == toLedgerTxIn initialInput' + then insertRedeemers (Map.insert key (toLedgerData @LedgerEra initialRedeemer', ExUnits 0 0) r) (fromList rest) + else insertRedeemers r (fromList rest) + Just blueprintRedeemer -> + insertRedeemers (Map.insert key blueprintRedeemer r) (fromList rest) initialScript = fromPlutusScript @PlutusScriptV2 Initial.validatorScript @@ -319,32 +351,6 @@ commitTx networkId scriptRegistry headId party utxoToCommit blueprintTx (initial txAuxMetadata = mkAlonzoTxAuxData @[] @LedgerEra (toShelleyMetadata metadataMap) [toLedgerScript initialScript] --- Re-Associate the redeemer indices present in some tx with the same inputs but different --- indices in the current tx. --- --- We need this in order to be able to find the the _old_ tx redeemer and re-add --- it to the tx witnesses using the appropriate index of the _new_ tx input --- because of the 'TxIn' re-ordering. -reAssociateOldInputs :: - Set (Ledger.TxIn StandardCrypto) -> - Set TxIn -> - Map (AlonzoPlutusPurpose AsIndex era) a -> - [(Ledger.TxIn StandardCrypto, Int, Maybe a)] -reAssociateOldInputs newInputs oldInputs oldTxRedeemers = - ( \txin -> - let currentIndex = Set.findIndex txin newInputs - in case fromLedgerTxIn txin `Set.lookupIndex` oldInputs of - Nothing -> (txin, currentIndex, Nothing) - -- if we found the 'TxIn' in the old inputs, we need to get the - -- redeemer value from the old tx and re-associate it with the new - Just ix -> - ( txin - , currentIndex - , Map.lookup (AlonzoSpending (AsIndex $ fromIntegral ix)) oldTxRedeemers - ) - ) - <$> toList newInputs - mkCommitDatum :: Party -> UTxO -> CurrencySymbol -> Plutus.Datum mkCommitDatum party utxo headId = Commit.datum (partyToChain party, commits, headId)