Add API type for http monitoring local-cluster

cardano-foundation · Apr 29, 2024 · eee9199 · eee9199
1 parent 591f363
commit eee9199
Show file tree

Hide file tree

Showing 3 changed files with 89 additions and 3 deletions.
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
@@ -0,0 +1,80 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Cardano.Wallet.Launch.Cluster.Monitoring.Http.API
+    ( API
+    , ApiT (..)
+    )
+where
+
+import Prelude
+
+import Cardano.Wallet.Launch.Cluster.Monitoring.Phase
+    ( History (..)
+    )
+import Control.Monitoring.Tracing
+    ( MonitorState (..)
+    )
+import Data.Aeson
+    ( FromJSON (..)
+    , ToJSON
+    , Value (..)
+    , object
+    , toJSON
+    , withObject
+    , (.:)
+    , (.=)
+    )
+
+import Servant
+    ( Post
+    , PostNoContent
+    )
+import Servant.API
+    ( Get
+    , JSON
+    , (:<|>)
+    , (:>)
+    )
+
+-- | The API for the monitoring server
+type API =
+    "ready" :> Get '[JSON] Bool
+        :<|> "step" :> PostNoContent
+        :<|> "switch" :> Post '[JSON] (ApiT MonitorState)
+        :<|> "observe" :> Get '[JSON] (ApiT (History, MonitorState))
+
+-- | A newtype wrapper to avoid orphan instances
+newtype ApiT a = ApiT {unApiT :: a}
+    deriving newtype (Eq, Show)
+
+instance ToJSON (ApiT MonitorState) where
+    toJSON = \case
+        ApiT Wait -> String "waiting"
+        ApiT Step -> String "stepping"
+        ApiT Run -> String "running"
+
+instance FromJSON (ApiT MonitorState) where
+    parseJSON = \case
+        String "waiting" -> pure $ ApiT Wait
+        String "stepping" -> pure $ ApiT Step
+        String "running" -> pure $ ApiT Run
+        _ -> fail "Invalid state"
+
+instance ToJSON (ApiT (History, MonitorState)) where
+    toJSON (ApiT (History{history}, state)) =
+        object
+            [ "phases" .=  history
+            , "state" .= ApiT state
+            ]
+
+instance FromJSON (ApiT (History, MonitorState)) where
+    parseJSON = withObject "ApiT (History, MonitorState)" $ \o -> do
+        history <- o .: "phases"
+        ApiT state <- o .: "state"
+        pure $ ApiT (History{history}, state)
diff --git a/lib/local-cluster/lib/Control/Monitoring/Tracing.hs b/lib/local-cluster/lib/Control/Monitoring/Tracing.hs
@@ -42,7 +42,7 @@ data MonitorState
     -- ^ Wating for a step before going into `Wait`
     | Run
     -- ^ Tracing freely
-    deriving stock Show
+    deriving stock (Show, Eq)
 
 -- | Tracing state along with its observation
 data Tracing state a b = Tracing

diff --git a/lib/local-cluster/local-cluster.cabal b/lib/local-cluster/local-cluster.cabal
@@ -52,6 +52,7 @@ library
     Cardano.Wallet.Launch.Cluster.KeyRegistration
     Cardano.Wallet.Launch.Cluster.Logging
     Cardano.Wallet.Launch.Cluster.MonetaryPolicyScript
+    Cardano.Wallet.Launch.Cluster.Monitoring.Http.API
     Cardano.Wallet.Launch.Cluster.Monitoring.Phase
     Cardano.Wallet.Launch.Cluster.Node.GenNodeConfig
     Cardano.Wallet.Launch.Cluster.Node.GenTopology
@@ -120,8 +121,10 @@ library
     , profunctors
     , resourcet
     , retry
+    , servant
     , servant-client
     , stm
+    , servant-server
     , tagged
     , temporary
     , temporary-extra
@@ -158,18 +161,21 @@ test-suite test
     , base
     , cardano-wallet-primitive
     , cardano-wallet-test-utils
+    , containers
     , foldl
     , hspec
     , local-cluster
     , pathtype
     , QuickCheck
     , temporary
+    , time
     , unliftio
     , with-utf8
 
   build-tool-depends: hspec-discover:hspec-discover
   other-modules:
-    Spec
-    SpecHook
+    Cardano.Wallet.Launch.Cluster.Monitoring.Http.APISpec
     Control.Monitoring.MonitorSpec
     Control.Monitoring.TracingSpec
+    Spec
+    SpecHook