Add getUTxOByTxIn local state query

cardano-foundation · Jun 27, 2024 · a648280 · a648280
1 parent a2cac93
commit a648280
Show file tree

Hide file tree

Showing 6 changed files with 72 additions and 0 deletions.
diff --git a/lib/network-layer/cardano-wallet-network-layer.cabal b/lib/network-layer/cardano-wallet-network-layer.cabal
@@ -54,6 +54,7 @@ library
     Cardano.Wallet.Network.LocalStateQuery.PParams
     Cardano.Wallet.Network.LocalStateQuery.RewardAccount
     Cardano.Wallet.Network.LocalStateQuery.StakeDistribution
+    Cardano.Wallet.Network.LocalStateQuery.UTxO
     Cardano.Wallet.Network.Logging
     Cardano.Wallet.Network.Logging.Aggregation
     Cardano.Wallet.Network.RestorationMode

diff --git a/lib/network-layer/src/Cardano/Wallet/Network.hs b/lib/network-layer/src/Cardano/Wallet/Network.hs
@@ -153,6 +153,9 @@ data NetworkLayer m block = NetworkLayer
     , stakeDistribution
         :: Coin -- Stake to consider for rewards
         -> m StakePoolsSummary
+    , getUTxOByTxIn
+        :: Set Write.TxIn
+        -> m (MaybeInRecentEra Write.UTxO)
     , getCachedRewardAccountBalance
         :: RewardAccount
         -- Either reward account from key hash or script hash

diff --git a/lib/network-layer/src/Cardano/Wallet/Network/Implementation.hs b/lib/network-layer/src/Cardano/Wallet/Network/Implementation.hs
@@ -517,6 +517,8 @@ withNodeNetworkLayerBase
                     _postTx txSubmissionQ readCurrentNodeEra
                 , stakeDistribution =
                     _stakeDistribution queryRewardQ
+                , getUTxOByTxIn =
+                    _getUTxOByTxIn queryRewardQ
                 , getCachedRewardAccountBalance =
                     _getCachedRewardAccountBalance rewardsObserver
                 , fetchRewardAccountBalances =
@@ -659,6 +661,10 @@ withNodeNetworkLayerBase
                     return res
                 Nothing -> pure $ StakePoolsSummary 0 mempty mempty
 
+        _getUTxOByTxIn queue ins =
+            bracketQuery "getUTxOByTxIn" tr
+                $ queue `send` SomeLSQ (LSQ.getUTxOByTxIn ins)
+
         _watchNodeTip readTip callback = do
             observeForever readTip $ \tip -> do
                 let tip' = fromOuroborosTip tip

diff --git a/lib/network-layer/src/Cardano/Wallet/Network/LocalStateQuery.hs b/lib/network-layer/src/Cardano/Wallet/Network/LocalStateQuery.hs
@@ -9,6 +9,7 @@ module Cardano.Wallet.Network.LocalStateQuery
     , module Cardano.Wallet.Network.LocalStateQuery.PParams
     , module Cardano.Wallet.Network.LocalStateQuery.RewardAccount
     , module Cardano.Wallet.Network.LocalStateQuery.StakeDistribution
+    , module Cardano.Wallet.Network.LocalStateQuery.UTxO
     ) where
 
 import Cardano.Wallet.Network.LocalStateQuery.Extra
@@ -25,3 +26,6 @@ import Cardano.Wallet.Network.LocalStateQuery.RewardAccount
 import Cardano.Wallet.Network.LocalStateQuery.StakeDistribution
     ( stakeDistribution
     )
+import Cardano.Wallet.Network.LocalStateQuery.UTxO
+    ( getUTxOByTxIn
+    )
diff --git a/lib/network-layer/src/Cardano/Wallet/Network/LocalStateQuery/UTxO.hs b/lib/network-layer/src/Cardano/Wallet/Network/LocalStateQuery/UTxO.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE GADTs #-}
+-- |
+-- Copyright: © 2024 Cardano Foundation
+-- License: Apache-2.0
+--
+-- A local state query that looks up UTxOs based on TxIns.
+--
+module Cardano.Wallet.Network.LocalStateQuery.UTxO
+    ( getUTxOByTxIn
+    ) where
+
+import Prelude
+
+import Cardano.Ledger.TxIn
+    ( TxIn
+    )
+import Cardano.Ledger.UTxO
+    ( UTxO
+    )
+import Cardano.Wallet.Network.Implementation.Ouroboros
+    ( LSQ (..)
+    )
+import Cardano.Wallet.Network.LocalStateQuery.Extra
+    ( onAnyEra
+    )
+import Data.Set
+    ( Set
+    )
+import Internal.Cardano.Write.Tx
+    ( MaybeInRecentEra (..)
+    )
+import Ouroboros.Consensus.Cardano
+    ( CardanoBlock
+    )
+import Ouroboros.Consensus.Shelley.Eras
+    ( StandardCrypto
+    )
+
+import qualified Ouroboros.Consensus.Shelley.Ledger as Shelley
+
+{-----------------------------------------------------------------------------
+    Local State Query for GetUTxOByTxIn
+------------------------------------------------------------------------------}
+--
+type LSQ' m = LSQ (CardanoBlock StandardCrypto) m
+
+getUTxOByTxIn
+    :: Set (TxIn StandardCrypto) -> LSQ' m (MaybeInRecentEra UTxO)
+getUTxOByTxIn ins =
+    onAnyEra
+        (pure InNonRecentEraByron)
+        (pure InNonRecentEraShelley)
+        (pure InNonRecentEraAllegra)
+        (pure InNonRecentEraMary)
+        (pure InNonRecentEraAlonzo)
+        (InRecentEraBabbage <$> LSQry (Shelley.GetUTxOByTxIn ins))
+        (InRecentEraConway <$> LSQry (Shelley.GetUTxOByTxIn ins))
diff --git a/lib/unit/test-common/Cardano/Wallet/DummyTarget/Primitive/Types.hs b/lib/unit/test-common/Cardano/Wallet/DummyTarget/Primitive/Types.hs
@@ -222,6 +222,7 @@ dummyNetworkLayer = NetworkLayer
     , currentProtocolParametersInRecentEras
         = err "currentProtocolParametersInRecentEras"
     , currentSlottingParameters = err "currentSlottingParameters"
+    , getUTxOByTxIn = err "getUTxOByTxIn"
     , postTx = err "postTx"
     , stakeDistribution = err "stakeDistribution"
     , getCachedRewardAccountBalance = err "getRewardCachedAccountBalance"