diff --git a/lib/cardano-sl.cabal b/lib/cardano-sl.cabal index e77bb6fbcec..c74575f4a33 100644 --- a/lib/cardano-sl.cabal +++ b/lib/cardano-sl.cabal @@ -116,6 +116,7 @@ library Test.Pos.Configuration Pos.Util.Servant + Pos.Util.Swagger Pos.Util.Jsend Pos.Util.UnitsOfMeasure Pos.Util.Pagination @@ -202,6 +203,9 @@ library , servant-client-core >= 0.8.1 , servant-server >= 0.8.1 , servant-swagger + , servant-swagger-ui + , servant-swagger-ui-core + , servant-swagger-ui-redoc , stm , streaming-commons , swagger2 diff --git a/lib/src/Pos/Client/CLI/NodeOptions.hs b/lib/src/Pos/Client/CLI/NodeOptions.hs index e31bd287149..bd3a0cddc0f 100644 --- a/lib/src/Pos/Client/CLI/NodeOptions.hs +++ b/lib/src/Pos/Client/CLI/NodeOptions.hs @@ -173,17 +173,18 @@ nodeWithApiArgsParser = nodeApiArgsParser :: Parser NodeApiArgs nodeApiArgsParser = NodeApiArgs - <$> addressParser + <$> addressParser "node-api-address" (localhost, 8083) <*> tlsParamsParser <*> debugModeParser + <*> addressParser "node-doc-address" (localhost, 8084) where - addressParser = + addressParser flagName defValue = option (fromParsec addrParser) $ - long "node-api-address" + long flagName <> metavar "IP:PORT" <> help helpMsg <> showDefault - <> value (localhost, 8083) + <> value defValue helpMsg = "IP and port for backend node API." debugModeParser :: Parser Bool debugModeParser = @@ -193,9 +194,10 @@ nodeApiArgsParser = ) data NodeApiArgs = NodeApiArgs - { nodeBackendAddress :: !NetworkAddress - , nodeBackendTLSParams :: !(Maybe TlsParams) - , nodeBackendDebugMode :: !Bool + { nodeBackendAddress :: !NetworkAddress + , nodeBackendTLSParams :: !(Maybe TlsParams) + , nodeBackendDebugMode :: !Bool + , nodeBackendDocAddress :: !NetworkAddress } deriving Show tlsParamsParser :: Parser (Maybe TlsParams) diff --git a/lib/src/Pos/Node/API.hs b/lib/src/Pos/Node/API.hs index 5bc0f483075..4d2c90ddeb5 100644 --- a/lib/src/Pos/Node/API.hs +++ b/lib/src/Pos/Node/API.hs @@ -43,7 +43,7 @@ import Pos.Infra.Util.LogSafe (BuildableSafeGen (..), SecureLog (..), deriveSafeBuildable) import Pos.Util.Example import Pos.Util.Servant (APIResponse, CustomQueryFlag, Flaggable (..), - Tags, ValidJSON) + HasCustomQueryFlagDescription (..), Tags, ValidJSON) import Pos.Util.UnitsOfMeasure import Serokell.Util.Text @@ -107,6 +107,10 @@ instance BuildableSafeGen ForceNtpCheck where buildSafeGen _ ForceNtpCheck = "force ntp check" buildSafeGen _ NoNtpCheck = "no ntp check" +forceNtpCheckDescription :: T.Text +forceNtpCheckDescription = + "In some cases, API Clients need to force a new NTP check as a previous result gets cached. A typical use-case is after asking a user to fix its system clock. If this flag is set, request will block until NTP server responds or it will timout if NTP server is not available within **30** seconds." + -- | The different between the local time and the remote NTP server. newtype LocalTimeDifference = LocalTimeDifference (MeasuredIn 'Microseconds Integer) @@ -599,6 +603,9 @@ type InfoAPI = :> CustomQueryFlag "force_ntp_check" ForceNtpCheck :> Get '[ValidJSON] (APIResponse NodeInfo) +instance HasCustomQueryFlagDescription "force_ntp_check" where + customDescription _ = Just forceNtpCheckDescription + -- The API definition is down here for now due to TH staging restrictions. Will -- relocate other stuff into it's own module when the extraction is complete. type API = diff --git a/lib/src/Pos/Util/Servant.hs b/lib/src/Pos/Util/Servant.hs index 064b09c7e78..e38274a6275 100644 --- a/lib/src/Pos/Util/Servant.hs +++ b/lib/src/Pos/Util/Servant.hs @@ -60,6 +60,7 @@ module Pos.Util.Servant , Flaggable (..) , CustomQueryFlag + , HasCustomQueryFlagDescription(..) , serverHandlerL , serverHandlerL' @@ -80,7 +81,7 @@ module Pos.Util.Servant import Universum import Control.Exception.Safe (handleAny) -import Control.Lens (Iso, iso, ix, makePrisms) +import Control.Lens (Iso, iso, ix, makePrisms, (?~)) import Control.Monad.Except (ExceptT (..), MonadError (..)) import Data.Aeson (FromJSON (..), ToJSON (..), eitherDecode, encode, object, (.=)) @@ -118,7 +119,8 @@ import Servant.Client.Core (RunClient) import Servant.Server (Handler (..), HasServer (..), ServantErr (..), Server) import qualified Servant.Server.Internal as SI -import Servant.Swagger (HasSwagger (toSwagger)) +import Servant.Swagger +import Servant.Swagger.Internal import Test.QuickCheck import Pos.Infra.Util.LogSafe (BuildableSafe, SecuredText, buildSafe, @@ -762,6 +764,30 @@ instance ReportDecodeError api => -- Boolean type for all flags but we can implement custom type. data CustomQueryFlag (sym :: Symbol) flag +instance + ( KnownSymbol sym + , HasSwagger sub + , HasCustomQueryFlagDescription sym + ) => HasSwagger (CustomQueryFlag sym flag :> sub) + where + toSwagger _ = toSwagger (Proxy :: Proxy sub) + & addParam param + & addDefaultResponse400 tname + where + tname = T.pack (symbolVal (Proxy :: Proxy sym)) + param = mempty + & name .~ tname + & description .~ customDescription (Proxy @sym) + & schema .~ ParamOther (mempty + & in_ .~ ParamQuery + & allowEmptyValue ?~ True + & paramSchema .~ (toParamSchema (Proxy :: Proxy Bool) + & default_ ?~ toJSON False)) + +class HasCustomQueryFlagDescription (sym :: Symbol) where + customDescription :: Proxy sym -> Maybe Text + customDescription _ = Nothing + class Flaggable flag where toBool :: flag -> Bool fromBool :: Bool -> flag @@ -770,7 +796,6 @@ instance Flaggable Bool where toBool = identity fromBool = identity --- TODO (akegalj): this instance is almost the same as upstream HasServer instance of QueryFlag. The only difference is addition of `fromBool` function in `route` implementation. Can we somehow reuse `route` implementation of CustomQuery instead of copy-pasting it here with this small `fromBool` addition? instance (KnownSymbol sym, HasServer api context, Flaggable flag) => HasServer (CustomQueryFlag sym flag :> api) context where diff --git a/lib/src/Pos/Util/Swagger.hs b/lib/src/Pos/Util/Swagger.hs new file mode 100644 index 00000000000..8cf98f5cd97 --- /dev/null +++ b/lib/src/Pos/Util/Swagger.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Pos.Util.Swagger where + +import Universum + +import Data.Swagger +import NeatInterpolation (text) +import Servant.Server (Handler, Server) +import Servant.Swagger.UI.Core (SwaggerSchemaUI', + swaggerSchemaUIServerImpl) +import Servant.Swagger.UI.ReDoc (redocFiles) + +-- | Provide an alternative UI (ReDoc) for rendering Swagger documentation. +swaggerSchemaUIServer + :: (Server api ~ Handler Swagger) + => Swagger -> Server (SwaggerSchemaUI' dir api) +swaggerSchemaUIServer = + swaggerSchemaUIServerImpl redocIndexTemplate redocFiles + where + redocIndexTemplate :: Text + redocIndexTemplate = [text| + + +
+