Add witnesses to commit transaction

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

@@ -9,22 +9,36 @@
 -- thus we have not yet "reached" 'isomorphism'.
 module Hydra.Chain.Direct.Tx where
 
-import Hydra.Cardano.Api
+import Hydra.Cardano.Api hiding (hashScript)
 import Hydra.Prelude
 
 import Cardano.Api.UTxO qualified as UTxO
+import Cardano.Ledger.Alonzo.Scripts (ExUnits (..))
 import Cardano.Ledger.Alonzo.TxAuxData (hashAlonzoTxAuxData)
 import Cardano.Ledger.Api (
+  AlonzoPlutusPurpose (..),
+  AsIndex (..),
+  Redeemers (..),
+  TxDats (..),
+  addrTxWitsL,
   auxDataHashTxBodyL,
   bodyTxL,
+  datsTxWitsL,
+  hashData,
+  hashScript,
+  hashScriptTxWitsL,
   inputsTxBodyL,
   mkAlonzoTxAuxData,
   outputsTxBodyL,
+  rdmrsTxWitsL,
   referenceInputsTxBodyL,
   reqSignerHashesTxBodyL,
+  scriptTxWitsL,
+  unRedeemers,
+  witsTxL,
  )
 import Cardano.Ledger.BaseTypes (StrictMaybe (..))
-import Control.Lens ((%~), (.~), (<>~))
+import Control.Lens ((%~), (.~), (<>~), (^.))
 import Data.Aeson qualified as Aeson
 import Data.ByteString qualified as BS
 import Data.ByteString.Base16 qualified as Base16
@@ -249,20 +263,26 @@ commitTx networkId scriptRegistry headId party utxoToCommit blueprintTx (initial
         & bodyTxL . referenceInputsTxBodyL <>~ Set.fromList [toLedgerTxIn initialScriptRef]
         & bodyTxL . outputsTxBodyL %~ (|> toLedgerTxOut commitOutput)
         & bodyTxL . reqSignerHashesTxBodyL <>~ Set.singleton (toLedgerKeyHash vkh)
-        & bodyTxL . auxDataHashTxBodyL .~ SJust (hashAlonzoTxAuxData txAuxMetadata)
+    -- & bodyTxL . auxDataHashTxBodyL .~ SJust (hashAlonzoTxAuxData txAuxMetadata)
+    existingWits = ledgerBlueprintTx ^. witsTxL
+    existingRedeemers = existingWits ^. rdmrsTxWitsL
+    inputs = ledgerBlueprintTx ^. bodyTxL . inputsTxBodyL
+    script = toLedgerScript initialScript
+    wits =
+      existingWits
+        -- TODO: How to make sure Head output is the first one?
+        & scriptTxWitsL <>~ Map.fromList [(hashScript @LedgerEra script, script)]
+        & datsTxWitsL <>~ TxDats (Map.singleton (hashData (toLedgerData @LedgerEra commitDatum')) (toLedgerData commitDatum'))
+        & rdmrsTxWitsL
+          .~ Redeemers
+            ( Map.insert
+                (AlonzoSpending (AsIndex (fromIntegral $ length inputs - 1)))
+                (toLedgerData @LedgerEra initialRedeemer, ExUnits 0 0)
+                (unRedeemers existingRedeemers)
+            )
    in
-    -- TODO: don't forget about initialWitness
-    fromLedgerTx ledgerBlueprintTx
+    fromLedgerTx $ ledgerBlueprintTx & witsTxL .~ wits
  where
-  -- unsafeBuildTransaction $
-  --   emptyTxBody
-  --     & addInputs [(initialInput, initialWitness)]
-
-  initialWitness =
-    BuildTxWith $
-      ScriptWitness scriptWitnessInCtx $
-        mkScriptReference initialScriptRef initialScript InlineScriptDatum initialRedeemer
-
   initialScript =
     fromPlutusScript @PlutusScriptV2 Initial.validatorScript
 
@@ -288,13 +308,14 @@ commitTx networkId scriptRegistry headId party utxoToCommit blueprintTx (initial
   commitValue =
     txOutValue out <> foldMap txOutValue utxoToCommit
 
+  commitDatum' = toScriptData $ mkCommitDatum party utxoToCommit (headIdToCurrencySymbol headId)
+
   commitDatum =
     mkTxOutDatumInline $ mkCommitDatum party utxoToCommit (headIdToCurrencySymbol headId)
 
   TxMetadata metadataMap = mkHydraHeadV1TxName "CommitTx"
 
-  -- REVIEW empty list of [AlonzoScript]
-  txAuxMetadata = mkAlonzoTxAuxData @[] @LedgerEra (toShelleyMetadata metadataMap) []
+  txAuxMetadata = mkAlonzoTxAuxData @[] @LedgerEra (toShelleyMetadata metadataMap) [toLedgerScript initialScript]
 
 mkCommitDatum :: Party -> UTxO -> CurrencySymbol -> Plutus.Datum
 mkCommitDatum party utxo headId =