Use proper inputs to build the commit datum

Author: v0d1ch

hydra-node/src/Hydra/Chain/Direct/Tx.hs

@@ -253,21 +253,20 @@ commitTx networkId scriptRegistry headId party commitTxDraft (initialInput, out,
     ledgerBlueprintTx =
       toLedgerTx draftTx
         & bodyTxL . inputsTxBodyL <>~ Set.singleton (toLedgerTxIn initialInput)
-        & bodyTxL . inputsTxBodyL <>~ Set.fromList (toLedgerTxIn <$> committedTxIns)
+        -- & bodyTxL . inputsTxBodyL <>~ Set.fromList (toLedgerTxIn <$> committedTxIns)
         & bodyTxL . referenceInputsTxBodyL <>~ Set.fromList [toLedgerTxIn initialScriptRef]
         & bodyTxL . outputsTxBodyL .~ StrictSeq.singleton (toLedgerTxOut commitOutput)
         & bodyTxL . reqSignerHashesTxBodyL <>~ Set.singleton (toLedgerKeyHash vkh)
         & bodyTxL . auxDataHashTxBodyL .~ SJust (hashAlonzoTxAuxData txAuxMetadata)
         & bodyTxL . mintTxBodyL .~ mempty
         & auxDataTxL .~ addMetadata txAuxMetadata
-    existingWits = ledgerBlueprintTx ^. witsTxL
+    existingWits = toLedgerTx draftTx ^. witsTxL
     currentInputs = ledgerBlueprintTx ^. bodyTxL . inputsTxBodyL
-    commitInputs = Set.map toLedgerTxIn (UTxO.inputSet lookupUTxO)
     blueprintRedeemers = unRedeemers $ toLedgerTx draftTx ^. witsTxL . rdmrsTxWitsL
     wits =
       witsTxL
         .~ ( existingWits
-              & rdmrsTxWitsL .~ rebuildSpendingRedeemers currentInputs commitInputs blueprintRedeemers
+              & rdmrsTxWitsL .~ rebuildSpendingRedeemers currentInputs committedTxIns blueprintRedeemers
            )
    in
     fromLedgerTx $ ledgerBlueprintTx & wits
@@ -312,18 +311,19 @@ commitTx networkId scriptRegistry headId party commitTxDraft (initialInput, out,
             Just ix ->
               Map.lookup (AlonzoSpending (AsIndex $ fromIntegral ix)) oldTxRedeemers >>= Just . (key,)
 
-  initialScript =
-    fromPlutusScript @PlutusScriptV2 Initial.validatorScript
+  -- initialScript =
+  --   fromPlutusScript @PlutusScriptV2 Initial.validatorScript
 
   initialScriptRef =
     fst (initialReference scriptRegistry)
 
   initialRedeemer =
     toScriptData . Initial.redeemer $
-      Initial.ViaCommit (toPlutusTxOutRef <$> committedTxIns)
+      Initial.ViaCommit (toPlutusTxOutRef . fromLedgerTxIn <$> Set.toList committedTxIns)
 
-  committedTxIns =
-    fst <$> UTxO.pairs lookupUTxO
+  committedTxIns = toLedgerTx draftTx ^. bodyTxL . inputsTxBodyL
+  -- committedTxIns =
+  --   fst <$> UTxO.pairs lookupUTxO
 
   commitOutput =
     TxOut commitAddress commitValue commitDatum ReferenceScriptNone
@@ -334,16 +334,18 @@ commitTx networkId scriptRegistry headId party commitTxDraft (initialInput, out,
   commitAddress =
     mkScriptAddress @PlutusScriptV2 networkId commitScript
 
+  utxoToCommit =
+    UTxO.fromPairs $ mapMaybe (\txin -> (txin,) <$> UTxO.resolve txin lookupUTxO) (txIns' draftTx)
+
   commitValue =
-    txOutValue out <> foldMap txOutValue lookupUTxO
+    txOutValue out <> foldMap txOutValue utxoToCommit
 
   commitDatum =
-    mkTxOutDatumInline $ mkCommitDatum party lookupUTxO (headIdToCurrencySymbol headId)
+    mkTxOutDatumInline $ mkCommitDatum party utxoToCommit (headIdToCurrencySymbol headId)
 
   TxMetadata metadataMap = mkHydraHeadV1TxName "CommitTx"
 
-  txAuxMetadata = mkAlonzoTxAuxData @[] @LedgerEra (toShelleyMetadata metadataMap) [toLedgerScript initialScript]
-
+  txAuxMetadata = mkAlonzoTxAuxData @[] @LedgerEra (toShelleyMetadata metadataMap) [] -- toLedgerScript initialScript
   CommitTxDraft{lookupUTxO, draftTx} = commitTxDraft
 
 mkCommitDatum :: Party -> UTxO -> CurrencySymbol -> Plutus.Datum

hydra-node/test/Hydra/Chain/Direct/TxSpec.hs

@@ -17,6 +17,8 @@ import Cardano.Ledger.Api (
   bodyTxL,
   inputsTxBodyL,
   mkAlonzoTxAuxData,
+  mkBasicTx,
+  mkBasicTxBody,
   outputsTxBodyL,
   rdmrsTxWitsL,
   referenceInputsTxBodyL,
@@ -306,7 +308,7 @@ addRandomMetadata (l, metadata) tx =
 genBlueprintTx :: UTxO -> Gen Tx
 genBlueprintTx utxo = do
   (toSpend, toReference) <- splitUTxO
-  tx <- arbitrary <&> referenceInputs toReference . spendInputs toSpend
+  let tx = mkBasicTx mkBasicTxBody & referenceInputs toReference . spendInputs toSpend
   pure $ fromLedgerTx tx
  where
   spendInputs spentTxIns tx =