Implement observeCommitTx according to new strategy

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

@@ -53,6 +53,7 @@ import Hydra.Ledger.Cardano (
   Utxo,
   VerificationKey (PaymentVerificationKey),
   filterTxIn,
+  findRedeemerSpending,
   fromLedgerTx,
   fromPlutusScript,
   getDatum,
@@ -264,7 +265,7 @@ collectComTx networkId (Api.fromLedgerTxIn -> headInput, Api.fromLedgerData -> h
   extractSerialisedTxOut d =
     case fromData $ getPlutusData d of
       Nothing -> error "SNAFU"
-      Just ((_, _, Just (_, o)) :: DatumType Commit.Commit) -> Just o
+      Just ((_, _, Just o) :: DatumType Commit.Commit) -> Just o
       _ -> Nothing
   utxoHash =
     Head.hashPreSerializedCommits $
@@ -473,12 +474,22 @@ observeCommitTx ::
   ValidatedTx Era ->
   Maybe (OnChainTx CardanoTx, (TxIn StandardCrypto, TxOut Era, Data Era))
 observeCommitTx networkId initials (Api.getTxBody . fromLedgerTx -> txBody) = do
-  let ins = filterTxIn (`elem` initials) txBody
+  initialTxIn <- findInitialTxIn
+  initialRedeemer <- findRedeemerSpending txBody initialTxIn
+  let mCommittedTxIn = Api.fromPlutusTxOutRef <$> initialRedeemer
+
   (commitIn, commitOut) <- Api.findTxOutByAddress commitAddress txBody
   dat <- getDatum commitOut
   (party, _, serializedTxOut) <- fromData @(DatumType Commit.Commit) $ toPlutusData dat
-  convertedTxOut <- convertTxOut serializedTxOut
-  let onChainTx = OnCommitTx (convertParty party) convertedUtxo
+  let mCommittedTxOut = convertTxOut serializedTxOut
+
+  comittedUtxo <-
+    case (mCommittedTxIn, mCommittedTxOut) of
+      (Nothing, Nothing) -> Just mempty
+      (Just i, Just o) -> Just $ Api.singletonUtxo (i, o)
+      _ -> Nothing
+
+  let onChainTx = OnCommitTx (convertParty party) comittedUtxo
   pure
     ( onChainTx
     ,
@@ -488,13 +499,21 @@ observeCommitTx networkId initials (Api.getTxBody . fromLedgerTx -> txBody) = do
       )
     )
  where
-  convertTxOut :: Maybe Commit.SerializedTxOut -> Maybe (TxOut Era)
+  findInitialTxIn =
+    let ins = filterTxIn (`elem` (Api.fromLedgerTxIn <$> initials)) txBody
+     in case ins of
+          [input] -> Just input
+          _ ->
+            -- XXX(SN): this is indicating a problem and we at least wan't to know about it
+            Nothing
+
+  convertTxOut :: Maybe Commit.SerializedTxOut -> Maybe (Api.TxOut Api.CtxUTxO Api.Era)
   convertTxOut = \case
-    Nothing -> Just mempty
+    Nothing -> Nothing
     Just (Commit.SerializedTxOut outBytes) ->
       -- XXX(SN): these errors might be more severe and we could throw an
       -- exception here?
-      eitherToMaybe $ decodeFull' (fromBuiltin outBytes)
+      eitherToMaybe $ Api.fromLedgerTxOut <$> decodeFull' (fromBuiltin outBytes)
 
   commitAddress = mkScriptAddress @Api.PlutusScriptV1 networkId commitScript
 
@@ -509,7 +528,7 @@ observeCommit ::
   Maybe (OnChainTx CardanoTx, OnChainHeadState)
 observeCommit networkId tx = \case
   Initial{threadOutput, initials, commits} -> do
-    (onChainTx, commitTriple) <- observeCommitTx networkId initials tx
+    (onChainTx, commitTriple) <- observeCommitTx networkId (initials <&> \(a, _, _) -> a) tx
     -- NOTE(SN): A commit tx has been observed and thus we can remove all it's
     -- inputs from our tracked initials
     let commitIns = inputs $ body tx