Add local-cluster http monitoring

lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/Monitoring/Http/Logging.hs

@@ -0,0 +1,23 @@
+{-# 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
+    )
+
+-- | Messages for the HTTP monitoring service
+data MsgHttpMonitoring
+    = MsgHttpMonitoringPort PortNumber
+    | MsgHttpMonitoringQuery MsgClient
+    | MsgHttpMonitoringServerStarted
+    | MsgHttpMonitoringDone
+    deriving stock (Show)

lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/Monitoring/Monitor.hs

@@ -0,0 +1,115 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# OPTIONS_GHC -Wno-missing-local-signatures #-}
+
+module Cardano.Wallet.Launch.Cluster.Monitoring.Monitor
+    ( MsgHttpMonitoring (..)
+    , MonitorConfiguration (..)
+    , withMonitoring
+    )
+where
+
+import Prelude
+
+import Cardano.Wallet.Launch.Cluster.Monitoring.Http.Client
+    ( RunQuery
+    , withHttpClient
+    )
+import Cardano.Wallet.Launch.Cluster.Monitoring.Http.Logging
+    ( MsgHttpMonitoring (..)
+    )
+import Cardano.Wallet.Launch.Cluster.Monitoring.Http.Server
+    ( mkHandlers
+    , withHttpServer
+    )
+import Cardano.Wallet.Launch.Cluster.Monitoring.Phase
+    ( History (..)
+    , Phase
+    )
+import Cardano.Wallet.Network.Ports
+    ( getRandomPort
+    )
+import Control.Monad.Cont
+    ( ContT (..)
+    )
+import Control.Monad.IO.Class
+    ( MonadIO (..)
+    )
+import Control.Monitoring.Folder
+import Control.Monitoring.Monitor
+    ( Monitor
+    , mkMonitor
+    , monitorTracer
+    )
+import Control.Monitoring.Tracing
+    ( AnyTracing (AnyTracing)
+    , MonitorState
+    , StateS (..)
+    , Tracing
+    , withTracingState
+    )
+import Control.Tracer
+    ( Tracer (..)
+    , traceWith
+    )
+import Data.Functor.Contravariant
+    ( (>$<)
+    )
+import Data.Map
+    ( Map
+    )
+import Data.Profunctor
+    ( Profunctor (..)
+    )
+import Data.Time
+    ( UTCTime
+    , getCurrentTime
+    )
+import Network.Socket
+    ( PortNumber
+    )
+
+import qualified Control.Foldl as F
+
+-- | Configuration for the monitoring service
+data MonitorConfiguration = MonitorConfiguration
+    { monitorPort :: Maybe PortNumber
+    -- ^ The port to run the monitoring service on
+    -- If `Nothing`, a random port will be chosen
+    , monitorInitialState :: MonitorState
+    -- ^ The initial state of the monitor
+    }
+    deriving stock (Show)
+
+timedMonitor
+    :: forall m w a
+     . MonadIO m
+    => StateS w
+    -> m (Monitor m a (Map UTCTime a))
+timedMonitor initialState = do
+    let tracer :: Tracing w (UTCTime, a) (Map UTCTime a)
+        tracer = mkTracingFromFold F.map initialState
+    mkMonitor
+        (AnyTracing initialState tracer)
+        (\x -> (,x) <$> liftIO getCurrentTime)
+
+-- | Start a monitoring service, returning a tracer to write `Phase` values to
+-- and a function to interact with the monitoring service
+withMonitoring
+    :: Tracer IO MsgHttpMonitoring
+    -- ^ Tracer for logging the monitoring operations
+    -> MonitorConfiguration
+    -- ^ Configuration for the monitoring service
+    -> ContT () IO (Tracer IO Phase, RunQuery IO)
+withMonitoring tr MonitorConfiguration{..} = do
+    monitor <- liftIO $ withTracingState timedMonitor monitorInitialState
+    port <- liftIO $ maybe getRandomPort pure monitorPort
+    liftIO $ traceWith tr $ MsgHttpMonitoringPort port
+    withHttpServer port $ mkHandlers $ rmap History monitor
+    liftIO $ traceWith tr MsgHttpMonitoringServerStarted
+    runQueries <- withHttpClient (MsgHttpMonitoringQuery >$< tr) port
+    ContT $ \ k -> do
+        k (monitorTracer monitor, runQueries)
+        traceWith tr MsgHttpMonitoringDone

lib/local-cluster/local-cluster.cabal

@@ -54,7 +54,9 @@ library
     Cardano.Wallet.Launch.Cluster.MonetaryPolicyScript
     Cardano.Wallet.Launch.Cluster.Monitoring.Http.API
     Cardano.Wallet.Launch.Cluster.Monitoring.Http.Client
+    Cardano.Wallet.Launch.Cluster.Monitoring.Http.Logging
     Cardano.Wallet.Launch.Cluster.Monitoring.Http.Server
+    Cardano.Wallet.Launch.Cluster.Monitoring.Monitor
     Cardano.Wallet.Launch.Cluster.Monitoring.Phase
     Cardano.Wallet.Launch.Cluster.Node.GenNodeConfig
     Cardano.Wallet.Launch.Cluster.Node.GenTopology