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/Http/APISpec.hs

@@ -0,0 +1,78 @@
+module Cardano.Wallet.Launch.Cluster.Monitoring.Http.APISpec
+    ( spec
+    )
+where
+
+import Prelude
+
+import Cardano.Wallet.Launch.Cluster.Monitoring.Http.API
+    ( ApiT (..)
+    )
+import Cardano.Wallet.Launch.Cluster.Monitoring.Phase
+    ( History (..)
+    , Phase (..)
+    )
+import Control.Monitoring.Tracing
+    ( MonitorState (..)
+    )
+import Data.Aeson
+    ( FromJSON (..)
+    , Result (..)
+    , ToJSON (..)
+    , fromJSON
+    )
+import Data.Time
+    ( Day (ModifiedJulianDay)
+    , UTCTime (UTCTime)
+    , secondsToDiffTime
+    )
+import Test.Hspec
+    ( Spec
+    , describe
+    , it
+    , shouldBe
+    )
+import Test.QuickCheck
+    ( Arbitrary (..)
+    , Gen
+    , elements
+    , forAll
+    , listOf
+    , oneof
+    )
+
+import qualified Data.Map as Map
+
+jsonRoundtrip :: (ToJSON a, FromJSON a, Eq a, Show a) => a -> IO ()
+jsonRoundtrip a = fromJSON (toJSON a) `shouldBe` Success a
+
+spec :: Spec
+spec = do
+    describe "observe end-point json instances"
+        $ it " roundtrips" $ forAll genObserveApiType jsonRoundtrip
+
+genObserveApiType :: Gen (ApiT (History, MonitorState))
+genObserveApiType = do
+    history' <-
+        History . Map.fromList <$> listOf ((,) <$> genUTCTime <*> genPhase)
+    state <- oneof [pure Wait, pure Step, pure Run]
+    pure $ ApiT (history', state)
+
+genUTCTime :: Gen UTCTime
+genUTCTime = do
+    day <- ModifiedJulianDay <$> arbitrary
+    seconds <- secondsToDiffTime . (`mod` (3600 * 24)) <$> arbitrary
+    pure $ UTCTime day seconds
+
+genPhase :: Gen Phase
+genPhase =
+    elements
+        [ RetrievingFunds
+        , Metadata
+        , Genesis
+        , Pool0
+        , Funding
+        , Pools
+        , Relay
+        , Cluster Nothing
+        ]

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]