Convert 'findScriptOutput' to cardano-api's version.

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

@@ -314,7 +314,7 @@ chainSyncClient tracer networkMagic callback party headState =
   runOnChainTx :: [OnChainTx CardanoTx] -> ValidatedTx Era -> STM m [OnChainTx CardanoTx]
   runOnChainTx observed tx = do
     onChainHeadState <- readTVar headState
-    let utxo = knownUtxo onChainHeadState
+    let utxo = Ledger.UTxO (knownUtxo onChainHeadState)
     -- TODO(SN): We should be only looking for abort,commit etc. when we have a headId/policyId
     let res =
           observeInitTx networkId party tx

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

@@ -26,16 +26,15 @@ import Cardano.Ledger.Alonzo.TxInfo (transKeyHash)
 import Cardano.Ledger.Alonzo.TxWitness (TxWitness (..), unTxDats)
 import Cardano.Ledger.Crypto (StandardCrypto)
 import Cardano.Ledger.Era (hashScript)
-import qualified Cardano.Ledger.SafeHash as SafeHash
 import Cardano.Ledger.Shelley.API (
   Credential (ScriptHashObj),
   Network (Testnet),
   StakeReference (StakeRefNull),
   StrictMaybe (..),
-  TxId (TxId),
-  TxIn (TxIn),
+  TxIn,
   hashKey,
  )
+import Cardano.Ledger.Shelley.UTxO (UTxO (..))
 import qualified Data.Aeson as Aeson
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -502,56 +501,70 @@ observeCommit networkId tx = \case
 -- and decoding its redeemer.
 observeCollectComTx ::
   -- | A Utxo set to lookup tx inputs
-  Map (TxIn StandardCrypto) (TxOut Era) ->
+  UTxO Era ->
   ValidatedTx Era ->
   Maybe (OnChainTx CardanoTx, OnChainHeadState)
 observeCollectComTx utxo tx = do
-  (headInput, headOutput) <- findScriptOutput utxo headScript
+  (headInput, headOutput) <- Api.findScriptOutput @Api.PlutusScriptV1 (Api.fromLedgerUtxo utxo) headScript
   redeemer <-
     Api.findRedeemerSpending
       (Api.getTxBody $ Api.fromLedgerTx tx)
-      (Api.fromLedgerTxIn headInput)
-  oldHeadDatum <- lookupDatum (wits tx) headOutput
+      headInput
+  oldHeadDatum <- lookupDatum (wits tx) (Api.toLedgerTxOut headOutput)
   datum <- fromData $ getPlutusData oldHeadDatum
   case (datum, redeemer) of
     (Head.Initial{parties}, Head.CollectCom{}) -> do
-      (newHeadInput, newHeadOutput) <- findScriptOutput (utxoFromTx tx) headScript
-      newHeadDatum <- lookupDatum (wits tx) newHeadOutput
+      (newHeadInput, newHeadOutput) <- Api.findScriptOutput @Api.PlutusScriptV1 (Api.utxoFromTx $ Api.fromLedgerTx tx) headScript
+      newHeadDatum <- lookupDatum (wits tx) (Api.toLedgerTxOut newHeadOutput)
       pure
         ( OnCollectComTx
-        , OpenOrClosed{threadOutput = (newHeadInput, newHeadOutput, newHeadDatum, parties)}
+        , OpenOrClosed
+            { threadOutput =
+                ( Api.toLedgerTxIn newHeadInput
+                , Api.toLedgerTxOut newHeadOutput
+                , newHeadDatum
+                , parties
+                )
+            }
         )
     _ -> Nothing
  where
-  headScript = plutusScript $ Head.validatorScript policyId
+  headScript = Api.fromPlutusScript $ Head.validatorScript policyId
 
 -- | Identify a close tx by lookup up the input spending the Head output and
 -- decoding its redeemer.
 observeCloseTx ::
   -- | A Utxo set to lookup tx inputs
-  Map (TxIn StandardCrypto) (TxOut Era) ->
+  UTxO Era ->
   ValidatedTx Era ->
   Maybe (OnChainTx CardanoTx, OnChainHeadState)
 observeCloseTx utxo tx = do
-  (headInput, headOutput) <- findScriptOutput utxo headScript
+  (headInput, headOutput) <- Api.findScriptOutput @Api.PlutusScriptV1 (Api.fromLedgerUtxo utxo) headScript
   redeemer <-
     Api.findRedeemerSpending
       (Api.getTxBody $ Api.fromLedgerTx tx)
-      (Api.fromLedgerTxIn headInput)
-  oldHeadDatum <- lookupDatum (wits tx) headOutput
+      headInput
+  oldHeadDatum <- lookupDatum (wits tx) (Api.toLedgerTxOut headOutput)
   datum <- fromData $ getPlutusData oldHeadDatum
   case (datum, redeemer) of
     (Head.Open{parties}, Head.Close{snapshotNumber = onChainSnapshotNumber}) -> do
-      (newHeadInput, newHeadOutput) <- findScriptOutput (utxoFromTx tx) headScript
-      newHeadDatum <- lookupDatum (wits tx) newHeadOutput
+      (newHeadInput, newHeadOutput) <- Api.findScriptOutput @Api.PlutusScriptV1 (Api.utxoFromTx $ Api.fromLedgerTx tx) headScript
+      newHeadDatum <- lookupDatum (wits tx) (Api.toLedgerTxOut newHeadOutput)
       snapshotNumber <- integerToNatural onChainSnapshotNumber
       pure
         ( OnCloseTx{contestationDeadline, snapshotNumber}
-        , OpenOrClosed{threadOutput = (newHeadInput, newHeadOutput, newHeadDatum, parties)}
+        , OpenOrClosed
+            { threadOutput =
+                ( Api.toLedgerTxIn newHeadInput
+                , Api.toLedgerTxOut newHeadOutput
+                , newHeadDatum
+                , parties
+                )
+            }
         )
     _ -> Nothing
  where
-  headScript = plutusScript $ Head.validatorScript policyId
+  headScript = Api.fromPlutusScript $ Head.validatorScript policyId
 
   -- FIXME(SN): store in/read from datum
   contestationDeadline = UTCTime (ModifiedJulianDay 0) 0
@@ -564,38 +577,38 @@ observeCloseTx utxo tx = do
 -- from a known script (the head state machine script) with a "fanout" redeemer.
 observeFanoutTx ::
   -- | A Utxo set to lookup tx inputs
-  Map (TxIn StandardCrypto) (TxOut Era) ->
+  UTxO Era ->
   ValidatedTx Era ->
   Maybe (OnChainTx CardanoTx, OnChainHeadState)
 observeFanoutTx utxo tx = do
-  headInput <- fst <$> findScriptOutput utxo headScript
+  headInput <- fst <$> Api.findScriptOutput @Api.PlutusScriptV1 (Api.fromLedgerUtxo utxo) headScript
   Api.findRedeemerSpending
     (Api.getTxBody $ Api.fromLedgerTx tx)
-    (Api.fromLedgerTxIn headInput)
+    headInput
     >>= \case
       Head.Fanout{} -> pure (OnFanoutTx, Final)
       _ -> Nothing
  where
-  headScript = plutusScript $ Head.validatorScript policyId
+  headScript = Api.fromPlutusScript $ Head.validatorScript policyId
 
 -- | Identify an abort tx by looking up the input spending the Head output and
 -- decoding its redeemer.
 observeAbortTx ::
   -- | A Utxo set to lookup tx inputs
-  Map (TxIn StandardCrypto) (TxOut Era) ->
+  UTxO Era ->
   ValidatedTx Era ->
   Maybe (OnChainTx CardanoTx, OnChainHeadState)
 observeAbortTx utxo tx = do
-  headInput <- fst <$> findScriptOutput utxo headScript
+  headInput <- fst <$> Api.findScriptOutput @Api.PlutusScriptV1 (Api.fromLedgerUtxo utxo) headScript
   Api.findRedeemerSpending
     (Api.getTxBody $ Api.fromLedgerTx tx)
-    (Api.fromLedgerTxIn headInput)
+    headInput
     >>= \case
       Head.Abort -> pure (OnAbortTx, Final)
       _ -> Nothing
  where
   -- FIXME(SN): make sure this is aborting "the right head / your head" by not hard-coding policyId
-  headScript = plutusScript $ Head.validatorScript policyId
+  headScript = Api.fromPlutusScript $ Head.validatorScript policyId
 
 -- * Functions related to OnChainHeadState
 
@@ -645,23 +658,6 @@ lookupDatum wits = \case
   (TxOut _ _ (SJust datumHash)) -> Map.lookup datumHash . unTxDats $ txdats wits
   _ -> Nothing
 
-findScriptOutput ::
-  Map (TxIn StandardCrypto) (TxOut Era) ->
-  Script Era ->
-  Maybe (TxIn StandardCrypto, TxOut Era)
-findScriptOutput utxo script =
-  find go $ Map.toList utxo
- where
-  go (_, TxOut addr _ _) = addr == scriptAddr script
-
--- | Get the Utxo set created by given transaction.
--- TODO(SN): DRY with Hydra.Ledger.Cardano.utxoFromTx
-utxoFromTx :: ValidatedTx Era -> Map (TxIn StandardCrypto) (TxOut Era)
-utxoFromTx ValidatedTx{body} =
-  Map.fromList $ zip (map mkTxIn [0 ..]) . toList $ outputs body
- where
-  mkTxIn = TxIn (TxId $ SafeHash.hashAnnotated body)
-
 -- | Find first occurrence including a transformation.
 findFirst :: Foldable t => (a -> Maybe b) -> t a -> Maybe b
 findFirst fn = getFirst . foldMap (First . fn)

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

@@ -219,7 +219,7 @@ spec =
               committedUtxo = fold $ snd <$> commitPartiesAndUtxos
               onChainParties = partyFromVerKey . vkey <$> parties
               headDatum = Data . toData $ Head.Initial cperiod onChainParties
-              lookupUtxo = Map.singleton headInput headOutput
+              lookupUtxo = UTxO (Map.singleton headInput headOutput)
               tx = collectComTx testNetworkId committedUtxo (headInput, headDatum, onChainParties) commitsUtxo
               res = observeCollectComTx lookupUtxo tx
            in case res of
@@ -266,7 +266,7 @@ spec =
       prop "is observed" $ \parties headInput snapshot msig ->
         let headOutput = mkHeadOutput (SJust headDatum)
             headDatum = Data $ toData $ Head.Open{parties, utxoHash = ""}
-            lookupUtxo = Map.singleton headInput headOutput
+            lookupUtxo = UTxO (Map.singleton headInput headOutput)
             -- NOTE(SN): deliberately uses an arbitrary multi-signature
             tx = closeTx snapshot msig (headInput, headOutput, headDatum)
             res = observeCloseTx lookupUtxo tx
@@ -314,7 +314,7 @@ spec =
         let tx = fanoutTx utxo (headInput, headDatum)
             headOutput = mkHeadOutput SNothing
             headDatum = Data $ toData $ Head.Closed{snapshotNumber = 1, utxoHash = ""}
-            lookupUtxo = Map.singleton headInput headOutput
+            lookupUtxo = UTxO (Map.singleton headInput headOutput)
             res = observeFanoutTx lookupUtxo tx
          in res === Just (OnFanoutTx, Final)
               & counterexample ("Tx: " <> show tx)
@@ -362,7 +362,7 @@ spec =
       prop "updates on-chain state to 'Final'" $ \txIn cperiod parties (ReasonablySized initials) ->
         let headOutput = mkHeadOutput SNothing -- will be SJust, but not covered by this test
             headDatum = Data . toData $ Head.Initial cperiod parties
-            utxo = Map.singleton txIn headOutput
+            utxo = UTxO (Map.singleton txIn headOutput)
          in case abortTx testNetworkId (txIn, headDatum) initials of
               Left err -> property False & counterexample ("AbortTx construction failed: " <> show err)
               Right tx ->
@@ -417,7 +417,7 @@ spec =
               initials = zipWith (\ix dat -> (TxIn initTxId ix, dat)) [1 ..] initialDatums
               -- Finally we can create the abortTx and have it processed by the wallet
               lookupUtxo = Map.fromList (headUtxo : initialUtxo)
-              utxo = UTxO $ walletUtxo <> lookupUtxo
+              utxo = walletUtxo <> lookupUtxo
            in case abortTx testNetworkId (headInput, headDatum) (Map.fromList initials) of
                 Left err ->
                   property False & counterexample ("AbortTx construction failed: " <> show err)