PR review

Signed-off-by: Sasha Bogicevic <sasha.bogicevic@iohk.io>

Author: v0d1ch

hydra-cardano-api/src/Hydra/Cardano/Api/TxOut.hs

@@ -101,19 +101,6 @@ findTxOutByScript utxo script =
     _ ->
       False
 
--- | Find all pub key outputs in some 'UTxO'
-findPubKeyOutputs ::
-  UTxO ->
-  Maybe UTxO
-findPubKeyOutputs utxo =
-  case List.filter matchPubKey (UTxO.pairs utxo) of
-    [] -> Nothing
-    as -> Just $ UTxO.fromPairs as
- where
-  matchPubKey = \case
-    (_, TxOut (AddressInEra _ (ShelleyAddress _ (Ledger.KeyHashObj _) _)) _ _ _) -> True
-    _ -> False
-
 -- | Predicate to find or filter 'TxOut' owned by a key. This
 -- is better than comparing the full address as it does not require a network
 -- discriminator.

hydra-node/test/Hydra/BehaviorSpec.hs

@@ -1147,7 +1147,7 @@ toOnChainTx now = \case
       , contestationDeadline = addUTCTime (toNominalDiffTime testContestationPeriod) now
       }
   FanoutTx{utxo, utxoToCommit, utxoToDecommit} ->
-    OnFanoutTx{headId = testHeadId, fanoutUTxO = utxo <> fromMaybe mempty utxoToCommit `withoutUTxO` fromMaybe mempty utxoToDecommit}
+    OnFanoutTx{headId = testHeadId, fanoutUTxO = utxo <> fromMaybe mempty utxoToCommit <> fromMaybe mempty utxoToDecommit}
 
 testContestationPeriod :: ContestationPeriod
 testContestationPeriod = UnsafeContestationPeriod 10

hydra-node/test/Hydra/HeadLogicSpec.hs

@@ -18,7 +18,6 @@ import Data.List qualified as List
 import Data.Map (notMember)
 import Data.Map qualified as Map
 import Data.Set qualified as Set
-import GHC.Natural (naturalToInteger)
 import Hydra.API.ClientInput (ClientInput (SideLoadSnapshot))
 import Hydra.API.ServerOutput (DecommitInvalidReason (..))
 import Hydra.Cardano.Api (fromLedgerTx, genTxIn, mkVkAddress, toLedgerTx, txOutValue, unSlotNo, pattern TxValidityUpperBound)
@@ -726,10 +725,9 @@ spec =
         update bobEnv ledger (inClosedState threeParties) collectOtherHead
           `shouldBe` Error (NotOurHead{ourHeadId = testHeadId, otherHeadId})
 
-      prop "fanout utxo always relies on observed utxo" $ \i ->
+      prop "fanout utxo always relies on observed utxo" $ \fanoutUTxO ->
         forAllShrink genClosedState shrink $ \closedState -> do
-          let fanoutUTxO = utxoRef $ naturalToInteger i
-              fanoutHead = observeTx $ OnFanoutTx{headId = testHeadId, fanoutUTxO}
+          let fanoutHead = observeTx $ OnFanoutTx{headId = testHeadId, fanoutUTxO}
           let outcome = update bobEnv ledger closedState fanoutHead
           counterexample ("Outcome: " <> show outcome) $
             outcome `hasStateChangedSatisfying` \case

hydra-node/test/Hydra/Model.hs

@@ -539,8 +539,11 @@ instance
       Fanout{} ->
         case hydraState st of
           Final{finalUTxO} -> do
-            let allOutputs = Data.Foldable.toList result
-            pure $ all (`elem` allOutputs) (toTxOuts finalUTxO)
+            -- NOTE: Sort `[TxOut]` by the address and values. We want to make
+            -- sure that the fanout outputs match what we had in the open Head
+            -- exactly.
+            let sorted = sortOn (\o -> (txOutAddress o, selectLovelace (txOutValue o)))
+            sorted (toTxOuts finalUTxO) === sorted (Data.Foldable.toList result)
           _ -> pure False
       _ -> pure True
 

hydra-tx/src/Hydra/Tx/Fanout.hs

@@ -3,6 +3,7 @@ module Hydra.Tx.Fanout where
 import Hydra.Cardano.Api
 import Hydra.Prelude
 
+import Cardano.Api.UTxO qualified as UTxO
 import Hydra.Contract.Head qualified as Head
 import Hydra.Contract.HeadState qualified as Head
 import Hydra.Contract.MintAction (MintAction (..))
@@ -90,9 +91,12 @@ observeFanoutTx ::
 observeFanoutTx utxo tx = do
   let inputUTxO = resolveInputsUTxO utxo tx
   (headInput, headOutput) <- findTxOutByScript inputUTxO Head.validatorScript
-  pubKeyOutputs <- findPubKeyOutputs (utxoFromTx tx)
+  let txOutputs = utxoFromTx tx
   headId <- findStateToken headOutput
   findRedeemerSpending tx headInput
     >>= \case
-      Head.Fanout{} -> pure FanoutObservation{headId, fanoutUTxO = pubKeyOutputs}
+      Head.Fanout{numberOfFanoutOutputs, numberOfCommitOutputs, numberOfDecommitOutputs} -> do
+        let allOutputs = fromIntegral $ numberOfFanoutOutputs + numberOfCommitOutputs + numberOfDecommitOutputs
+        let fanoutUTxO = UTxO.fromPairs $ take allOutputs $ UTxO.pairs txOutputs
+        pure FanoutObservation{headId, fanoutUTxO}
       _ -> Nothing