{-# LANGUAGE QuasiQuotes #-}

-- | Host swagger-ui based on WebGear API specifications
module WebGear.Swagger.UI (
  swaggerUI,
) where

import Control.Arrow ((<+>))
import Data.ByteString (ByteString)
import Data.Text (Text)
import qualified Network.HTTP.Types as HTTP
import Network.Wai.Application.Static (embeddedSettings)
import WebGear.Core (
  Body,
  HTML (..),
  JSON (..),
  RequestHandler,
  RequiredResponseHeader,
  Response (..),
  Sets,
  StdHandler,
  UnknownContentBody,
  match,
  method,
  pathEnd,
  respondA,
  route,
  serveStatic,
 )
import qualified WebGear.Swagger.UI.Embedded as Embedded

{- | An API that hosts a few endpoints for swagger-ui.

- @/@ - redirects to @/index.html@
- @/index.html@ - UI entry point for swagger-ui
- @/swagger.json@ - Swagger/OpenAPI specification in json format
- @/...@ - Other UI assets required for swagger-ui
-}
swaggerUI ::
  ( StdHandler h m
  , Sets
      h
      [ RequiredResponseHeader "Content-Type" Text
      , Body HTML ByteString
      , Body JSON apiSpec
      , UnknownContentBody
      ]
      Response
  ) =>
  -- | Swagger 2.0 or OpenAPI 3.x specification
  apiSpec ->
  RequestHandler h ts
swaggerUI :: forall (h :: * -> * -> *) (m :: * -> *) apiSpec (ts :: [*]).
(StdHandler h m,
 Sets
   h
   '[RequiredResponseHeader "Content-Type" Text, Body HTML ByteString,
     Body JSON apiSpec, UnknownContentBody]
   Response) =>
apiSpec -> RequestHandler h ts
swaggerUI apiSpec
apiSpec =
  RequestHandler h ts
forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
(StdHandler h m,
 Sets
   h
   '[RequiredResponseHeader "Content-Type" Text, Body HTML ByteString]
   Response) =>
RequestHandler h ts
rootEndpoint
    RequestHandler h ts -> RequestHandler h ts -> RequestHandler h ts
forall b c. h b c -> h b c -> h b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> RequestHandler h ts
forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
(StdHandler h m,
 Sets
   h
   '[RequiredResponseHeader "Content-Type" Text, Body HTML ByteString]
   Response) =>
RequestHandler h ts
indexHtml
    RequestHandler h ts -> RequestHandler h ts -> RequestHandler h ts
forall b c. h b c -> h b c -> h b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> apiSpec -> RequestHandler h ts
forall (h :: * -> * -> *) (m :: * -> *) apiSpec (ts :: [*]).
(StdHandler h m,
 Sets
   h
   '[RequiredResponseHeader "Content-Type" Text, Body JSON apiSpec]
   Response) =>
apiSpec -> RequestHandler h ts
swaggerJson apiSpec
apiSpec
    RequestHandler h ts -> RequestHandler h ts -> RequestHandler h ts
forall b c. h b c -> h b c -> h b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> RequestHandler h ts
forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
StdHandler h m =>
RequestHandler h ts
uiAssets

rootEndpoint ::
  ( StdHandler h m
  , Sets h [RequiredResponseHeader "Content-Type" Text, Body HTML ByteString] Response
  ) =>
  RequestHandler h ts
rootEndpoint :: forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
(StdHandler h m,
 Sets
   h
   '[RequiredResponseHeader "Content-Type" Text, Body HTML ByteString]
   Response) =>
RequestHandler h ts
rootEndpoint = StdMethod -> Middleware h ts (Method : ts)
forall (h :: * -> * -> *) (ts :: [*]).
(Get h Method Request, ArrowChoice h,
 ArrowError RouteMismatch h) =>
StdMethod -> Middleware h ts (Method : ts)
method StdMethod
HTTP.GET Middleware h ts (Method : ts) -> Middleware h ts (Method : ts)
forall a b. (a -> b) -> a -> b
$ Middleware h (Method : ts) (PathEnd : Method : ts)
forall (h :: * -> * -> *) (ts :: [*]).
(Get h PathEnd Request, ArrowChoice h,
 ArrowError RouteMismatch h) =>
Middleware h ts (PathEnd : ts)
pathEnd RequestHandler h (PathEnd : Method : ts)
forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
(StdHandler h m,
 Sets
   h
   '[RequiredResponseHeader "Content-Type" Text, Body HTML ByteString]
   Response) =>
RequestHandler h ts
serveIndexHtml

indexHtml ::
  ( StdHandler h m
  , Sets h [RequiredResponseHeader "Content-Type" Text, Body HTML ByteString] Response
  ) =>
  RequestHandler h ts
indexHtml :: forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
(StdHandler h m,
 Sets
   h
   '[RequiredResponseHeader "Content-Type" Text, Body HTML ByteString]
   Response) =>
RequestHandler h ts
indexHtml = [route| HTTP.GET /index.html |] RequestHandler h (PathEnd : Path : Method : ts)
forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
(StdHandler h m,
 Sets
   h
   '[RequiredResponseHeader "Content-Type" Text, Body HTML ByteString]
   Response) =>
RequestHandler h ts
serveIndexHtml

serveIndexHtml ::
  ( StdHandler h m
  , Sets h [RequiredResponseHeader "Content-Type" Text, Body HTML ByteString] Response
  ) =>
  RequestHandler h ts
serveIndexHtml :: forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
(StdHandler h m,
 Sets
   h
   '[RequiredResponseHeader "Content-Type" Text, Body HTML ByteString]
   Response) =>
RequestHandler h ts
serveIndexHtml = proc With Request ts
_request ->
  Status -> HTML -> h ByteString Response
forall body mt (h :: * -> * -> *) (m :: * -> *).
(Handler h m,
 Sets
   h
   '[Status, Body mt body, RequiredResponseHeader "Content-Type" Text]
   Response,
 MIMEType mt) =>
Status -> mt -> h body Response
respondA Status
HTTP.ok200 HTML
HTML -< ByteString
Embedded.indexHtmlFile

swaggerJson ::
  ( StdHandler h m
  , Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON apiSpec] Response
  ) =>
  -- | Swagger 2.0 or OpenAPI 3.x specification
  apiSpec ->
  RequestHandler h ts
swaggerJson :: forall (h :: * -> * -> *) (m :: * -> *) apiSpec (ts :: [*]).
(StdHandler h m,
 Sets
   h
   '[RequiredResponseHeader "Content-Type" Text, Body JSON apiSpec]
   Response) =>
apiSpec -> RequestHandler h ts
swaggerJson apiSpec
apiSpec =
  [route| HTTP.GET /swagger.json |] (RequestHandler h (PathEnd : Path : Method : ts)
 -> RequestHandler h ts)
-> RequestHandler h (PathEnd : Path : Method : ts)
-> RequestHandler h ts
forall a b. (a -> b) -> a -> b
$
    proc With Request (PathEnd : Path : Method : ts)
_request -> Status -> JSON -> h apiSpec Response
forall body mt (h :: * -> * -> *) (m :: * -> *).
(Handler h m,
 Sets
   h
   '[Status, Body mt body, RequiredResponseHeader "Content-Type" Text]
   Response,
 MIMEType mt) =>
Status -> mt -> h body Response
respondA Status
HTTP.ok200 JSON
JSON -< apiSpec
apiSpec

uiAssets :: (StdHandler h m) => RequestHandler h ts
uiAssets :: forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
StdHandler h m =>
RequestHandler h ts
uiAssets =
  [match| HTTP.GET / |] Middleware h ts (Method : ts) -> Middleware h ts (Method : ts)
forall a b. (a -> b) -> a -> b
$
    StaticSettings -> RequestHandler h (Method : ts)
forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
Handler h m =>
StaticSettings -> RequestHandler h ts
serveStatic ([(String, ByteString)] -> StaticSettings
embeddedSettings [(String, ByteString)]
Embedded.uiAssetsDir)