Add local-cluster monitor tests

lib/local-cluster/local-cluster.cabal

@@ -167,9 +167,11 @@ test-suite test
     , cardano-wallet-primitive
     , cardano-wallet-test-utils
     , containers
+    , contra-tracer
     , foldl
     , hspec
     , local-cluster
+    , mtl
     , pathtype
     , QuickCheck
     , temporary
@@ -180,6 +182,7 @@ test-suite test
   build-tool-depends: hspec-discover:hspec-discover
   other-modules:
     Cardano.Wallet.Launch.Cluster.Monitoring.Http.APISpec
+    Cardano.Wallet.Launch.Cluster.Monitoring.MonitorSpec
     Control.Monitoring.MonitorSpec
     Control.Monitoring.TracingSpec
     Spec

lib/local-cluster/test/unit/Cardano/Wallet/Launch/Cluster/Monitoring/MonitorSpec.hs

@@ -0,0 +1,120 @@
+module Cardano.Wallet.Launch.Cluster.Monitoring.MonitorSpec
+    ( spec
+    )
+where
+
+import Prelude
+
+import Cardano.Wallet.Launch.Cluster.Monitoring.Http.Client
+    ( Query (..)
+    , RunQuery (..)
+    )
+import Cardano.Wallet.Launch.Cluster.Monitoring.Monitor
+    ( MonitorConfiguration (..)
+    , withMonitoring
+    )
+import Cardano.Wallet.Launch.Cluster.Monitoring.Phase
+    ( History (..)
+    , Phase (..)
+    )
+import Control.Monad
+    ( unless
+    )
+import Control.Monad.Cont
+    ( evalContT
+    )
+import Control.Monad.Fix
+    ( fix
+    )
+import Control.Monad.IO.Class
+    ( liftIO
+    )
+import Control.Monitoring.Tracing
+    ( MonitorState (..)
+    )
+import Control.Tracer
+    ( Tracer
+    , nullTracer
+    , traceWith
+    )
+import Data.Foldable
+    ( toList
+    )
+import Test.Hspec
+    ( Spec
+    , describe
+    , it
+    , shouldBe
+    )
+import UnliftIO.Async
+    ( async
+    , wait
+    )
+
+testMonitoring
+    :: MonitorState
+    -> (Tracer IO Phase -> RunQuery IO -> IO ())
+    -> IO ()
+testMonitoring w f =
+    evalContT $ do
+        (tracer, query) <-
+            withMonitoring nullTracer
+                $ MonitorConfiguration Nothing w
+        liftIO $ f tracer query
+
+spec :: Spec
+spec = do
+    describe "withMonitoring" $ do
+        it "can start" $ do
+            testMonitoring Step $ \_ _ -> pure ()
+        it "can query" $ do
+            testMonitoring Step $ \_ (RunQuery query) -> do
+                result <- query ReadyQ
+                result `shouldBe` False
+        it "can trace" $ do
+            testMonitoring Run $ \tracer _ -> do
+                traceWith tracer RetrievingFunds
+        it "can report readiness" $ do
+            testMonitoring Run $ \tracer (RunQuery query) -> do
+                traceWith tracer (Cluster Nothing)
+                result <- query ReadyQ
+                result `shouldBe` True
+        it "can step the tracer thread" $ do
+            testMonitoring Step $ \tracer (RunQuery query) -> do
+                tracer' <- async $ do
+                    traceWith tracer (Cluster Nothing)
+                fix $ \loop -> do
+                    result <- query ReadyQ
+                    unless result $ query StepQ >> loop
+                wait tracer'
+        it "can report the phase history" $ do
+            testMonitoring Run $ \tracer (RunQuery query) -> do
+                traceWith tracer RetrievingFunds
+                traceWith tracer Metadata
+                traceWith tracer Genesis
+                traceWith tracer Pool0
+                traceWith tracer Funding
+                traceWith tracer Pools
+                traceWith tracer Relay
+                traceWith tracer (Cluster Nothing)
+                (History phases, state) <- query ObserveQ
+                toList phases
+                    `shouldBe` [ RetrievingFunds
+                               , Metadata
+                               , Genesis
+                               , Pool0
+                               , Funding
+                               , Pools
+                               , Relay
+                               , Cluster Nothing
+                               ]
+                state `shouldBe` Run
+        it "can switch from step to run" $ do
+            testMonitoring Step $ \tracer (RunQuery query) -> do
+                tracer' <- async $ do
+                    traceWith tracer RetrievingFunds
+                state <- query SwitchQ
+                state `shouldBe` Run
+                wait tracer'
+                (History phases, _state) <- query ObserveQ
+                toList phases `shouldBe` [RetrievingFunds]