diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,45 @@ +Copyright (c) 2016, Oleg Grenrus + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Oleg Grenrus nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +--- + +Bundled swagger-ui (index.html.tmpl original and swagger-dist-2.1.4 directory): + +Copyright 2016 SmartBear Software + +Licensed under the Apache License, Version 2.0 (the "License"); you may not use +this file except in compliance with the License. You may obtain a copy of the +License at apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software distributed +under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR +CONDITIONS OF ANY KIND, either express or implied. See the License for the +specific language governing permissions and limitations under the License. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/servant-swagger-ui-core.cabal b/servant-swagger-ui-core.cabal new file mode 100644 --- /dev/null +++ b/servant-swagger-ui-core.cabal @@ -0,0 +1,58 @@ +cabal-version: 1.12 +name: servant-swagger-ui-core +version: 0.3 + +synopsis: Servant swagger ui core components +category: Web, Servant, Swagger +description: + Provide embedded swagger UI for servant and swagger (i.e. servant-swagger) + . + See servant-swagger-ui, servant-swagger-ui-jensoleg or + servant-swagger-ui-redoc for "concrete" implementations. + +homepage: https://github.com/phadej/servant-swagger-ui +bug-reports: https://github.com/phadej/servant-swagger-ui/issues +author: Oleg Grenrus +maintainer: Oleg Grenrus +license: BSD3 +license-file: LICENSE +build-type: Simple +tested-with: GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.2 + +source-repository head + type: git + location: https://github.com/phadej/servant-swagger-ui + +flag servant-0-5 + description: Whether use servant >= 0.5 + manual: False + default: True + +library + hs-source-dirs: + src + ghc-options: -Wall + + build-depends: + base >=4.7 && <4.12 + , blaze-markup >=0.7.0.2 && <0.9 + , bytestring >=0.10.4.0 && <0.11 + , http-media >=0.6.2 && <0.8 + , servant >=0.4.4.5 && <0.14 + , servant-blaze >=0.4.4.5 && <0.9 + , servant-server >=0.4.4.5 && <0.14 + , swagger2 >=2.0.1 && <2.3 + , text >=1.2.0.6 && <1.3 + , wai-app-static >=3.0.1.1 && <3.2 + if flag(servant-0-5) + build-depends: + servant >=0.5 + , transformers >=0.3 && <0.6 + , transformers-compat >=0.3 && <0.6 + else + build-depends: + servant <0.5 + , either + exposed-modules: + Servant.Swagger.UI.Core + default-language: Haskell2010 diff --git a/src/Servant/Swagger/UI/Core.hs b/src/Servant/Swagger/UI/Core.hs new file mode 100644 --- /dev/null +++ b/src/Servant/Swagger/UI/Core.hs @@ -0,0 +1,136 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +----------------------------------------------------------------------------- +-- +-- Provides 'SwaggerUI' and corresponding 'swaggerUIServer' to embed +-- into the application. +-- +-- All of UI files are embedded into the binary. +-- +-- /An example:/ +-- +-- @ +-- -- | Actual API. +-- type BasicAPI = Get '[PlainText, JSON] Text +-- :\<|> "cat" :> Capture ":name" CatName :> Get '[JSON] Cat +-- +-- -- | API type with bells and whistles, i.e. schema file and swagger-ui. +-- type API = 'SwaggerSchemaUI' "swagger-ui" "swagger.json" +-- :\<|> BasicAPI +-- +-- -- | Servant server for an API +-- server :: Server API +-- server = 'swaggerSchemaUIServer' swaggerDoc +-- :\<|> (pure "Hello World" :\<|> catEndpoint) +-- where +-- catEndpoint name = pure $ Cat name False +-- @ + +module Servant.Swagger.UI.Core ( + -- * Swagger UI API + SwaggerSchemaUI, + SwaggerSchemaUI', + + -- * Implementation details + SwaggerUiHtml(..), + swaggerSchemaUIServerImpl, + Handler, + ) where + +import Data.ByteString (ByteString) +import Data.Swagger (Swagger) +import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) +import Network.Wai.Application.Static (embeddedSettings, staticApp) +import Servant +import Servant.HTML.Blaze (HTML) +import Text.Blaze (ToMarkup (..)) + +import qualified Data.Text as T + +#if MIN_VERSION_servant(0,7,0) +-- do nothing +#else +#if MIN_VERSION_servant(0,5,0) +import Control.Monad.Trans.Except (ExceptT) +type Handler = ExceptT ServantErr IO +#else +import Control.Monad.Trans.Either (EitherT) +type Handler = EitherT ServantErr IO +#endif +#endif + +-- | Swagger schema + ui api. +-- +-- @SwaggerSchemaUI "swagger-ui" "swagger.json"@ will result into following hierarchy: +-- +-- @ +-- \/swagger.json +-- \/swagger-ui +-- \/swagger-ui\/index.html +-- \/swagger-ui\/... +-- @ +-- +type SwaggerSchemaUI (dir :: Symbol) (schema :: Symbol) = + SwaggerSchemaUI' dir (schema :> Get '[JSON] Swagger) + +-- | Use 'SwaggerSchemaUI'' when you need even more control over +-- where @swagger.json@ is served (e.g. subdirectory). +type SwaggerSchemaUI' (dir :: Symbol) (api :: *) = + api + :<|> dir :> + ( Get '[HTML] (SwaggerUiHtml dir api) + :<|> "index.html" :> Get '[HTML] (SwaggerUiHtml dir api) + :<|> Raw + ) + +-- | Index file for swagger ui. +-- +-- It's configured by the location of swagger schema and directory it lives under. +-- +-- Implementation detail: the @index.html@ is prepopulated with parameters +-- to find schema file automatically. +data SwaggerUiHtml (dir :: Symbol) (api :: *) = SwaggerUiHtml T.Text + +#if MIN_VERSION_servant(0,10,0) +#define LINK Link +#define LINKPATH uriPath . linkURI +#else +#define LINK URI +#define LINKPATH uriPath +#endif + +instance (KnownSymbol dir, HasLink api, LINK ~ MkLink api, IsElem api api) + => ToMarkup (SwaggerUiHtml dir api) + where + toMarkup (SwaggerUiHtml template) = preEscapedToMarkup + $ T.replace "SERVANT_SWAGGER_UI_SCHEMA" schema + $ T.replace "SERVANT_SWAGGER_UI_DIR" dir + $ template + where + schema = T.pack $ LINKPATH $ safeLink proxyApi proxyApi + dir = T.pack $ symbolVal (Proxy :: Proxy dir) + proxyApi = Proxy :: Proxy api + +swaggerSchemaUIServerImpl + :: (Server api ~ Handler Swagger) + => T.Text -> [(FilePath, ByteString)] + -> Swagger -> Server (SwaggerSchemaUI' dir api) +swaggerSchemaUIServerImpl indexTemplate files swagger = return swagger + :<|> return (SwaggerUiHtml indexTemplate) + :<|> return (SwaggerUiHtml indexTemplate) + :<|> rest + where + rest = +#if MIN_VERSION_servant_server(0,11,0) + Tagged $ +#endif + staticApp $ embeddedSettings files