Add send faucet assets end point to the http monitoring service

cardano-foundation · Apr 23, 2024 · 0c913d2 · 0c913d2
1 parent d14ba9d
commit 0c913d2
Show file tree

Hide file tree

Showing 10 changed files with 448 additions and 60 deletions.
diff --git a/lib/integration/framework/Test/Integration/Framework/Cluster/Launch.hs b/lib/integration/framework/Test/Integration/Framework/Cluster/Launch.hs
@@ -217,7 +217,7 @@ withGenesisData shelleyGenesis = ContT $ \f -> do
 withLocalClusterReady :: (Query Bool -> IO Bool) -> IO ()
 withLocalClusterReady queryMonitor = do
     void $ liftIO $ retrying policy (const $ pure . not) $ \_ -> do
-        queryMonitor Ready
+        queryMonitor ReadyQ
   where
     policy :: RetryPolicyM IO
     policy = capDelay (120 * oneSecond) $ exponentialBackoff oneSecond

diff --git a/lib/local-cluster/exe/local-cluster.hs b/lib/local-cluster/exe/local-cluster.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 
 import Prelude
 
@@ -23,6 +24,7 @@ import Cardano.Wallet.Faucet.Yaml
     )
 import Cardano.Wallet.Launch.Cluster
     ( Config (..)
+    , runningNodeSocketPath
     )
 import Cardano.Wallet.Launch.Cluster.CommandLine
     ( CommandLineOptions (..)
@@ -33,9 +35,15 @@ import Cardano.Wallet.Launch.Cluster.FileOf
     , FileOf (..)
     , mkRelDirOf
     )
+import Cardano.Wallet.Launch.Cluster.Monitoring.Http.API
+    ( API
+    )
 import Cardano.Wallet.Launch.Cluster.Monitoring.Monitor
     ( withMonitoring
     )
+import Cardano.Wallet.Primitive.NetworkId
+    ( NetworkDiscriminant (..)
+    )
 import Control.Concurrent
     ( threadDelay
     )
@@ -54,6 +62,9 @@ import Control.Monad.Cont
 import Control.Monad.Trans
     ( MonadIO (..)
     )
+import Data.Proxy
+    ( Proxy (..)
+    )
 import Main.Utf8
     ( withUtf8
     )
@@ -74,6 +85,12 @@ import System.Path
 import System.Path.Directory
     ( createDirectoryIfMissing
     )
+import UnliftIO
+    ( atomically
+    , newTVarIO
+    , readTVarIO
+    , writeTVar
+    )
 
 import qualified Cardano.Node.Cli.Launcher as NC
 import qualified Cardano.Wallet.Cli.Launcher as WC
@@ -132,6 +149,9 @@ import qualified Cardano.Wallet.Launch.Cluster as Cluster
 -- - NO_CLEANUP  (default: temp files are cleaned up)
 --     If set, the temporary directory used as a state directory for
 --     nodes and wallet data won't be cleaned up.
+testnetMonitorAPI :: Proxy (API ('Testnet 42))
+testnetMonitorAPI = Proxy
+
 main :: IO ()
 main = withUtf8 $ do
     -- Handle SIGTERM properly
@@ -160,7 +180,6 @@ main = withUtf8 $ do
         parseCommandLineOptions
     funds <- retrieveFunds faucetFundsFile
     flip runContT pure $ do
-        trace <- withMonitoring clusterControl monitoring
         clusterPath <-
             case clusterDir of
                 Just path -> pure path
@@ -183,14 +202,27 @@ main = withUtf8 $ do
                     , cfgClusterLogFile = clusterLogs
                     , cfgNodeToClientSocket = nodeToClientSocket
                     }
+        tconn <- liftIO $ newTVarIO Nothing
+        trace <-
+            withMonitoring
+                clusterControl
+                ((,) <$> monitoring <*> pure testnetMonitorAPI)
+                clusterCfg
+                $ readTVarIO tconn
+
         let clusterDirPath = absDirOf clusterPath
             walletDir = clusterDirPath </> relDir "wallet"
         liftIO $ createDirectoryIfMissing True walletDir
-        node <-
+        conn <-
             ContT
                 $ Cluster.withCluster trace clusterCfg funds
+        liftIO
+            $ atomically
+            $ writeTVar tconn
+            $ Just
+            $ runningNodeSocketPath conn
         nodeSocket <-
-            case parse . nodeSocketFile $ Cluster.runningNodeSocketPath node of
+            case parse . nodeSocketFile $ Cluster.runningNodeSocketPath conn of
                 Left e -> error e
                 Right p -> pure p
 

diff --git a/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/Logging.hs b/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/Logging.hs
@@ -51,7 +51,7 @@ import Cardano.Wallet.Launch.Cluster.FileOf
 import Cardano.Wallet.Launch.Cluster.Monitoring.Http.Client
     ( MsgClient (..)
     )
-import Cardano.Wallet.Launch.Cluster.Monitoring.Monitor
+import Cardano.Wallet.Launch.Cluster.Monitoring.Http.Logging
     ( MsgHttpMonitoring (..)
     )
 import Data.Char

diff --git a/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/Monitoring/Http/API.hs b/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/Monitoring/Http/API.hs
@@ -4,21 +4,31 @@
 
 module Cardano.Wallet.Launch.Cluster.Monitoring.Http.API
     ( API
-    , proxyAPI
+    , MonitorApi
     )
 where
 
+import Prelude
+
+import Cardano.Wallet.Launch.Cluster.Monitoring.Http.SendFaucetAssets
+    ( SendFaucetAssets
+    )
 import Data.Proxy
     ( Proxy (..)
     )
-import Prelude
+import Servant
+    ( PostNoContent
+    )
 import Servant.API
     ( Get
     , JSON
+    , ReqBody
+    , (:<|>)
     , (:>)
     )
 
-type API = "ready" :> Get '[JSON] Bool
+type API n =
+    "ready" :> Get '[JSON] Bool
+        :<|> "send" :> ReqBody '[JSON] (SendFaucetAssets n):> PostNoContent
 
-proxyAPI :: Proxy API
-proxyAPI = Proxy
+type MonitorApi n = Proxy (API n)
diff --git a/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/Monitoring/Http/Client.hs b/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/Monitoring/Http/Client.hs
@@ -1,9 +1,9 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
 
 module Cardano.Wallet.Launch.Cluster.Monitoring.Http.Client
     ( withHttpClient
@@ -18,8 +18,21 @@ import Prelude
 import Cardano.Wallet.Launch.Cluster.Monitoring.Http.API
     ( API
     )
+import Cardano.Wallet.Launch.Cluster.Monitoring.Http.SendFaucetAssets
+    ( SendFaucetAssets (..)
+    )
+import Cardano.Wallet.Primitive.NetworkId
+    ( NetworkDiscriminant (..)
+    )
+import Cardano.Wallet.Primitive.Types.Address
+    ( Address
+    )
+import Cardano.Wallet.Primitive.Types.TokenBundle
+    ( TokenBundle
+    )
 import Control.Monad
     ( unless
+    , void
     )
 import Control.Monad.Cont
     ( ContT (..)
@@ -38,15 +51,17 @@ import Control.Tracer
     ( Tracer
     , traceWith
     )
-import Data.Proxy
-    ( Proxy (..)
-    )
 import Network.HTTP.Client
     ( ManagerSettings (..)
     , defaultManagerSettings
     , newManager
     , responseTimeoutNone
     )
+import Servant
+    ( NoContent
+    , Proxy (..)
+    , (:<|>) (..)
+    )
 import Servant.Client
     ( BaseUrl (..)
     , ClientM
@@ -64,15 +79,28 @@ import UnliftIO
 
 -- | Queries that can be sent to the monitoring server via HTTP.
 data Query a where
-    Ready :: Query Bool
+    ReadyQ :: Query Bool
+    SendFaucetAssetsQ
+        :: Int
+        -> [(Address, (TokenBundle, [(String, String)]))]
+        -> Query ()
 
+testnetMonitorAPI :: Proxy (API ('Testnet 42))
+testnetMonitorAPI = Proxy
+
+sendFaucetAssets
+    :: SendFaucetAssets ('Testnet 42)
+    -> ClientM NoContent
 ready :: ClientM Bool
-ready = client (Proxy @API)
+
+ready :<|> sendFaucetAssets = client testnetMonitorAPI
 
 data AnyQuery = forall a. Show a => AnyQuery (Query a)
 
 instance Show AnyQuery where
-    show (AnyQuery Ready) = "Ready"
+    show (AnyQuery ReadyQ) = "Ready"
+    show (AnyQuery (SendFaucetAssetsQ n xs ))
+        = "SendFaucetAssets " <> show n <> " " <> show xs
 
 -- | Run any query against the monitoring server.
 newtype RunQuery m = RunQuery (forall a. Show a => Query a -> m a)
@@ -100,19 +128,25 @@ withHttpClient tracer httpPort = ContT $ \k -> do
             $ defaultManagerSettings
                 { managerResponseTimeout = responseTimeoutNone
                 }
+    let
+        query :: ClientM a -> IO a
+        query f = do
+            r <- runClientM f $ mkClientEnv manager url
+            either throwIO pure r
     k $ RunQuery $ \x -> do
         tr $ MsgClientReq $ AnyQuery x
         case x of
-            Ready -> liftIO
+            ReadyQ -> liftIO
                 $ recoverAll retryPolicy
                 $ \rt -> do
                     unless (firstTry rt)
                         $ unlift
                         $ tr
                         $ MsgClientRetry
                         $ AnyQuery x
-                    r <- runClientM ready $ mkClientEnv manager url
-                    either throwIO pure r
+                    query ready
+            SendFaucetAssetsQ n xs -> liftIO $ do
+                void $ query $ sendFaucetAssets $ SendFaucetAssets n xs
 
 retryPolicy :: RetryPolicyM IO
 retryPolicy = capDelay (60 * oneSecond) $ exponentialBackoff oneSecond

diff --git a/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/Monitoring/Http/Logging.hs b/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/Monitoring/Http/Logging.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE DerivingStrategies #-}
+
+module Cardano.Wallet.Launch.Cluster.Monitoring.Http.Logging
+    ( MsgHttpMonitoring (..)
+    )
+where
+
+import Prelude
+
+import Cardano.Wallet.Launch.Cluster.Monitoring.Http.Client
+    ( MsgClient
+    )
+import Network.Socket
+    ( PortNumber
+    )
+
+data MsgHttpMonitoring
+    = MsgHttpMonitoringPort PortNumber
+    | MsgHttpMonitoringQuery MsgClient
+    deriving stock (Show)