Add functions to UTxO interface. (#2067)

Uses `UTxO.foldMap`, `UTxO.map` and `UTxO.txOutputs` that will be the
interface from cardano-api-10.17. Also adds `UTxO.null`. `UTxO.size`,
`UTxO.totalValue` and `UTxO.lovelaceValue` that will be upstreamed.

Author: locallycompact

hydra-cardano-api/src/Cardano/Api/UTxO.hs

@@ -10,11 +10,11 @@ module Cardano.Api.UTxO where
 
 import Cardano.Api hiding (UTxO, toLedgerUTxO)
 import Cardano.Api qualified
+import Cardano.Api.Ledger (Coin)
 import Cardano.Api.Shelley (ReferenceScript (..))
 import Cardano.Ledger.Babbage ()
 import Data.Bifunctor (second)
 import Data.Coerce (coerce)
-import Data.Foldable qualified as F
 import Data.List qualified as List
 import Data.Map (Map)
 import Data.Map qualified as Map
@@ -36,8 +36,6 @@ newtype UTxO' out = UTxO
   deriving newtype
     ( Eq
     , Show
-    , Functor
-    , Foldable
     , Semigroup
     , Monoid
     , ToJSON
@@ -88,12 +86,33 @@ difference a b = UTxO $ Map.difference (toMap a) (toMap b)
 -- | Check if the first 'UTxO' contains all **outputs** of the second 'UTxO'.
 -- First argument is the 'UTxO' to search in, second argument is the 'UTxO'
 -- to search for.
-containsOutputs :: Eq out => UTxO' out -> UTxO' out -> Bool
+containsOutputs :: UTxO -> UTxO -> Bool
 containsOutputs utxoForSearching utxo =
-  let allOutputs = F.toList utxoForSearching
-      expectedOutputs = F.toList utxo
+  let allOutputs = txOutputs utxoForSearching
+      expectedOutputs = txOutputs utxo
    in all (`elem` allOutputs) expectedOutputs
 
+map :: (TxOut CtxUTxO Era -> TxOut CtxUTxO Era) -> UTxO -> UTxO
+map f = UTxO . Map.map f . toMap
+
+foldMap :: Monoid m => (TxOut CtxUTxO Era -> m) -> UTxO -> m
+foldMap fn = Prelude.foldMap fn . toMap
+
+txOutputs :: UTxO -> [TxOut CtxUTxO Era]
+txOutputs = Map.elems . toMap
+
+null :: UTxO -> Bool
+null = Map.null . toMap
+
+size :: UTxO -> Int
+size = Map.size . toMap
+
+totalValue :: UTxO -> Value
+totalValue = Cardano.Api.UTxO.foldMap (\(TxOut _ (txOutValueToValue -> v) _ _) -> v)
+
+totalLovelace :: UTxO -> Coin
+totalLovelace = selectLovelace . totalValue
+
 -- * Type Conversions
 
 -- | Transforms a UTxO containing tx outs from any era into Babbage era.

hydra-cluster/src/Hydra/Cluster/Faucet.hs

@@ -87,7 +87,7 @@ findFaucetUTxO networkId backend lovelace = do
   (faucetVk, _) <- keysFor Faucet
   faucetUTxO <- Backend.queryUTxO backend [buildAddress faucetVk networkId]
   let foundUTxO = UTxO.filter (\o -> (selectLovelace . txOutValue) o >= lovelace) faucetUTxO
-  when (null foundUTxO) $
+  when (UTxO.null foundUTxO) $
     throwIO $
       FaucetHasNotEnoughFunds{faucetUTxO}
   pure foundUTxO
@@ -178,7 +178,7 @@ returnFundsToFaucet' tracer backend senderSk = do
   let senderVk = getVerificationKey senderSk
   utxo <- Backend.queryUTxOFor backend QueryTip senderVk
   returnAmount <-
-    if null utxo
+    if UTxO.null utxo
       then pure 0
       else retryOnExceptions tracer $ do
         let utxoValue = balance @Tx utxo

hydra-cluster/src/Hydra/Cluster/Scenarios.hs

@@ -744,7 +744,7 @@ singlePartyUsesWithdrawZeroTrick tracer workDir backend hydraScriptsTxId =
                   recomputeIntegrityHash pparams [PlutusV3] $
                     toLedgerTx tx
                       & bodyTxL . collateralInputsTxBodyL .~ Set.map toLedgerTxIn (UTxO.inputSet utxoToCommit)
-                      & bodyTxL . totalCollateralTxBodyL .~ SJust (foldMap (selectLovelace . txOutValue) utxoToCommit)
+                      & bodyTxL . totalCollateralTxBodyL .~ SJust (UTxO.totalLovelace utxoToCommit)
                       & bodyTxL . withdrawalsTxBodyL .~ Withdrawals (Map.singleton rewardAccount 0)
                       & witsTxL . rdmrsTxWitsL .~ Redeemers (Map.singleton (ConwayRewarding $ AsIx 0) (redeemer, exUnits))
                       & witsTxL . scriptTxWitsL .~ Map.singleton scriptHash script

hydra-cluster/src/Hydra/Generator.hs

@@ -134,7 +134,7 @@ generateDemoUTxODataset ::
 generateDemoUTxODataset network nodeSocket faucetSk nClients nTxs = do
   -- Query available funds
   faucetUTxO <- queryUTxOFor network nodeSocket QueryTip faucetVk
-  let (Coin fundsAvailable) = foldMap (selectLovelace . txOutValue) faucetUTxO
+  let (Coin fundsAvailable) = UTxO.totalLovelace faucetUTxO
   -- Generate client datasets
   allPaymentKeys <- generate $ replicateM nClients genSigningKey
   clientFunds <- generate $ genClientFunds allPaymentKeys fundsAvailable

hydra-cluster/test/Test/DirectChainSpec.hs

@@ -157,7 +157,7 @@ spec = around (showLogsOnFailure "DirectChainSpec") $ do
                 -- Expect that Alice got her committed value back to her
                 -- external address
                 utxo <- Backend.queryUTxO backend [aliceExternalAddress]
-                let aliceValues = txOutValue <$> toList utxo
+                let aliceValues = txOutValue <$> UTxO.txOutputs utxo
                 aliceValues `shouldContain` [lovelaceToValue aliceCommitment]
 
   it "cannot abort a non-participating head" $ \tracer ->

hydra-cluster/test/Test/GeneratorSpec.hs

@@ -5,6 +5,7 @@ module Test.GeneratorSpec where
 import Hydra.Prelude
 import Test.Hydra.Prelude
 
+import Cardano.Api.UTxO qualified as UTxO
 import Data.Text (unpack)
 import Hydra.Cardano.Api (LedgerEra, UTxO, prettyPrintJSON, utxoFromTx)
 import Hydra.Chain.ChainState (ChainSlot (ChainSlot))
@@ -45,7 +46,7 @@ prop_keepsUTxOConstant =
           \Dataset{fundingTransaction, clientDatasets = [ClientDataset{txSequence}]} ->
             let initialUTxO = utxoFromTx fundingTransaction
                 finalUTxO = foldl' (apply defaultGlobals ledgerEnv) initialUTxO txSequence
-             in length finalUTxO == length initialUTxO
+             in length (UTxO.txOutputs finalUTxO) == length (UTxO.txOutputs initialUTxO)
                   & counterexample ("transactions: " <> prettyJSONString txSequence)
                   & counterexample ("utxo: " <> prettyJSONString initialUTxO)
                   & counterexample ("funding tx: " <> prettyJSONString fundingTransaction)

hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs

@@ -5,9 +5,10 @@ module Test.Hydra.Cluster.FaucetSpec where
 import Hydra.Prelude
 import Test.Hydra.Prelude
 
+import Cardano.Api.UTxO qualified as UTxO
 import CardanoNode (withCardanoNodeDevnet)
 import Control.Concurrent.Async (replicateConcurrently)
-import Hydra.Cardano.Api (Coin (..), selectLovelace, txOutValue)
+import Hydra.Cardano.Api (Coin (..), selectLovelace)
 import Hydra.Chain.Backend qualified as Backend
 import Hydra.Chain.CardanoClient (QueryPoint (..))
 import Hydra.Chain.Direct (DirectBackend (..))
@@ -36,7 +37,7 @@ spec =
           vk <- generate genVerificationKey
           seedFromFaucet backend vk 1_000_000 tracer
         -- 10 unique outputs
-        length (fold utxos) `shouldBe` 10
+        UTxO.size (fold utxos) `shouldBe` 10
 
     describe "returnFundsToFaucet" $ do
       it "does nothing if nothing to return" $ \(tracer, backend) -> do
@@ -53,13 +54,13 @@ spec =
               returnFundsToFaucet tracer backend actor
               remaining <- Backend.queryUTxOFor backend QueryTip vk
               finalFaucetFunds <- Backend.queryUTxOFor backend QueryTip faucetVk
-              foldMap txOutValue remaining `shouldBe` mempty
+              UTxO.totalValue remaining `shouldBe` mempty
 
               -- check the faucet has one utxo extra in the end
-              length finalFaucetFunds `shouldBe` length initialFaucetFunds + 1
+              UTxO.size finalFaucetFunds `shouldBe` UTxO.size initialFaucetFunds + 1
 
-              let initialFaucetValue = selectLovelace (foldMap txOutValue initialFaucetFunds)
-              let finalFaucetValue = selectLovelace (foldMap txOutValue finalFaucetFunds)
+              let initialFaucetValue = selectLovelace (UTxO.totalValue initialFaucetFunds)
+              let finalFaucetValue = selectLovelace (UTxO.totalValue finalFaucetFunds)
               let difference = initialFaucetValue - finalFaucetValue
               -- difference between starting faucet amount and final one should
               -- just be the amount of paid fees
@@ -77,4 +78,4 @@ spec =
         -- it squashed the UTxO
         utxoAfter <- Backend.queryUTxOFor backend QueryTip vk
 
-        length utxoAfter `shouldBe` 1
+        UTxO.size utxoAfter `shouldBe` 1

hydra-node/bench/tx-cost/TxCost.hs

@@ -102,7 +102,7 @@ computeCommitCost = do
       Right tx ->
         case checkSizeAndEvaluate tx (utxo <> knownUtxo) of
           Just (txSize, memUnit, cpuUnit, minFee) ->
-            pure $ Just (NumUTxO $ length utxo, txSize, memUnit, cpuUnit, minFee)
+            pure $ Just (NumUTxO $ UTxO.size utxo, txSize, memUnit, cpuUnit, minFee)
           Nothing ->
             pure Nothing
 
@@ -309,4 +309,4 @@ serializedSize :: UTxO -> Natural
 serializedSize =
   fromIntegral
     . lengthOfByteString
-    . foldMap (serialiseData . toBuiltinData . fromJust . toPlutusTxOut)
+    . UTxO.foldMap (serialiseData . toBuiltinData . fromJust . toPlutusTxOut)

hydra-node/src/Hydra/Chain/Blockfrost/Client.hs

@@ -547,6 +547,6 @@ awaitUTxO networkId addresses txid i = do
       Left _e -> liftIO (threadDelay 1) >> go (n - 1)
       Right utxo' ->
         let wantedUTxO = UTxO.fromList $ List.filter (\(TxIn txid' _, _) -> txid' == txid) (UTxO.toList utxo')
-         in if null wantedUTxO
+         in if UTxO.null wantedUTxO
               then liftIO (threadDelay 1) >> go (n - 1)
               else pure utxo'

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

@@ -122,7 +122,7 @@ awaitTransaction networkId socket tx =
   ins = keys (UTxO.toMap $ utxoFromTx tx)
   go = do
     utxo <- queryUTxOByTxIn networkId socket QueryTip ins
-    if null utxo
+    if UTxO.null utxo
       then go
       else pure utxo