Generate and serve OpenAPI specs

chainweb-data.cabal

@@ -66,6 +66,7 @@ library
     ChainwebData.Genesis
     ChainwebData.Types
     ChainwebData.Env
+    ChainwebData.Spec
     ChainwebDb.BoundedScan
     ChainwebDb.Database
     ChainwebDb.Queries
@@ -85,8 +86,10 @@ library
     , http-client              ^>=0.6
     , http-client-tls          ^>=0.3
     , http-types
+    , openapi3
     , optparse-applicative     >=0.14 && <0.17
     , servant-client
+    , servant-openapi3
     , yet-another-logger
 
   if flag(ghc-flags)
@@ -131,6 +134,7 @@ executable chainweb-data
     , servant-client
     , servant-client-core
     , servant-server
+    , servant-swagger-ui
     , stm
     , stm-chans
     , streaming                ^>=0.2

exec/Chainweb/Server.hs

@@ -54,6 +54,7 @@ import           Network.Wai.Handler.Warp
 import           Network.Wai.Middleware.Cors
 import           Servant.API
 import           Servant.Server
+import           Servant.Swagger.UI
 import           System.Directory
 import           System.FilePath
 import           System.Logger.Types hiding (logg)
@@ -74,6 +75,7 @@ import           ChainwebData.Api
 import           ChainwebData.AccountDetail
 import           ChainwebData.EventDetail
 import           ChainwebData.AccountDetail ()
+import qualified ChainwebData.Spec as Spec
 import           ChainwebData.Pagination
 import           ChainwebData.TxDetail
 import           ChainwebData.TxSummary
@@ -138,8 +140,14 @@ type TxEndpoint = "tx" :> QueryParam "requestkey" Text :> Get '[JSON] TxDetail
 type TheApi =
   ChainwebDataApi
   :<|> RichlistEndpoint
-theApi :: Proxy TheApi
-theApi = Proxy
+
+type ApiWithSwaggerUI
+     = TheApi
+  :<|> SwaggerSchemaUI "cwd-spec" "cwd-spec.json"
+
+type ApiWithNoSwaggerUI
+     = TheApi
+  :<|> "cwd-spec" :> Get '[PlainText] Text -- Respond with 404
 
 apiServer :: Env -> ServerEnv -> IO ()
 apiServer env senv = do
@@ -178,8 +186,12 @@ apiServerCut env senv cutBS = do
             :<|> coinsHandler ssRef
           )
           :<|> richlistHandler
+  let swaggerServer = swaggerSchemaUIServer Spec.spec
+      noSwaggerServer = throw404 "Swagger UI server is not enabled on this instance"
   Network.Wai.Handler.Warp.run (_serverEnv_port senv) $ setCors $ \req f ->
-    serve theApi (serverApp req) req f
+    if _serverEnv_serveSwaggerUi senv
+      then serve (Proxy @ApiWithSwaggerUI) (serverApp req :<|> swaggerServer) req f
+      else serve (Proxy @ApiWithNoSwaggerUI) (serverApp req :<|> noSwaggerServer) req f
 
 retryingListener :: Env -> IORef ServerState -> IO ()
 retryingListener env ssRef = do

lib/ChainwebData/Env.hs

@@ -203,6 +203,7 @@ data ServerEnv = ServerEnv
   { _serverEnv_port :: Int
   , _serverEnv_runFill :: Bool
   , _serverEnv_fillDelay :: Maybe Int
+  , _serverEnv_serveSwaggerUi :: Bool
   } deriving (Eq,Ord,Show)
 
 envP :: Parser Args
@@ -284,6 +285,8 @@ serverP = ServerEnv
   <$> option auto (long "port" <> metavar "INT" <> help "Port the server will listen on")
   <*> flag False True (long "run-fill" <> short 'f' <> help "Run fill operation once a day to fill gaps")
   <*> delayP
+  -- The OpenAPI spec is currently rudimentary and not official so we're hiding this option
+  <*> flag False True (long "serve-swagger-ui" <> internal)
 
 delayP :: Parser (Maybe Int)
 delayP = optional $ option auto (long "delay" <> metavar "DELAY_MICROS" <> help  "Number of microseconds to delay between queries to the node")

lib/ChainwebData/Spec.hs

@@ -0,0 +1,72 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
+
+module ChainwebData.Spec where
+
+import ChainwebData.Api
+
+import Data.Proxy
+
+import Data.OpenApi.ParamSchema
+import Data.OpenApi.Schema
+import Servant.OpenApi
+import ChainwebData.Pagination
+import Chainweb.Api.ChainId
+import ChainwebData.TxSummary
+import Data.OpenApi
+
+import ChainwebData.EventDetail (EventDetail)
+import ChainwebData.Util
+import qualified Data.Aeson as A
+import ChainwebData.TxDetail
+import ChainwebData.AccountDetail (AccountDetail)
+
+instance ToSchema A.Value where
+  declareNamedSchema _ = pure $ NamedSchema (Just "AnyValue") mempty
+
+deriving newtype instance ToParamSchema Limit
+deriving newtype instance ToParamSchema Offset
+deriving newtype instance ToParamSchema EventParam
+deriving newtype instance ToParamSchema EventName
+deriving newtype instance ToParamSchema EventModuleName
+deriving newtype instance ToParamSchema RequestKey
+deriving newtype instance ToParamSchema ChainId
+deriving newtype instance ToParamSchema NextToken
+
+instance ToSchema TxSummary where
+  declareNamedSchema = genericDeclareNamedSchema
+    defaultSchemaOptions{ fieldLabelModifier = drop 11 }
+
+deriving anyclass instance ToSchema TxResult
+
+instance ToSchema EventDetail where
+  declareNamedSchema = genericDeclareNamedSchema
+    defaultSchemaOptions{ fieldLabelModifier = lensyConstructorToNiceJson 10 }
+
+instance ToSchema TxDetail where
+  declareNamedSchema = genericDeclareNamedSchema
+    defaultSchemaOptions{ fieldLabelModifier = lensyConstructorToNiceJson 10 }
+
+instance ToSchema TxEvent where
+  declareNamedSchema = genericDeclareNamedSchema
+    defaultSchemaOptions{ fieldLabelModifier = lensyConstructorToNiceJson 9 }
+
+instance ToSchema AccountDetail where
+  declareNamedSchema = genericDeclareNamedSchema
+    defaultSchemaOptions{ fieldLabelModifier = lensyConstructorToNiceJson 10 }
+
+instance ToSchema ChainwebDataStats where
+  declareNamedSchema = genericDeclareNamedSchema
+    defaultSchemaOptions{ fieldLabelModifier = drop 5 }
+
+spec :: OpenApi
+spec = toOpenApi (Proxy :: Proxy ChainwebDataApi)
+