Add a Maybe TxOutRef to Initial.Commit redeemer

Also adds another isomorphism for Plutus.TxOutRef
input-output-hk · Jan 26, 2022 · ab9f1bd · ab9f1bd
1 parent 225b76a
commit ab9f1bd
Show file tree

Hide file tree

Showing 3 changed files with 16 additions and 6 deletions.
diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs
@@ -186,7 +186,7 @@ commitTx networkId party utxo (initialInput, vkh) =
     Api.unsafeBuildTransaction $
       Api.emptyTxBody
         & Api.addInputs [(Api.fromLedgerTxIn initialInput, initialWitness)]
-        & Api.addVkInputs [commit | Just (commit, _) <- [utxo]]
+        & Api.addVkInputs (maybeToList mCommittedInput)
         & Api.addOutputs [commitOutput]
  where
   initialWitness =
@@ -196,8 +196,10 @@ commitTx networkId party utxo (initialInput, vkh) =
   initialDatum =
     Api.mkDatumForTxIn $ Initial.datum vkh
   initialRedeemer =
-    Api.mkRedeemerForTxIn $ Initial.redeemer Initial.Commit
-
+    Api.mkRedeemerForTxIn . Initial.redeemer $
+      Initial.Commit (Api.toPlutusTxOutRef <$> mCommittedInput)
+  mCommittedInput =
+    fst <$> utxo
   commitOutput =
     Api.TxOut commitAddress commitValue commitDatum
   commitScript =

diff --git a/hydra-node/src/Hydra/Ledger/Cardano/Isomorphism.hs b/hydra-node/src/Hydra/Ledger/Cardano/Isomorphism.hs
@@ -184,6 +184,10 @@ fromPlutusTxOutRef (Plutus.TxOutRef (Plutus.TxId bytes) ix) =
   TxIn
     (TxId $ unsafeHashFromBytes $ Plutus.fromBuiltin bytes)
     (TxIx $ fromIntegral ix)
+
+toPlutusTxOutRef :: TxIn -> Plutus.TxOutRef
+toPlutusTxOutRef = Ledger.txInfoIn' . toLedgerTxIn
+
 -- ** TxOut
 
 toLedgerTxOut :: TxOut CtxUTxO Era -> Ledger.TxOut (ShelleyLedgerEra Era)

diff --git a/hydra-plutus/src/Hydra/Contract/Initial.hs b/hydra-plutus/src/Hydra/Contract/Initial.hs
@@ -21,6 +21,9 @@ data Initial
 data InitialRedeemer
   = Abort
   | Commit
+      { -- | Points to the committed Utxo.
+        committedRef :: Maybe TxOutRef
+      }
 
 PlutusTx.unstableMakeIsData ''InitialRedeemer
 
@@ -31,14 +34,15 @@ instance Scripts.ValidatorTypes Initial where
 validator ::
   -- | Commit validator
   ValidatorHash ->
-  DatumType Initial ->
-  RedeemerType Initial ->
+  -- | The Hydra party which committed
+  PubKeyHash ->
+  InitialRedeemer ->
   ScriptContext ->
   Bool
 validator commitValidator _datum red context@ScriptContext{scriptContextTxInfo = txInfo} =
   case red of
     Abort -> True
-    Commit -> checkOutputValue
+    Commit{} -> checkOutputValue
  where
   checkOutputValue =
     traceIfFalse "commitLockedValue does not match" $