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| + + + + ReDoc + + + + + + + + + +|] + diff --git a/node/cardano-sl-node.cabal b/node/cardano-sl-node.cabal index a72f802fd38..357105fbdc8 100644 --- a/node/cardano-sl-node.cabal +++ b/node/cardano-sl-node.cabal @@ -18,6 +18,7 @@ library hs-source-dirs: src build-depends: base , aeson + , async , bytestring , connection , cardano-sl @@ -37,7 +38,10 @@ library , lens , servant-client , servant-server + , servant-swagger + , servant-swagger-ui , stm + , swagger2 , text , time-units , tls @@ -48,6 +52,7 @@ library , x509-store exposed-modules: Cardano.Node.API + Cardano.Node.API.Swagger Cardano.Node.Client Cardano.Node.Manager diff --git a/node/src/Cardano/Node/API.hs b/node/src/Cardano/Node/API.hs index 9852a604c10..20677de2780 100644 --- a/node/src/Cardano/Node/API.hs +++ b/node/src/Cardano/Node/API.hs @@ -1,12 +1,11 @@ {-# LANGUAGE LambdaCase #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -- | This module implements the API defined in "Pos.Node.API". module Cardano.Node.API where import Universum +import Control.Concurrent.Async (concurrently_) import Control.Concurrent.STM (orElse, retry) import Control.Lens (lens, makeLensesWith, to) import Data.Aeson (encode) @@ -51,6 +50,8 @@ import Pos.Util.Servant (APIResponse (..), JsendException (..), import Pos.Web (serveImpl) import qualified Pos.Web as Legacy +import Cardano.Node.API.Swagger (forkDocServer) + type NodeV1Api = "api" :> "v1" :> ( Node.API @@ -146,14 +147,25 @@ launchNodeServer compileTimeInfo :<|> legacyApi - serveImpl - (pure app) - (BS8.unpack ipAddress) - portNumber - (do guard (not isDebug) - nodeBackendTLSParams params) - (Just exceptionResponse) - Nothing -- TODO: Set a port callback for shutdown/IPC + concurrently_ + (serveImpl + (pure app) + (BS8.unpack ipAddress) + portNumber + (do guard (not isDebug) + nodeBackendTLSParams params) + (Just exceptionResponse) + Nothing -- TODO: Set a port callback for shutdown/IPC + ) + (forkDocServer + (Proxy @NodeV1Api) + (curSoftwareVersion updateConfiguration) + (BS8.unpack docAddress) + docPort + (do guard (not isDebug) + nodeBackendTLSParams params) + + ) where isDebug = nodeBackendDebugMode params exceptionResponse = @@ -167,6 +179,7 @@ launchNodeServer nodeCtx = nrContext nodeResources (slottingVarTimestamp, slottingVar) = ncSlottingVar nodeCtx (ipAddress, portNumber) = nodeBackendAddress params + (docAddress, docPort) = nodeBackendDocAddress params handlers :: Diffusion IO diff --git a/node/src/Cardano/Node/API/Swagger.hs b/node/src/Cardano/Node/API/Swagger.hs new file mode 100644 index 00000000000..cc1ac9d2a48 --- /dev/null +++ b/node/src/Cardano/Node/API/Swagger.hs @@ -0,0 +1,77 @@ +-- necessary for `ToParamSchema Core.EpochIndex` +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Cardano.Node.API.Swagger where + +import Universum + +import Control.Lens (at, (?~)) +import Data.Swagger +import Servant +import Servant.Swagger +import Servant.Swagger.UI (SwaggerSchemaUI) + +import Pos.Chain.Txp (TxIn, TxOut, TxOutAux) +import Pos.Chain.Update (SoftwareVersion) +import Pos.Util.Swagger (swaggerSchemaUIServer) +import Pos.Web (CConfirmedProposalState, serveDocImpl) +import Pos.Web.Types (TlsParams) + +forkDocServer + :: HasSwagger a + => Proxy a + -> SoftwareVersion + -> String + -> Word16 + -> Maybe TlsParams + -> IO () +forkDocServer prxy swVersion ip port' tlsParams = + serveDocImpl + (pure app) + ip + port' + tlsParams + Nothing + Nothing + where + app = + serve + (Proxy @("docs" :> "v1" :> SwaggerSchemaUI "index" "swagger.json")) + (swaggerSchemaUIServer (documentationApi swVersion prxy)) + +documentationApi + :: HasSwagger a + => SoftwareVersion + -> Proxy a + -> Swagger +documentationApi curSoftwareVersion prxy = toSwagger prxy + & info.title .~ "Cardano Node API" + & info.version .~ fromString (show curSoftwareVersion) + & host ?~ "127.0.0.1:8083" + & info.license ?~ ("MIT" & url ?~ URL "https://raw.githubusercontent.com/input-output-hk/cardano-sl/develop/lib/LICENSE") + +instance ToParamSchema TxIn where + toParamSchema _ = mempty + & type_ .~ SwaggerString + +instance ToSchema TxIn where + declareNamedSchema = pure . paramSchemaToNamedSchema defaultSchemaOptions + +instance ToSchema TxOut where + declareNamedSchema _ = + pure $ NamedSchema (Just "TxOut") $ mempty + & type_ .~ SwaggerObject + & required .~ ["coin", "address"] + & properties .~ (mempty + & at "coin" ?~ (Inline $ mempty + & type_ .~ SwaggerNumber + ) + & at "address" ?~ (Inline $ mempty + & type_ .~ SwaggerString + ) + ) + +instance ToSchema TxOutAux + +instance ToSchema CConfirmedProposalState + diff --git a/pkgs/default.nix b/pkgs/default.nix index 19c6deea293..c9e1ee4edf7 100644 --- a/pkgs/default.nix +++ b/pkgs/default.nix @@ -13548,6 +13548,9 @@ license = stdenv.lib.licenses.bsd3; , servant-client-core , servant-server , servant-swagger +, servant-swagger-ui +, servant-swagger-ui-core +, servant-swagger-ui-redoc , stdenv , stm , streaming-commons @@ -13646,6 +13649,9 @@ servant-client servant-client-core servant-server servant-swagger +servant-swagger-ui +servant-swagger-ui-core +servant-swagger-ui-redoc stm streaming-commons swagger2 @@ -16083,6 +16089,7 @@ license = stdenv.lib.licenses.mit; ({ mkDerivation , aeson +, async , base , bytestring , cardano-sl @@ -16111,8 +16118,11 @@ license = stdenv.lib.licenses.mit; , QuickCheck , servant-client , servant-server +, servant-swagger +, servant-swagger-ui , stdenv , stm +, swagger2 , text , time-units , tls @@ -16138,6 +16148,7 @@ isLibrary = true; isExecutable = true; libraryHaskellDepends = [ aeson +async base bytestring cardano-sl @@ -16158,7 +16169,10 @@ http-types lens servant-client servant-server +servant-swagger +servant-swagger-ui stm +swagger2 text time-units tls diff --git a/wallet-new b/wallet-new index 7c57ea665ed..f8cf01a12ff 160000 --- a/wallet-new +++ b/wallet-new @@ -1 +1 @@ -Subproject commit 7c57ea665edf3545d4f378828227e28e66f44954 +Subproject commit f8cf01a12ff204f2e6938fa466f6734a497956f9