Add query for user funds and total funds

src/lib/Wst/Server.hs

@@ -6,8 +6,10 @@
 module Wst.Server(runServer) where
 
 import Cardano.Api.Shelley qualified as C
+import Control.Lens qualified as L
 import Control.Monad.Except (MonadError)
 import Control.Monad.Reader (MonadReader, asks)
+import Convex.CardanoApi.Lenses qualified as L
 import Convex.Class (MonadBlockchain, MonadUtxoQuery)
 import Data.Data (Proxy (..))
 import Network.Wai.Handler.Warp qualified as Warp
@@ -40,16 +42,18 @@ runServer env = do
 server :: forall env. (Env.HasRuntimeEnv env, Env.HasDirectoryEnv env) => env -> Server APIInEra
 server env = hoistServer (Proxy @APIInEra) (runWstAppServant env) $
   healthcheck
-  :<|> queryApi @env @C.ConwayEra
+  :<|> queryApi @env
   :<|> txApi @env
 
 healthcheck :: Applicative m => m NoContent
 healthcheck = pure NoContent
 
-queryApi :: forall env era. C.IsBabbageBasedEra era => ServerT (QueryAPI era) (WstApp env era)
+queryApi :: forall env. (Env.HasDirectoryEnv env) => ServerT (QueryAPI C.ConwayEra) (WstApp env C.ConwayEra)
 queryApi =
   Query.globalParamsNode
-  :<|> queryBlacklistedNodes (Proxy @era)
+  :<|> queryBlacklistedNodes (Proxy @C.ConwayEra)
+  :<|> queryUserFunds @C.ConwayEra @env (Proxy @C.ConwayEra)
+  :<|> queryAllFunds @C.ConwayEra @env (Proxy @C.ConwayEra)
 
 txApi :: forall env. (Env.HasDirectoryEnv env) => ServerT (BuildTxAPI C.ConwayEra) (WstApp env C.ConwayEra)
 txApi =
@@ -75,6 +79,32 @@ queryBlacklistedNodes _ (SerialiseAddress addr) = do
         . uDatum
   Env.withEnv $ Env.withTransfer transferLogic (fmap (fmap getHash) (Query.blacklistNodes @era))
 
+txOutValue :: C.IsMaryBasedEra era => C.TxOut C.CtxUTxO era -> C.Value
+txOutValue = L.view (L._TxOut . L._2 . L._TxOutValue)
+
+queryUserFunds :: forall era env m.
+  ( MonadUtxoQuery m
+  , C.IsBabbageBasedEra era
+  , MonadReader env m
+  , Env.HasDirectoryEnv env
+  , MonadBlockchain era m
+  )
+  => Proxy era
+  -> SerialiseAddress (C.Address C.ShelleyAddr)
+  -> m C.Value
+queryUserFunds _ (SerialiseAddress addr) =
+  foldMap (txOutValue . Query.uOut) <$> Query.userProgrammableOutputs @era @env (paymentCredentialFromAddress addr)
+
+queryAllFunds :: forall era env m.
+  ( MonadUtxoQuery m
+  , C.IsBabbageBasedEra era
+  , MonadReader env m
+  , Env.HasDirectoryEnv env
+  )
+  => Proxy era
+  -> m C.Value
+queryAllFunds _ = foldMap (txOutValue . Query.uOut) <$> Query.programmableLogicOutputs @era @env
+
 issueProgrammableTokenEndpoint :: forall era env m.
   ( MonadReader env m
   , Env.HasDirectoryEnv env

src/lib/Wst/Server/Types.hs

@@ -31,7 +31,7 @@ import Data.Proxy (Proxy (..))
 import GHC.Generics (Generic)
 import Servant (FromHttpApiData (..), ToHttpApiData (toUrlPiece))
 import Servant.API (Capture, Description, Get, JSON, NoContent, Post, ReqBody,
-                    ToHttpApiData, type (:>), (:<|>) (..))
+                    type (:>), (:<|>) (..))
 import SmartTokens.Types.ProtocolParams (ProgrammableLogicGlobalParams)
 import Wst.Offchain.Query (UTxODat (..))
 
@@ -59,11 +59,11 @@ type API era =
   :<|> "query" :> QueryAPI era
   :<|> "tx" :> BuildTxAPI era
 
--- TODO: FromHttpApiData, ToHttpApiData C.Address C.ShelleyAddr
-
 type QueryAPI era =
   "global-params" :> Description "The UTxO with the global parameters" :> Get '[JSON] (UTxODat era ProgrammableLogicGlobalParams)
   :<|> "blacklist" :> Description "The list of addresses that have been blacklisted" :> Capture "address" (SerialiseAddress (C.Address C.ShelleyAddr)) :>  Get '[JSON] [C.Hash C.PaymentKey]
+  :<|> "user-funds" :> Description "Total value locked in programmable token outputs addressed to the user" :> Capture "address" (SerialiseAddress (C.Address C.ShelleyAddr)) :> Get '[JSON] C.Value
+  :<|> "all-funds" :> Description "Total value of all programmable tokens" :> Get '[JSON] C.Value
 
 {-| Arguments for the programmable-token endpoint. The asset name can be something like "USDW" for the regulated stablecoin.
 -}