Skip to content

Commit

Permalink
Add local-cluster swagger file
Browse files Browse the repository at this point in the history
  • Loading branch information
@paolino
paolino committed May 2, 2024
1 parent e09afe6 commit 36dee56
Show file tree
Hide file tree
Showing 9 changed files with 652 additions and 34 deletions.
3 changes: 3 additions & 0 deletions .gitignore
View file
Original file line number Diff line number Diff line change
Expand Up @@ -75,3 +75,6 @@ test-output

## Membench uncompressed data
lib/wallet-benchmarks/data/membench-snapshot

## Local cluster swagger golden actual
lib/local-cluster/data/swagger.json.actual
215 changes: 215 additions & 0 deletions lib/local-cluster/data/swagger.json
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,215 @@
{
"components": {
"schemas": {
"MonitorState": {
"enum": [
"waiting",
"stepping",
"running"
],
"type": "string"
},
"Observation": {
"properties": {
"phases": {
"items": {
"properties": {
"phase": {
"description": "The different phases the cluster can be in",
"oneOf": [
{
"properties": {
"tag": {
"enum": [
"RetrievingFunds"
],
"type": "string"
}
},
"type": "object"
},
{
"properties": {
"tag": {
"enum": [
"Metadata"
],
"type": "string"
}
},
"type": "object"
},
{
"properties": {
"tag": {
"enum": [
"Genesis"
],
"type": "string"
}
},
"type": "object"
},
{
"properties": {
"tag": {
"enum": [
"Pool0"
],
"type": "string"
}
},
"type": "object"
},
{
"properties": {
"tag": {
"enum": [
"Funding"
],
"type": "string"
}
},
"type": "object"
},
{
"properties": {
"tag": {
"enum": [
"Pools"
],
"type": "string"
}
},
"type": "object"
},
{
"properties": {
"tag": {
"enum": [
"Relay"
],
"type": "string"
}
},
"type": "object"
},
{
"properties": {
"contents": {
"description": "The socket file or pipe of a relay node",
"type": "string"
},
"tag": {
"enum": [
"Cluster"
],
"type": "string"
}
},
"type": "object"
}
],
"type": "string"
},
"time": {
"type": "string"
}
},
"type": "object"
},
"type": "array"
},
"state": {
"enum": [
"waiting",
"stepping",
"running"
],
"type": "string"
}
},
"type": "object"
},
"Ready": {
"type": "boolean"
}
}
},
"info": {
"description": "This is the API for the monitoring server",
"license": {
"name": "Apache 2",
"url": "https://www.apache.org/licenses/LICENSE-2.0.html"
},
"title": "Cardano Wallet Monitoring API",
"version": "0.1.0.0"
},
"openapi": "3.0.0",
"paths": {
"/control/observe": {
"get": {
"responses": {
"200": {
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/Observation"
}
}
},
"description": "Ok"
}
},
"summary": "Observe the local-cluster monitor state"
}
},
"/control/step": {
"post": {
"responses": {
"204": {
"content": {
"application/json": {}
},
"description": "No Content"
}
},
"summary": "Step the local-cluster monitor"
}
},
"/control/switch": {
"post": {
"responses": {
"200": {
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/MonitorState"
}
}
},
"description": "Ok"
}
},
"summary": "Switch the local-cluster monitor"
}
},
"/ready": {
"get": {
"responses": {
"200": {
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/Ready"
}
}
},
"description": "Ok"
}
},
"summary": "Check if the local-cluster is ready"
}
}
}
}
70 changes: 61 additions & 9 deletions lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/Monitoring/Http/API.hs
View file
Original file line number Diff line number Diff line change
@@ -1,10 +1,13 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Wallet.Launch.Cluster.Monitoring.Http.API
( API
Expand All @@ -14,23 +17,37 @@ where

import Prelude

import Cardano.Wallet.Launch.Cluster.Monitoring.Http.OpenApi
( monitorStateSchema
, observationSchema
)
import Cardano.Wallet.Launch.Cluster.Monitoring.Phase
( History (..)
)
import Control.Monitoring.Tracing
( MonitorState (..)
)
import Data.Aeson
import Data.Aeson.Types
( FromJSON (..)
, ToJSON
, Parser
, ToJSON (..)
, Value (..)
, object
, toJSON
, withArray
, withObject
, (.:)
, (.=)
)

import Data.Foldable
( toList
)
import Data.OpenApi
( NamedSchema (..)
, ToSchema (..)
)
import GHC.Generics
( Generic (..)
)
import Servant
( Post
, PostNoContent
Expand All @@ -42,6 +59,8 @@ import Servant.API
, (:>)
)

import qualified Data.Map as Map

-- | The API for the monitoring server
type API =
"ready" :> Get '[JSON] Bool
Expand All @@ -51,14 +70,40 @@ type API =

-- | A newtype wrapper to avoid orphan instances
newtype ApiT a = ApiT {unApiT :: a}
deriving newtype (Eq, Show)
deriving newtype (Eq, Show, Generic)

renderHistory :: History -> Value
renderHistory History{history} = toJSON $ do
(time, phase) <- Map.assocs history
pure
$ object
[ "time" .= time
, "phase" .= phase
]

parseHistory :: Value -> Parser History
parseHistory = withArray "History" $ \arr -> do
history <- Map.fromList <$> traverse parsePhase (toList arr)
pure $ History{history}
where
parsePhase = withObject "Phase" $ \o -> do
time <- o .: "time"
phase <- o .: "phase"
pure (time, phase)

instance ToJSON (ApiT MonitorState) where
toJSON = \case
ApiT Wait -> String "waiting"
ApiT Step -> String "stepping"
ApiT Run -> String "running"

instance ToSchema (ApiT MonitorState) where
declareNamedSchema _ = do
pure
$ NamedSchema
(Just "ApiT MonitorState")
monitorStateSchema

instance FromJSON (ApiT MonitorState) where
parseJSON = \case
String "waiting" -> pure $ ApiT Wait
Expand All @@ -67,14 +112,21 @@ instance FromJSON (ApiT MonitorState) where
_ -> fail "Invalid state"

instance ToJSON (ApiT (History, MonitorState)) where
toJSON (ApiT (History{history}, state)) =
toJSON (ApiT (history, state)) =
object
[ "phases" .= history
[ "phases" .= renderHistory history
, "state" .= ApiT state
]

instance ToSchema (ApiT (History, MonitorState)) where
declareNamedSchema _ =
pure
$ NamedSchema
(Just "ApiT (History, MonitorState)")
observationSchema

instance FromJSON (ApiT (History, MonitorState)) where
parseJSON = withObject "ApiT (History, MonitorState)" $ \o -> do
history <- o .: "phases"
history <- o .: "phases" >>= parseHistory
ApiT state <- o .: "state"
pure $ ApiT (History{history}, state)
pure $ ApiT (history, state)

0 comments on commit 36dee56

Please sign in to comment.