{-# LANGUAGE CPP                  #-}
{-# LANGUAGE ConstraintKinds      #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE PolyKinds            #-}
{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeOperators        #-}
#if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE UndecidableInstances #-}
#endif
{-# OPTIONS_GHC -Wno-orphans #-}
module Servant.OpenApi.Internal where

import Prelude ()
import Prelude.Compat

#if MIN_VERSION_servant(0,18,1)
import           Control.Applicative                    ((<|>))
#endif
import           Control.Lens
import           Data.Aeson
import           Data.Foldable              (toList)
import           Data.HashMap.Strict.InsOrd (InsOrdHashMap)
import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
import           Data.OpenApi               hiding (Header, contentType)
import qualified Data.OpenApi               as OpenApi
import           Data.OpenApi.Declare
import           Data.Proxy
import           Data.Singletons.Bool
import           Data.Text                  (Text)
import qualified Data.Text                  as Text
import           Data.Typeable              (Typeable)
import           GHC.TypeLits
import           Network.HTTP.Media         (MediaType)
import           Servant.API
import           Servant.API.Description    (FoldDescription, reflectDescription)
import           Servant.API.Modifiers      (FoldRequired)

import           Servant.OpenApi.Internal.TypeLevel.API

-- | Generate a OpenApi specification for a servant API.
--
-- To generate OpenApi specification, your data types need
-- @'ToParamSchema'@ and/or @'ToSchema'@ instances.
--
-- @'ToParamSchema'@ is used for @'Capture'@, @'QueryParam'@ and @'Header'@.
-- @'ToSchema'@ is used for @'ReqBody'@ and response data types.
--
-- You can easily derive those instances via @Generic@.
-- For more information, refer to
-- <http://hackage.haskell.org/package/openapi3/docs/Data-OpenApi.html openapi3 documentation>.
--
-- Example:
--
-- @
-- newtype Username = Username String deriving (Generic, ToText)
--
-- instance ToParamSchema Username
--
-- data User = User
--   { username :: Username
--   , fullname :: String
--   } deriving (Generic)
--
-- instance ToJSON User
-- instance ToSchema User
--
-- type MyAPI = QueryParam "username" Username :> Get '[JSON] User
--
-- myOpenApi :: OpenApi
-- myOpenApi = toOpenApi (Proxy :: Proxy MyAPI)
-- @
class HasOpenApi api where
  -- | Generate a OpenApi specification for a servant API.
  toOpenApi :: Proxy api -> OpenApi

instance HasOpenApi Raw where
  toOpenApi :: Proxy Raw -> OpenApi
toOpenApi Proxy Raw
_ = OpenApi
forall a. Monoid a => a
mempty OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap FilePath PathItem
 -> Identity (InsOrdHashMap FilePath PathItem))
-> OpenApi -> Identity OpenApi
forall s a. HasPaths s a => Lens' s a
paths ((InsOrdHashMap FilePath PathItem
  -> Identity (InsOrdHashMap FilePath PathItem))
 -> OpenApi -> Identity OpenApi)
-> ((Maybe PathItem -> Identity (Maybe PathItem))
    -> InsOrdHashMap FilePath PathItem
    -> Identity (InsOrdHashMap FilePath PathItem))
-> (Maybe PathItem -> Identity (Maybe PathItem))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap FilePath PathItem)
-> Lens'
     (InsOrdHashMap FilePath PathItem)
     (Maybe (IxValue (InsOrdHashMap FilePath PathItem)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (InsOrdHashMap FilePath PathItem)
"/" ((Maybe PathItem -> Identity (Maybe PathItem))
 -> OpenApi -> Identity OpenApi)
-> PathItem -> OpenApi -> OpenApi
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ PathItem
forall a. Monoid a => a
mempty

instance HasOpenApi EmptyAPI where
  toOpenApi :: Proxy EmptyAPI -> OpenApi
toOpenApi Proxy EmptyAPI
_ = OpenApi
forall a. Monoid a => a
mempty

-- | All operations of sub API.
-- This is similar to @'operationsOf'@ but ensures that operations
-- indeed belong to the API at compile time.
subOperations :: (IsSubAPI sub api, HasOpenApi sub) =>
  Proxy sub     -- ^ Part of a servant API.
  -> Proxy api  -- ^ The whole servant API.
  -> Traversal' OpenApi Operation
subOperations :: Proxy sub -> Proxy api -> Traversal' OpenApi Operation
subOperations Proxy sub
sub Proxy api
_ = OpenApi -> Traversal' OpenApi Operation
operationsOf (Proxy sub -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi Proxy sub
sub)

-- | Make a singleton OpenApi spec (with only one endpoint).
-- For endpoints with no content see 'mkEndpointNoContent'.
mkEndpoint :: forall a cs hs proxy method status.
  (ToSchema a, AllAccept cs, AllToResponseHeader hs, OpenApiMethod method, KnownNat status)
  => FilePath                                       -- ^ Endpoint path.
  -> proxy (Verb method status cs (Headers hs a))  -- ^ Method, content-types, headers and response.
  -> OpenApi
mkEndpoint :: FilePath -> proxy (Verb method status cs (Headers hs a)) -> OpenApi
mkEndpoint FilePath
path proxy (Verb method status cs (Headers hs a))
proxy
  = Maybe (Referenced Schema)
-> FilePath
-> proxy (Verb method status cs (Headers hs a))
-> OpenApi
forall k1 (cs :: [*]) (hs :: [*]) (proxy :: * -> *) (method :: k1)
       (status :: Nat) a.
(AllAccept cs, AllToResponseHeader hs, OpenApiMethod method,
 KnownNat status) =>
Maybe (Referenced Schema)
-> FilePath
-> proxy (Verb method status cs (Headers hs a))
-> OpenApi
mkEndpointWithSchemaRef (Referenced Schema -> Maybe (Referenced Schema)
forall a. a -> Maybe a
Just Referenced Schema
ref) FilePath
path proxy (Verb method status cs (Headers hs a))
proxy
      OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (Components -> Identity Components) -> OpenApi -> Identity OpenApi
forall s a. HasComponents s a => Lens' s a
components((Components -> Identity Components)
 -> OpenApi -> Identity OpenApi)
-> ((Definitions Schema -> Identity (Definitions Schema))
    -> Components -> Identity Components)
-> (Definitions Schema -> Identity (Definitions Schema))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Definitions Schema -> Identity (Definitions Schema))
-> Components -> Identity Components
forall s a. HasSchemas s a => Lens' s a
schemas ((Definitions Schema -> Identity (Definitions Schema))
 -> OpenApi -> Identity OpenApi)
-> Definitions Schema -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Definitions Schema
defs
  where
    (Definitions Schema
defs, Referenced Schema
ref) = Declare (Definitions Schema) (Referenced Schema)
-> Definitions Schema -> (Definitions Schema, Referenced Schema)
forall d a. Declare d a -> d -> (d, a)
runDeclare (Proxy a -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) Definitions Schema
forall a. Monoid a => a
mempty

-- | Make a singletone 'OpenApi' spec (with only one endpoint) and with no content schema.
mkEndpointNoContent :: forall nocontent cs hs proxy method status.
  (AllAccept cs, AllToResponseHeader hs, OpenApiMethod method, KnownNat status)
  => FilePath                                               -- ^ Endpoint path.
  -> proxy (Verb method status cs (Headers hs nocontent))  -- ^ Method, content-types, headers and response.
  -> OpenApi
mkEndpointNoContent :: FilePath
-> proxy (Verb method status cs (Headers hs nocontent)) -> OpenApi
mkEndpointNoContent FilePath
path proxy (Verb method status cs (Headers hs nocontent))
proxy
  = Maybe (Referenced Schema)
-> FilePath
-> proxy (Verb method status cs (Headers hs nocontent))
-> OpenApi
forall k1 (cs :: [*]) (hs :: [*]) (proxy :: * -> *) (method :: k1)
       (status :: Nat) a.
(AllAccept cs, AllToResponseHeader hs, OpenApiMethod method,
 KnownNat status) =>
Maybe (Referenced Schema)
-> FilePath
-> proxy (Verb method status cs (Headers hs a))
-> OpenApi
mkEndpointWithSchemaRef Maybe (Referenced Schema)
forall a. Maybe a
Nothing FilePath
path proxy (Verb method status cs (Headers hs nocontent))
proxy

-- | Like @'mkEndpoint'@ but with explicit schema reference.
-- Unlike @'mkEndpoint'@ this function does not update @'definitions'@.
mkEndpointWithSchemaRef :: forall cs hs proxy method status a.
  (AllAccept cs, AllToResponseHeader hs, OpenApiMethod method, KnownNat status)
  => Maybe (Referenced Schema)
  -> FilePath
  -> proxy (Verb method status cs (Headers hs a))
  -> OpenApi
mkEndpointWithSchemaRef :: Maybe (Referenced Schema)
-> FilePath
-> proxy (Verb method status cs (Headers hs a))
-> OpenApi
mkEndpointWithSchemaRef Maybe (Referenced Schema)
mref FilePath
path proxy (Verb method status cs (Headers hs a))
_ = OpenApi
forall a. Monoid a => a
mempty
  OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap FilePath PathItem
 -> Identity (InsOrdHashMap FilePath PathItem))
-> OpenApi -> Identity OpenApi
forall s a. HasPaths s a => Lens' s a
paths((InsOrdHashMap FilePath PathItem
  -> Identity (InsOrdHashMap FilePath PathItem))
 -> OpenApi -> Identity OpenApi)
-> ((Maybe PathItem -> Identity (Maybe PathItem))
    -> InsOrdHashMap FilePath PathItem
    -> Identity (InsOrdHashMap FilePath PathItem))
-> (Maybe PathItem -> Identity (Maybe PathItem))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (InsOrdHashMap FilePath PathItem)
-> Lens'
     (InsOrdHashMap FilePath PathItem)
     (Maybe (IxValue (InsOrdHashMap FilePath PathItem)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at FilePath
Index (InsOrdHashMap FilePath PathItem)
path ((Maybe PathItem -> Identity (Maybe PathItem))
 -> OpenApi -> Identity OpenApi)
-> PathItem -> OpenApi -> OpenApi
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~
    (PathItem
forall a. Monoid a => a
mempty PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
method ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Operation
forall a. Monoid a => a
mempty
      Operation -> (Operation -> Operation) -> Operation
forall a b. a -> (a -> b) -> b
& Index Operation -> Lens' Operation (Maybe (IxValue Operation))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
Index Operation
code ((Maybe (Referenced Response)
  -> Identity (Maybe (Referenced Response)))
 -> Operation -> Identity Operation)
-> Referenced Response -> Operation -> Operation
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Response -> Referenced Response
forall a. a -> Referenced a
Inline (Response
forall a. Monoid a => a
mempty
            Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap MediaType MediaTypeObject
 -> Identity (InsOrdHashMap MediaType MediaTypeObject))
-> Response -> Identity Response
forall s a. HasContent s a => Lens' s a
content ((InsOrdHashMap MediaType MediaTypeObject
  -> Identity (InsOrdHashMap MediaType MediaTypeObject))
 -> Response -> Identity Response)
-> InsOrdHashMap MediaType MediaTypeObject -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(MediaType, MediaTypeObject)]
-> InsOrdHashMap MediaType MediaTypeObject
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList
              [(MediaType
t, MediaTypeObject
forall a. Monoid a => a
mempty MediaTypeObject
-> (MediaTypeObject -> MediaTypeObject) -> MediaTypeObject
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> MediaTypeObject -> Identity MediaTypeObject
forall s a. HasSchema s a => Lens' s a
schema ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> MediaTypeObject -> Identity MediaTypeObject)
-> Maybe (Referenced Schema) -> MediaTypeObject -> MediaTypeObject
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Referenced Schema)
mref) | MediaType
t <- [MediaType]
responseContentTypes]
            Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap HeaderName (Referenced Header)
 -> Identity (InsOrdHashMap HeaderName (Referenced Header)))
-> Response -> Identity Response
forall s a. HasHeaders s a => Lens' s a
headers ((InsOrdHashMap HeaderName (Referenced Header)
  -> Identity (InsOrdHashMap HeaderName (Referenced Header)))
 -> Response -> Identity Response)
-> InsOrdHashMap HeaderName (Referenced Header)
-> Response
-> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InsOrdHashMap HeaderName (Referenced Header)
responseHeaders)))
  where
    method :: (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
method               = Proxy method -> Lens' PathItem (Maybe Operation)
forall k (method :: k) (proxy :: k -> *).
OpenApiMethod method =>
proxy method -> Lens' PathItem (Maybe Operation)
openApiMethod (Proxy method
forall k (t :: k). Proxy t
Proxy :: Proxy method)
    code :: HttpStatusCode
code                 = Integer -> HttpStatusCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy status -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy status
forall k (t :: k). Proxy t
Proxy :: Proxy status))
    responseContentTypes :: [MediaType]
responseContentTypes = Proxy cs -> [MediaType]
forall k (cs :: k). AllAccept cs => Proxy cs -> [MediaType]
allContentType (Proxy cs
forall k (t :: k). Proxy t
Proxy :: Proxy cs)
    responseHeaders :: InsOrdHashMap HeaderName (Referenced Header)
responseHeaders      = Header -> Referenced Header
forall a. a -> Referenced a
Inline (Header -> Referenced Header)
-> InsOrdHashMap HeaderName Header
-> InsOrdHashMap HeaderName (Referenced Header)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy hs -> InsOrdHashMap HeaderName Header
forall k (hs :: k).
AllToResponseHeader hs =>
Proxy hs -> InsOrdHashMap HeaderName Header
toAllResponseHeaders (Proxy hs
forall k (t :: k). Proxy t
Proxy :: Proxy hs)

mkEndpointNoContentVerb :: forall proxy method.
  (OpenApiMethod method)
  => FilePath                      -- ^ Endpoint path.
  -> proxy (NoContentVerb method)  -- ^ Method
  -> OpenApi
mkEndpointNoContentVerb :: FilePath -> proxy (NoContentVerb method) -> OpenApi
mkEndpointNoContentVerb FilePath
path proxy (NoContentVerb method)
_ = OpenApi
forall a. Monoid a => a
mempty
  OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap FilePath PathItem
 -> Identity (InsOrdHashMap FilePath PathItem))
-> OpenApi -> Identity OpenApi
forall s a. HasPaths s a => Lens' s a
paths((InsOrdHashMap FilePath PathItem
  -> Identity (InsOrdHashMap FilePath PathItem))
 -> OpenApi -> Identity OpenApi)
-> ((Maybe PathItem -> Identity (Maybe PathItem))
    -> InsOrdHashMap FilePath PathItem
    -> Identity (InsOrdHashMap FilePath PathItem))
-> (Maybe PathItem -> Identity (Maybe PathItem))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (InsOrdHashMap FilePath PathItem)
-> Lens'
     (InsOrdHashMap FilePath PathItem)
     (Maybe (IxValue (InsOrdHashMap FilePath PathItem)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at FilePath
Index (InsOrdHashMap FilePath PathItem)
path ((Maybe PathItem -> Identity (Maybe PathItem))
 -> OpenApi -> Identity OpenApi)
-> PathItem -> OpenApi -> OpenApi
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~
    (PathItem
forall a. Monoid a => a
mempty PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
method ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Operation
forall a. Monoid a => a
mempty
      Operation -> (Operation -> Operation) -> Operation
forall a b. a -> (a -> b) -> b
& Index Operation -> Lens' Operation (Maybe (IxValue Operation))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
Index Operation
code ((Maybe (Referenced Response)
  -> Identity (Maybe (Referenced Response)))
 -> Operation -> Identity Operation)
-> Referenced Response -> Operation -> Operation
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Response -> Referenced Response
forall a. a -> Referenced a
Inline Response
forall a. Monoid a => a
mempty))
  where
    method :: (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
method               = Proxy method -> Lens' PathItem (Maybe Operation)
forall k (method :: k) (proxy :: k -> *).
OpenApiMethod method =>
proxy method -> Lens' PathItem (Maybe Operation)
openApiMethod (Proxy method
forall k (t :: k). Proxy t
Proxy :: Proxy method)
    code :: HttpStatusCode
code                 = HttpStatusCode
204 -- hardcoded in servant-server

-- | Add parameter to every operation in the spec.
addParam :: Param -> OpenApi -> OpenApi
addParam :: Param -> OpenApi -> OpenApi
addParam Param
param = (Operation -> Identity Operation) -> OpenApi -> Identity OpenApi
Traversal' OpenApi Operation
allOperations((Operation -> Identity Operation) -> OpenApi -> Identity OpenApi)
-> (([Referenced Param] -> Identity [Referenced Param])
    -> Operation -> Identity Operation)
-> ([Referenced Param] -> Identity [Referenced Param])
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Referenced Param] -> Identity [Referenced Param])
-> Operation -> Identity Operation
forall s a. HasParameters s a => Lens' s a
parameters (([Referenced Param] -> Identity [Referenced Param])
 -> OpenApi -> Identity OpenApi)
-> ([Referenced Param] -> [Referenced Param]) -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Param -> Referenced Param
forall a. a -> Referenced a
Inline Param
param Referenced Param -> [Referenced Param] -> [Referenced Param]
forall a. a -> [a] -> [a]
:)

-- | Add RequestBody to every operations in the spec.
addRequestBody :: RequestBody -> OpenApi -> OpenApi
addRequestBody :: RequestBody -> OpenApi -> OpenApi
addRequestBody RequestBody
rb = (Operation -> Identity Operation) -> OpenApi -> Identity OpenApi
Traversal' OpenApi Operation
allOperations ((Operation -> Identity Operation) -> OpenApi -> Identity OpenApi)
-> ((Maybe (Referenced RequestBody)
     -> Identity (Maybe (Referenced RequestBody)))
    -> Operation -> Identity Operation)
-> (Maybe (Referenced RequestBody)
    -> Identity (Maybe (Referenced RequestBody)))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Referenced RequestBody)
 -> Identity (Maybe (Referenced RequestBody)))
-> Operation -> Identity Operation
forall s a. HasRequestBody s a => Lens' s a
requestBody ((Maybe (Referenced RequestBody)
  -> Identity (Maybe (Referenced RequestBody)))
 -> OpenApi -> Identity OpenApi)
-> Referenced RequestBody -> OpenApi -> OpenApi
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ RequestBody -> Referenced RequestBody
forall a. a -> Referenced a
Inline RequestBody
rb

-- | Format given text as inline code in Markdown.
markdownCode :: Text -> Text
markdownCode :: HeaderName -> HeaderName
markdownCode HeaderName
s = HeaderName
"`" HeaderName -> HeaderName -> HeaderName
forall a. Semigroup a => a -> a -> a
<> HeaderName
s HeaderName -> HeaderName -> HeaderName
forall a. Semigroup a => a -> a -> a
<> HeaderName
"`"

addDefaultResponse404 :: ParamName -> OpenApi -> OpenApi
addDefaultResponse404 :: HeaderName -> OpenApi -> OpenApi
addDefaultResponse404 HeaderName
pname = (Response -> Response -> Response)
-> HttpStatusCode
-> Declare (Definitions Schema) Response
-> OpenApi
-> OpenApi
setResponseWith (\Response
old Response
_new -> Response -> Response
alter404 Response
old) HttpStatusCode
404 (Response -> Declare (Definitions Schema) Response
forall (m :: * -> *) a. Monad m => a -> m a
return Response
response404)
  where
    sname :: HeaderName
sname = HeaderName -> HeaderName
markdownCode HeaderName
pname
    description404 :: HeaderName
description404 = HeaderName
sname HeaderName -> HeaderName -> HeaderName
forall a. Semigroup a => a -> a -> a
<> HeaderName
" not found"
    alter404 :: Response -> Response
alter404 = (HeaderName -> Identity HeaderName)
-> Response -> Identity Response
forall s a. HasDescription s a => Lens' s a
description ((HeaderName -> Identity HeaderName)
 -> Response -> Identity Response)
-> (HeaderName -> HeaderName) -> Response -> Response
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((HeaderName
sname HeaderName -> HeaderName -> HeaderName
forall a. Semigroup a => a -> a -> a
<> HeaderName
" or ") HeaderName -> HeaderName -> HeaderName
forall a. Semigroup a => a -> a -> a
<>)
    response404 :: Response
response404 = Response
forall a. Monoid a => a
mempty Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& (HeaderName -> Identity HeaderName)
-> Response -> Identity Response
forall s a. HasDescription s a => Lens' s a
description ((HeaderName -> Identity HeaderName)
 -> Response -> Identity Response)
-> HeaderName -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HeaderName
description404

addDefaultResponse400 :: ParamName -> OpenApi -> OpenApi
addDefaultResponse400 :: HeaderName -> OpenApi -> OpenApi
addDefaultResponse400 HeaderName
pname = (Response -> Response -> Response)
-> HttpStatusCode
-> Declare (Definitions Schema) Response
-> OpenApi
-> OpenApi
setResponseWith (\Response
old Response
_new -> Response -> Response
alter400 Response
old) HttpStatusCode
400 (Response -> Declare (Definitions Schema) Response
forall (m :: * -> *) a. Monad m => a -> m a
return Response
response400)
  where
    sname :: HeaderName
sname = HeaderName -> HeaderName
markdownCode HeaderName
pname
    description400 :: HeaderName
description400 = HeaderName
"Invalid " HeaderName -> HeaderName -> HeaderName
forall a. Semigroup a => a -> a -> a
<> HeaderName
sname
    alter400 :: Response -> Response
alter400 = (HeaderName -> Identity HeaderName)
-> Response -> Identity Response
forall s a. HasDescription s a => Lens' s a
description ((HeaderName -> Identity HeaderName)
 -> Response -> Identity Response)
-> (HeaderName -> HeaderName) -> Response -> Response
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (HeaderName -> HeaderName -> HeaderName
forall a. Semigroup a => a -> a -> a
<> (HeaderName
" or " HeaderName -> HeaderName -> HeaderName
forall a. Semigroup a => a -> a -> a
<> HeaderName
sname))
    response400 :: Response
response400 = Response
forall a. Monoid a => a
mempty Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& (HeaderName -> Identity HeaderName)
-> Response -> Identity Response
forall s a. HasDescription s a => Lens' s a
description ((HeaderName -> Identity HeaderName)
 -> Response -> Identity Response)
-> HeaderName -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HeaderName
description400

-- | Methods, available for OpenApi.
class OpenApiMethod method where
  openApiMethod :: proxy method -> Lens' PathItem (Maybe Operation)

instance OpenApiMethod 'GET     where openApiMethod :: proxy 'GET -> Lens' PathItem (Maybe Operation)
openApiMethod proxy 'GET
_ = (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasGet s a => Lens' s a
get
instance OpenApiMethod 'PUT     where openApiMethod :: proxy 'PUT -> Lens' PathItem (Maybe Operation)
openApiMethod proxy 'PUT
_ = (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasPut s a => Lens' s a
put
instance OpenApiMethod 'POST    where openApiMethod :: proxy 'POST -> Lens' PathItem (Maybe Operation)
openApiMethod proxy 'POST
_ = (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasPost s a => Lens' s a
post
instance OpenApiMethod 'DELETE  where openApiMethod :: proxy 'DELETE -> Lens' PathItem (Maybe Operation)
openApiMethod proxy 'DELETE
_ = (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasDelete s a => Lens' s a
delete
instance OpenApiMethod 'OPTIONS where openApiMethod :: proxy 'OPTIONS -> Lens' PathItem (Maybe Operation)
openApiMethod proxy 'OPTIONS
_ = (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasOptions s a => Lens' s a
options
instance OpenApiMethod 'HEAD    where openApiMethod :: proxy 'HEAD -> Lens' PathItem (Maybe Operation)
openApiMethod proxy 'HEAD
_ = (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasHead s a => Lens' s a
head_
instance OpenApiMethod 'PATCH   where openApiMethod :: proxy 'PATCH -> Lens' PathItem (Maybe Operation)
openApiMethod proxy 'PATCH
_ = (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasPatch s a => Lens' s a
patch

#if MIN_VERSION_servant(0,18,1)
instance HasOpenApi (UVerb method cs '[]) where
  toOpenApi :: Proxy (UVerb method cs '[]) -> OpenApi
toOpenApi Proxy (UVerb method cs '[])
_ = OpenApi
forall a. Monoid a => a
mempty

-- | @since <2.0.1.0>
instance
  {-# OVERLAPPABLE #-}
  ( ToSchema a,
    HasStatus a,
    AllAccept cs,
    OpenApiMethod method,
    HasOpenApi (UVerb method cs as)
  ) =>
  HasOpenApi (UVerb method cs (a ': as))
  where
  toOpenApi :: Proxy (UVerb method cs (a : as)) -> OpenApi
toOpenApi Proxy (UVerb method cs (a : as))
_ =
    Proxy (Verb method (StatusOf a) cs a) -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy (Verb method (StatusOf a) cs a)
forall k (t :: k). Proxy t
Proxy :: Proxy (Verb method (StatusOf a) cs a))
      OpenApi -> OpenApi -> OpenApi
`combineSwagger` Proxy (UVerb method cs as) -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy (UVerb method cs as)
forall k (t :: k). Proxy t
Proxy :: Proxy (UVerb method cs as))
    where
      -- workaround for https://github.com/GetShopTV/swagger2/issues/218
      combinePathItem :: PathItem -> PathItem -> PathItem
      combinePathItem :: PathItem -> PathItem -> PathItem
combinePathItem PathItem
s PathItem
t = PathItem :: Maybe HeaderName
-> Maybe HeaderName
-> Maybe Operation
-> Maybe Operation
-> Maybe Operation
-> Maybe Operation
-> Maybe Operation
-> Maybe Operation
-> Maybe Operation
-> Maybe Operation
-> [Server]
-> [Referenced Param]
-> PathItem
PathItem
        { _pathItemGet :: Maybe Operation
_pathItemGet = PathItem -> Maybe Operation
_pathItemGet PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemGet PathItem
t
        , _pathItemPut :: Maybe Operation
_pathItemPut = PathItem -> Maybe Operation
_pathItemPut PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemPut PathItem
t
        , _pathItemPost :: Maybe Operation
_pathItemPost = PathItem -> Maybe Operation
_pathItemPost PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemPost PathItem
t
        , _pathItemDelete :: Maybe Operation
_pathItemDelete = PathItem -> Maybe Operation
_pathItemDelete PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemDelete PathItem
t
        , _pathItemOptions :: Maybe Operation
_pathItemOptions = PathItem -> Maybe Operation
_pathItemOptions PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemOptions PathItem
t
        , _pathItemHead :: Maybe Operation
_pathItemHead = PathItem -> Maybe Operation
_pathItemHead PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemHead PathItem
t
        , _pathItemPatch :: Maybe Operation
_pathItemPatch = PathItem -> Maybe Operation
_pathItemPatch PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemPatch PathItem
t
        , _pathItemTrace :: Maybe Operation
_pathItemTrace = PathItem -> Maybe Operation
_pathItemTrace PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemTrace PathItem
t
        , _pathItemParameters :: [Referenced Param]
_pathItemParameters = PathItem -> [Referenced Param]
_pathItemParameters PathItem
s [Referenced Param] -> [Referenced Param] -> [Referenced Param]
forall a. Semigroup a => a -> a -> a
<> PathItem -> [Referenced Param]
_pathItemParameters PathItem
t
        , _pathItemSummary :: Maybe HeaderName
_pathItemSummary = PathItem -> Maybe HeaderName
_pathItemSummary PathItem
s Maybe HeaderName -> Maybe HeaderName -> Maybe HeaderName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PathItem -> Maybe HeaderName
_pathItemSummary PathItem
t
        , _pathItemDescription :: Maybe HeaderName
_pathItemDescription = PathItem -> Maybe HeaderName
_pathItemDescription PathItem
s Maybe HeaderName -> Maybe HeaderName -> Maybe HeaderName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PathItem -> Maybe HeaderName
_pathItemDescription PathItem
t
        , _pathItemServers :: [Server]
_pathItemServers = PathItem -> [Server]
_pathItemServers PathItem
s [Server] -> [Server] -> [Server]
forall a. Semigroup a => a -> a -> a
<> PathItem -> [Server]
_pathItemServers PathItem
t
        }

      combineSwagger :: OpenApi -> OpenApi -> OpenApi
      combineSwagger :: OpenApi -> OpenApi -> OpenApi
combineSwagger OpenApi
s OpenApi
t = OpenApi :: Info
-> [Server]
-> InsOrdHashMap FilePath PathItem
-> Components
-> [SecurityRequirement]
-> InsOrdHashSet Tag
-> Maybe ExternalDocs
-> OpenApi
OpenApi
        { _openApiInfo :: Info
_openApiInfo = OpenApi -> Info
_openApiInfo OpenApi
s Info -> Info -> Info
forall a. Semigroup a => a -> a -> a
<> OpenApi -> Info
_openApiInfo OpenApi
t
        , _openApiServers :: [Server]
_openApiServers = OpenApi -> [Server]
_openApiServers OpenApi
s [Server] -> [Server] -> [Server]
forall a. Semigroup a => a -> a -> a
<> OpenApi -> [Server]
_openApiServers OpenApi
t
        , _openApiPaths :: InsOrdHashMap FilePath PathItem
_openApiPaths = (PathItem -> PathItem -> PathItem)
-> InsOrdHashMap FilePath PathItem
-> InsOrdHashMap FilePath PathItem
-> InsOrdHashMap FilePath PathItem
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v)
-> InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.unionWith PathItem -> PathItem -> PathItem
combinePathItem (OpenApi -> InsOrdHashMap FilePath PathItem
_openApiPaths OpenApi
s) (OpenApi -> InsOrdHashMap FilePath PathItem
_openApiPaths OpenApi
t)
        , _openApiComponents :: Components
_openApiComponents = OpenApi -> Components
_openApiComponents OpenApi
s Components -> Components -> Components
forall a. Semigroup a => a -> a -> a
<> OpenApi -> Components
_openApiComponents OpenApi
t
        , _openApiSecurity :: [SecurityRequirement]
_openApiSecurity = OpenApi -> [SecurityRequirement]
_openApiSecurity OpenApi
s [SecurityRequirement]
-> [SecurityRequirement] -> [SecurityRequirement]
forall a. Semigroup a => a -> a -> a
<> OpenApi -> [SecurityRequirement]
_openApiSecurity OpenApi
t
        , _openApiTags :: InsOrdHashSet Tag
_openApiTags = OpenApi -> InsOrdHashSet Tag
_openApiTags OpenApi
s InsOrdHashSet Tag -> InsOrdHashSet Tag -> InsOrdHashSet Tag
forall a. Semigroup a => a -> a -> a
<> OpenApi -> InsOrdHashSet Tag
_openApiTags OpenApi
t
        , _openApiExternalDocs :: Maybe ExternalDocs
_openApiExternalDocs = OpenApi -> Maybe ExternalDocs
_openApiExternalDocs OpenApi
s Maybe ExternalDocs -> Maybe ExternalDocs -> Maybe ExternalDocs
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OpenApi -> Maybe ExternalDocs
_openApiExternalDocs OpenApi
t
        }

instance (Typeable (WithStatus s a), ToSchema a) => ToSchema (WithStatus s a) where
  declareNamedSchema :: Proxy (WithStatus s a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (WithStatus s a)
_ = Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
#endif

instance {-# OVERLAPPABLE #-} (ToSchema a, AllAccept cs, KnownNat status, OpenApiMethod method) => HasOpenApi (Verb method status cs a) where
  toOpenApi :: Proxy (Verb method status cs a) -> OpenApi
toOpenApi Proxy (Verb method status cs a)
_ = Proxy (Verb method status cs (Headers '[] a)) -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy (Verb method status cs (Headers '[] a))
forall k (t :: k). Proxy t
Proxy :: Proxy (Verb method status cs (Headers '[] a)))

-- | @since 1.1.7
instance (ToSchema a, Accept ct, KnownNat status, OpenApiMethod method) => HasOpenApi (Stream method status fr ct a) where
  toOpenApi :: Proxy (Stream method status fr ct a) -> OpenApi
toOpenApi Proxy (Stream method status fr ct a)
_ = Proxy (Verb method status '[ct] (Headers '[] a)) -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy (Verb method status '[ct] (Headers '[] a))
forall k (t :: k). Proxy t
Proxy :: Proxy (Verb method status '[ct] (Headers '[] a)))

instance {-# OVERLAPPABLE #-} (ToSchema a, AllAccept cs, AllToResponseHeader hs, KnownNat status, OpenApiMethod method)
  => HasOpenApi (Verb method status cs (Headers hs a)) where
  toOpenApi :: Proxy (Verb method status cs (Headers hs a)) -> OpenApi
toOpenApi = FilePath -> Proxy (Verb method status cs (Headers hs a)) -> OpenApi
forall k1 a (cs :: [*]) (hs :: [*]) (proxy :: * -> *)
       (method :: k1) (status :: Nat).
(ToSchema a, AllAccept cs, AllToResponseHeader hs,
 OpenApiMethod method, KnownNat status) =>
FilePath -> proxy (Verb method status cs (Headers hs a)) -> OpenApi
mkEndpoint FilePath
"/"

-- ATTENTION: do not remove this instance!
-- A similar instance above will always use the more general
-- polymorphic -- HasOpenApi instance and will result in a type error
-- since 'NoContent' does not have a 'ToSchema' instance.
instance (AllAccept cs, KnownNat status, OpenApiMethod method) => HasOpenApi (Verb method status cs NoContent) where
  toOpenApi :: Proxy (Verb method status cs NoContent) -> OpenApi
toOpenApi Proxy (Verb method status cs NoContent)
_ = Proxy (Verb method status cs (Headers '[] NoContent)) -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy (Verb method status cs (Headers '[] NoContent))
forall k (t :: k). Proxy t
Proxy :: Proxy (Verb method status cs (Headers '[] NoContent)))

instance (AllAccept cs, AllToResponseHeader hs, KnownNat status, OpenApiMethod method)
  => HasOpenApi (Verb method status cs (Headers hs NoContent)) where
  toOpenApi :: Proxy (Verb method status cs (Headers hs NoContent)) -> OpenApi
toOpenApi = FilePath
-> Proxy (Verb method status cs (Headers hs NoContent)) -> OpenApi
forall k1 nocontent (cs :: [*]) (hs :: [*]) (proxy :: * -> *)
       (method :: k1) (status :: Nat).
(AllAccept cs, AllToResponseHeader hs, OpenApiMethod method,
 KnownNat status) =>
FilePath
-> proxy (Verb method status cs (Headers hs nocontent)) -> OpenApi
mkEndpointNoContent FilePath
"/"

instance (OpenApiMethod method) => HasOpenApi (NoContentVerb method) where
  toOpenApi :: Proxy (NoContentVerb method) -> OpenApi
toOpenApi =  FilePath -> Proxy (NoContentVerb method) -> OpenApi
forall k1 (proxy :: * -> *) (method :: k1).
OpenApiMethod method =>
FilePath -> proxy (NoContentVerb method) -> OpenApi
mkEndpointNoContentVerb FilePath
"/"

instance (HasOpenApi a, HasOpenApi b) => HasOpenApi (a :<|> b) where
  toOpenApi :: Proxy (a :<|> b) -> OpenApi
toOpenApi Proxy (a :<|> b)
_ = Proxy a -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) OpenApi -> OpenApi -> OpenApi
forall a. Semigroup a => a -> a -> a
<> Proxy b -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)

-- | @'Vault'@ combinator does not change our specification at all.
instance (HasOpenApi sub) => HasOpenApi (Vault :> sub) where
  toOpenApi :: Proxy (Vault :> sub) -> OpenApi
toOpenApi Proxy (Vault :> sub)
_ = Proxy sub -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)

-- | @'IsSecure'@ combinator does not change our specification at all.
instance (HasOpenApi sub) => HasOpenApi (IsSecure :> sub) where
  toOpenApi :: Proxy (IsSecure :> sub) -> OpenApi
toOpenApi Proxy (IsSecure :> sub)
_ = Proxy sub -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)

-- | @'RemoteHost'@ combinator does not change our specification at all.
instance (HasOpenApi sub) => HasOpenApi (RemoteHost :> sub) where
  toOpenApi :: Proxy (RemoteHost :> sub) -> OpenApi
toOpenApi Proxy (RemoteHost :> sub)
_ = Proxy sub -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)

-- | @'HttpVersion'@ combinator does not change our specification at all.
instance (HasOpenApi sub) => HasOpenApi (HttpVersion :> sub) where
  toOpenApi :: Proxy (HttpVersion :> sub) -> OpenApi
toOpenApi Proxy (HttpVersion :> sub)
_ = Proxy sub -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)

-- | @'WithNamedContext'@ combinator does not change our specification at all.
instance (HasOpenApi sub) => HasOpenApi (WithNamedContext x c sub) where
  toOpenApi :: Proxy (WithNamedContext x c sub) -> OpenApi
toOpenApi Proxy (WithNamedContext x c sub)
_ = Proxy sub -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)

instance (KnownSymbol sym, HasOpenApi sub) => HasOpenApi (sym :> sub) where
  toOpenApi :: Proxy (sym :> sub) -> OpenApi
toOpenApi Proxy (sym :> sub)
_ = FilePath -> OpenApi -> OpenApi
prependPath FilePath
piece (Proxy sub -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub))
    where
      piece :: FilePath
piece = Proxy sym -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)

instance (KnownSymbol sym, ToParamSchema a, HasOpenApi sub, KnownSymbol (FoldDescription mods)) => HasOpenApi (Capture' mods sym a :> sub) where
  toOpenApi :: Proxy (Capture' mods sym a :> sub) -> OpenApi
toOpenApi Proxy (Capture' mods sym a :> sub)
_ = Proxy sub -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& Param -> OpenApi -> OpenApi
addParam Param
param
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& FilePath -> OpenApi -> OpenApi
prependPath FilePath
capture
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& HeaderName -> OpenApi -> OpenApi
addDefaultResponse404 HeaderName
tname
    where
      pname :: FilePath
pname = Proxy sym -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)
      tname :: HeaderName
tname = FilePath -> HeaderName
Text.pack FilePath
pname
      transDesc :: FilePath -> Maybe HeaderName
transDesc FilePath
""   = Maybe HeaderName
forall a. Maybe a
Nothing
      transDesc FilePath
desc = HeaderName -> Maybe HeaderName
forall a. a -> Maybe a
Just (FilePath -> HeaderName
Text.pack FilePath
desc)
      capture :: FilePath
capture = FilePath
"{" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
pname FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"}"
      param :: Param
param = Param
forall a. Monoid a => a
mempty
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (HeaderName -> Identity HeaderName) -> Param -> Identity Param
forall s a. HasName s a => Lens' s a
name ((HeaderName -> Identity HeaderName) -> Param -> Identity Param)
-> HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HeaderName
tname
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe HeaderName -> Identity (Maybe HeaderName))
-> Param -> Identity Param
forall s a. HasDescription s a => Lens' s a
description ((Maybe HeaderName -> Identity (Maybe HeaderName))
 -> Param -> Identity Param)
-> Maybe HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe HeaderName
transDesc (Proxy mods -> FilePath
forall (mods :: [*]).
KnownSymbol (FoldDescription mods) =>
Proxy mods -> FilePath
reflectDescription (Proxy mods
forall k (t :: k). Proxy t
Proxy :: Proxy mods))
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param
forall s a. HasRequired s a => Lens' s a
required ((Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param)
-> Bool -> Param -> Param
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (ParamLocation -> Identity ParamLocation)
-> Param -> Identity Param
forall s a. HasIn s a => Lens' s a
in_ ((ParamLocation -> Identity ParamLocation)
 -> Param -> Identity Param)
-> ParamLocation -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamLocation
ParamPath
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> Param -> Identity Param
forall s a. HasSchema s a => Lens' s a
schema ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> Param -> Identity Param)
-> Referenced Schema -> Param -> Param
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Proxy a -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))

-- | OpenApi Spec doesn't have a notion of CaptureAll, this instance is the best effort.
instance (KnownSymbol sym, ToParamSchema a, HasOpenApi sub) => HasOpenApi (CaptureAll sym a :> sub) where
  toOpenApi :: Proxy (CaptureAll sym a :> sub) -> OpenApi
toOpenApi Proxy (CaptureAll sym a :> sub)
_ = Proxy (Capture sym a :> sub) -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy (Capture sym a :> sub)
forall k (t :: k). Proxy t
Proxy :: Proxy (Capture sym a :> sub))

instance (KnownSymbol desc, HasOpenApi api) => HasOpenApi (Description desc :> api) where
  toOpenApi :: Proxy (Description desc :> api) -> OpenApi
toOpenApi Proxy (Description desc :> api)
_ = Proxy api -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api)
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> OpenApi -> Identity OpenApi
Traversal' OpenApi Operation
allOperations((Operation -> Identity Operation) -> OpenApi -> Identity OpenApi)
-> ((Maybe HeaderName -> Identity (Maybe HeaderName))
    -> Operation -> Identity Operation)
-> (Maybe HeaderName -> Identity (Maybe HeaderName))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe HeaderName -> Identity (Maybe HeaderName))
-> Operation -> Identity Operation
forall s a. HasDescription s a => Lens' s a
description ((Maybe HeaderName -> Identity (Maybe HeaderName))
 -> OpenApi -> Identity OpenApi)
-> (Maybe HeaderName -> Maybe HeaderName) -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (HeaderName -> Maybe HeaderName
forall a. a -> Maybe a
Just (FilePath -> HeaderName
Text.pack (Proxy desc -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy desc
forall k (t :: k). Proxy t
Proxy :: Proxy desc))) Maybe HeaderName -> Maybe HeaderName -> Maybe HeaderName
forall a. Semigroup a => a -> a -> a
<>)

instance (KnownSymbol desc, HasOpenApi api) => HasOpenApi (Summary desc :> api) where
  toOpenApi :: Proxy (Summary desc :> api) -> OpenApi
toOpenApi Proxy (Summary desc :> api)
_ = Proxy api -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api)
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> OpenApi -> Identity OpenApi
Traversal' OpenApi Operation
allOperations((Operation -> Identity Operation) -> OpenApi -> Identity OpenApi)
-> ((Maybe HeaderName -> Identity (Maybe HeaderName))
    -> Operation -> Identity Operation)
-> (Maybe HeaderName -> Identity (Maybe HeaderName))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe HeaderName -> Identity (Maybe HeaderName))
-> Operation -> Identity Operation
forall s a. HasSummary s a => Lens' s a
summary ((Maybe HeaderName -> Identity (Maybe HeaderName))
 -> OpenApi -> Identity OpenApi)
-> (Maybe HeaderName -> Maybe HeaderName) -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (HeaderName -> Maybe HeaderName
forall a. a -> Maybe a
Just (FilePath -> HeaderName
Text.pack (Proxy desc -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy desc
forall k (t :: k). Proxy t
Proxy :: Proxy desc))) Maybe HeaderName -> Maybe HeaderName -> Maybe HeaderName
forall a. Semigroup a => a -> a -> a
<>)

instance (KnownSymbol sym, ToParamSchema a, HasOpenApi sub, SBoolI (FoldRequired mods), KnownSymbol (FoldDescription mods)) => HasOpenApi (QueryParam' mods sym a :> sub) where
  toOpenApi :: Proxy (QueryParam' mods sym a :> sub) -> OpenApi
toOpenApi Proxy (QueryParam' mods sym a :> sub)
_ = Proxy sub -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& Param -> OpenApi -> OpenApi
addParam Param
param
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& HeaderName -> OpenApi -> OpenApi
addDefaultResponse400 HeaderName
tname
    where
      tname :: HeaderName
tname = FilePath -> HeaderName
Text.pack (Proxy sym -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym))
      transDesc :: FilePath -> Maybe HeaderName
transDesc FilePath
""   = Maybe HeaderName
forall a. Maybe a
Nothing
      transDesc FilePath
desc = HeaderName -> Maybe HeaderName
forall a. a -> Maybe a
Just (FilePath -> HeaderName
Text.pack FilePath
desc)
      param :: Param
param = Param
forall a. Monoid a => a
mempty
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (HeaderName -> Identity HeaderName) -> Param -> Identity Param
forall s a. HasName s a => Lens' s a
name ((HeaderName -> Identity HeaderName) -> Param -> Identity Param)
-> HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HeaderName
tname
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe HeaderName -> Identity (Maybe HeaderName))
-> Param -> Identity Param
forall s a. HasDescription s a => Lens' s a
description ((Maybe HeaderName -> Identity (Maybe HeaderName))
 -> Param -> Identity Param)
-> Maybe HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe HeaderName
transDesc (Proxy mods -> FilePath
forall (mods :: [*]).
KnownSymbol (FoldDescription mods) =>
Proxy mods -> FilePath
reflectDescription (Proxy mods
forall k (t :: k). Proxy t
Proxy :: Proxy mods))
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param
forall s a. HasRequired s a => Lens' s a
required ((Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param)
-> Bool -> Param -> Param
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Proxy (FoldRequired mods) -> Bool
forall (b :: Bool) (proxy :: Bool -> *).
SBoolI b =>
proxy b -> Bool
reflectBool (Proxy (FoldRequired mods)
forall k (t :: k). Proxy t
Proxy :: Proxy (FoldRequired mods))
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (ParamLocation -> Identity ParamLocation)
-> Param -> Identity Param
forall s a. HasIn s a => Lens' s a
in_ ((ParamLocation -> Identity ParamLocation)
 -> Param -> Identity Param)
-> ParamLocation -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamLocation
ParamQuery
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> Param -> Identity Param
forall s a. HasSchema s a => Lens' s a
schema ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> Param -> Identity Param)
-> Referenced Schema -> Param -> Param
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
sch
      sch :: Schema
sch = Proxy a -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

instance (KnownSymbol sym, ToParamSchema a, HasOpenApi sub) => HasOpenApi (QueryParams sym a :> sub) where
  toOpenApi :: Proxy (QueryParams sym a :> sub) -> OpenApi
toOpenApi Proxy (QueryParams sym a :> sub)
_ = Proxy sub -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& Param -> OpenApi -> OpenApi
addParam Param
param
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& HeaderName -> OpenApi -> OpenApi
addDefaultResponse400 HeaderName
tname
    where
      tname :: HeaderName
tname = FilePath -> HeaderName
Text.pack (Proxy sym -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym))
      param :: Param
param = Param
forall a. Monoid a => a
mempty
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (HeaderName -> Identity HeaderName) -> Param -> Identity Param
forall s a. HasName s a => Lens' s a
name ((HeaderName -> Identity HeaderName) -> Param -> Identity Param)
-> HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HeaderName
tname
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (ParamLocation -> Identity ParamLocation)
-> Param -> Identity Param
forall s a. HasIn s a => Lens' s a
in_ ((ParamLocation -> Identity ParamLocation)
 -> Param -> Identity Param)
-> ParamLocation -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamLocation
ParamQuery
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> Param -> Identity Param
forall s a. HasSchema s a => Lens' s a
schema ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> Param -> Identity Param)
-> Referenced Schema -> Param -> Param
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
pschema
      pschema :: Schema
pschema = Schema
forall a. Monoid a => a
mempty
        Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiArray
        Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiItems -> Identity (Maybe OpenApiItems))
-> Schema -> Identity Schema
forall s a. HasItems s a => Lens' s a
items ((Maybe OpenApiItems -> Identity (Maybe OpenApiItems))
 -> Schema -> Identity Schema)
-> OpenApiItems -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema -> OpenApiItems
OpenApiItemsObject (Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema) -> Schema -> Referenced Schema
forall a b. (a -> b) -> a -> b
$ Proxy a -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))

instance (KnownSymbol sym, HasOpenApi sub) => HasOpenApi (QueryFlag sym :> sub) where
  toOpenApi :: Proxy (QueryFlag sym :> sub) -> OpenApi
toOpenApi Proxy (QueryFlag sym :> sub)
_ = Proxy sub -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& Param -> OpenApi -> OpenApi
addParam Param
param
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& HeaderName -> OpenApi -> OpenApi
addDefaultResponse400 HeaderName
tname
    where
      tname :: HeaderName
tname = FilePath -> HeaderName
Text.pack (Proxy sym -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym))
      param :: Param
param = Param
forall a. Monoid a => a
mempty
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (HeaderName -> Identity HeaderName) -> Param -> Identity Param
forall s a. HasName s a => Lens' s a
name ((HeaderName -> Identity HeaderName) -> Param -> Identity Param)
-> HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HeaderName
tname
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (ParamLocation -> Identity ParamLocation)
-> Param -> Identity Param
forall s a. HasIn s a => Lens' s a
in_ ((ParamLocation -> Identity ParamLocation)
 -> Param -> Identity Param)
-> ParamLocation -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamLocation
ParamQuery
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param
forall s a. HasAllowEmptyValue s a => Lens' s a
allowEmptyValue ((Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param)
-> Bool -> Param -> Param
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> Param -> Identity Param
forall s a. HasSchema s a => Lens' s a
schema ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> Param -> Identity Param)
-> Referenced Schema -> Param -> Param
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema) -> Schema -> Referenced Schema
forall a b. (a -> b) -> a -> b
$ (Proxy Bool -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (Proxy Bool
forall k (t :: k). Proxy t
Proxy :: Proxy Bool))
                Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasDefault s a => Lens' s a
default_ ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
False)

instance (KnownSymbol sym, ToParamSchema a, HasOpenApi sub, SBoolI (FoldRequired mods), KnownSymbol (FoldDescription mods)) => HasOpenApi (Header' mods  sym a :> sub) where
  toOpenApi :: Proxy (Header' mods sym a :> sub) -> OpenApi
toOpenApi Proxy (Header' mods sym a :> sub)
_ = Proxy sub -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& Param -> OpenApi -> OpenApi
addParam Param
param
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& HeaderName -> OpenApi -> OpenApi
addDefaultResponse400 HeaderName
tname
    where
      tname :: HeaderName
tname = FilePath -> HeaderName
Text.pack (Proxy sym -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym))
      transDesc :: FilePath -> Maybe HeaderName
transDesc FilePath
""   = Maybe HeaderName
forall a. Maybe a
Nothing
      transDesc FilePath
desc = HeaderName -> Maybe HeaderName
forall a. a -> Maybe a
Just (FilePath -> HeaderName
Text.pack FilePath
desc)
      param :: Param
param = Param
forall a. Monoid a => a
mempty
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (HeaderName -> Identity HeaderName) -> Param -> Identity Param
forall s a. HasName s a => Lens' s a
name ((HeaderName -> Identity HeaderName) -> Param -> Identity Param)
-> HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HeaderName
tname
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe HeaderName -> Identity (Maybe HeaderName))
-> Param -> Identity Param
forall s a. HasDescription s a => Lens' s a
description ((Maybe HeaderName -> Identity (Maybe HeaderName))
 -> Param -> Identity Param)
-> Maybe HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe HeaderName
transDesc (Proxy mods -> FilePath
forall (mods :: [*]).
KnownSymbol (FoldDescription mods) =>
Proxy mods -> FilePath
reflectDescription (Proxy mods
forall k (t :: k). Proxy t
Proxy :: Proxy mods))
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param
forall s a. HasRequired s a => Lens' s a
required ((Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param)
-> Bool -> Param -> Param
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Proxy (FoldRequired mods) -> Bool
forall (b :: Bool) (proxy :: Bool -> *).
SBoolI b =>
proxy b -> Bool
reflectBool (Proxy (FoldRequired mods)
forall k (t :: k). Proxy t
Proxy :: Proxy (FoldRequired mods))
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (ParamLocation -> Identity ParamLocation)
-> Param -> Identity Param
forall s a. HasIn s a => Lens' s a
in_ ((ParamLocation -> Identity ParamLocation)
 -> Param -> Identity Param)
-> ParamLocation -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamLocation
ParamHeader
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> Param -> Identity Param
forall s a. HasSchema s a => Lens' s a
schema ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> Param -> Identity Param)
-> Referenced Schema -> Param -> Param
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema) -> Schema -> Referenced Schema
forall a b. (a -> b) -> a -> b
$ Proxy a -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))

instance (ToSchema a, AllAccept cs, HasOpenApi sub, KnownSymbol (FoldDescription mods)) => HasOpenApi (ReqBody' mods cs a :> sub) where
  toOpenApi :: Proxy (ReqBody' mods cs a :> sub) -> OpenApi
toOpenApi Proxy (ReqBody' mods cs a :> sub)
_ = Proxy sub -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& RequestBody -> OpenApi -> OpenApi
addRequestBody RequestBody
reqBody
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& HeaderName -> OpenApi -> OpenApi
addDefaultResponse400 HeaderName
tname
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (Components -> Identity Components) -> OpenApi -> Identity OpenApi
forall s a. HasComponents s a => Lens' s a
components((Components -> Identity Components)
 -> OpenApi -> Identity OpenApi)
-> ((Definitions Schema -> Identity (Definitions Schema))
    -> Components -> Identity Components)
-> (Definitions Schema -> Identity (Definitions Schema))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Definitions Schema -> Identity (Definitions Schema))
-> Components -> Identity Components
forall s a. HasSchemas s a => Lens' s a
schemas ((Definitions Schema -> Identity (Definitions Schema))
 -> OpenApi -> Identity OpenApi)
-> (Definitions Schema -> Definitions Schema) -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Definitions Schema -> Definitions Schema -> Definitions Schema
forall a. Semigroup a => a -> a -> a
<> Definitions Schema
defs)
    where
      tname :: HeaderName
tname = HeaderName
"body"
      transDesc :: FilePath -> Maybe HeaderName
transDesc FilePath
""   = Maybe HeaderName
forall a. Maybe a
Nothing
      transDesc FilePath
desc = HeaderName -> Maybe HeaderName
forall a. a -> Maybe a
Just (FilePath -> HeaderName
Text.pack FilePath
desc)
      (Definitions Schema
defs, Referenced Schema
ref) = Declare (Definitions Schema) (Referenced Schema)
-> Definitions Schema -> (Definitions Schema, Referenced Schema)
forall d a. Declare d a -> d -> (d, a)
runDeclare (Proxy a -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) Definitions Schema
forall a. Monoid a => a
mempty
      reqBody :: RequestBody
reqBody = (RequestBody
forall a. Monoid a => a
mempty :: RequestBody)
        RequestBody -> (RequestBody -> RequestBody) -> RequestBody
forall a b. a -> (a -> b) -> b
& (Maybe HeaderName -> Identity (Maybe HeaderName))
-> RequestBody -> Identity RequestBody
forall s a. HasDescription s a => Lens' s a
description ((Maybe HeaderName -> Identity (Maybe HeaderName))
 -> RequestBody -> Identity RequestBody)
-> Maybe HeaderName -> RequestBody -> RequestBody
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe HeaderName
transDesc (Proxy mods -> FilePath
forall (mods :: [*]).
KnownSymbol (FoldDescription mods) =>
Proxy mods -> FilePath
reflectDescription (Proxy mods
forall k (t :: k). Proxy t
Proxy :: Proxy mods))
        RequestBody -> (RequestBody -> RequestBody) -> RequestBody
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap MediaType MediaTypeObject
 -> Identity (InsOrdHashMap MediaType MediaTypeObject))
-> RequestBody -> Identity RequestBody
forall s a. HasContent s a => Lens' s a
content ((InsOrdHashMap MediaType MediaTypeObject
  -> Identity (InsOrdHashMap MediaType MediaTypeObject))
 -> RequestBody -> Identity RequestBody)
-> InsOrdHashMap MediaType MediaTypeObject
-> RequestBody
-> RequestBody
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(MediaType, MediaTypeObject)]
-> InsOrdHashMap MediaType MediaTypeObject
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList [(MediaType
t, MediaTypeObject
forall a. Monoid a => a
mempty MediaTypeObject
-> (MediaTypeObject -> MediaTypeObject) -> MediaTypeObject
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> MediaTypeObject -> Identity MediaTypeObject
forall s a. HasSchema s a => Lens' s a
schema ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> MediaTypeObject -> Identity MediaTypeObject)
-> Referenced Schema -> MediaTypeObject -> MediaTypeObject
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema
ref) | MediaType
t <- Proxy cs -> [MediaType]
forall k (cs :: k). AllAccept cs => Proxy cs -> [MediaType]
allContentType (Proxy cs
forall k (t :: k). Proxy t
Proxy :: Proxy cs)]

-- | This instance is an approximation.
--
-- @since 1.1.7
instance (ToSchema a, Accept ct, HasOpenApi sub, KnownSymbol (FoldDescription mods)) => HasOpenApi (StreamBody' mods fr ct a :> sub) where
  toOpenApi :: Proxy (StreamBody' mods fr ct a :> sub) -> OpenApi
toOpenApi Proxy (StreamBody' mods fr ct a :> sub)
_ = Proxy sub -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& RequestBody -> OpenApi -> OpenApi
addRequestBody RequestBody
reqBody
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& HeaderName -> OpenApi -> OpenApi
addDefaultResponse400 HeaderName
tname
    OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (Components -> Identity Components) -> OpenApi -> Identity OpenApi
forall s a. HasComponents s a => Lens' s a
components((Components -> Identity Components)
 -> OpenApi -> Identity OpenApi)
-> ((Definitions Schema -> Identity (Definitions Schema))
    -> Components -> Identity Components)
-> (Definitions Schema -> Identity (Definitions Schema))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Definitions Schema -> Identity (Definitions Schema))
-> Components -> Identity Components
forall s a. HasSchemas s a => Lens' s a
schemas ((Definitions Schema -> Identity (Definitions Schema))
 -> OpenApi -> Identity OpenApi)
-> (Definitions Schema -> Definitions Schema) -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Definitions Schema -> Definitions Schema -> Definitions Schema
forall a. Semigroup a => a -> a -> a
<> Definitions Schema
defs)
    where
      tname :: HeaderName
tname = HeaderName
"body"
      transDesc :: FilePath -> Maybe HeaderName
transDesc FilePath
""   = Maybe HeaderName
forall a. Maybe a
Nothing
      transDesc FilePath
desc = HeaderName -> Maybe HeaderName
forall a. a -> Maybe a
Just (FilePath -> HeaderName
Text.pack FilePath
desc)
      (Definitions Schema
defs, Referenced Schema
ref) = Declare (Definitions Schema) (Referenced Schema)
-> Definitions Schema -> (Definitions Schema, Referenced Schema)
forall d a. Declare d a -> d -> (d, a)
runDeclare (Proxy a -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) Definitions Schema
forall a. Monoid a => a
mempty
      reqBody :: RequestBody
reqBody = (RequestBody
forall a. Monoid a => a
mempty :: RequestBody)
        RequestBody -> (RequestBody -> RequestBody) -> RequestBody
forall a b. a -> (a -> b) -> b
& (Maybe HeaderName -> Identity (Maybe HeaderName))
-> RequestBody -> Identity RequestBody
forall s a. HasDescription s a => Lens' s a
description ((Maybe HeaderName -> Identity (Maybe HeaderName))
 -> RequestBody -> Identity RequestBody)
-> Maybe HeaderName -> RequestBody -> RequestBody
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe HeaderName
transDesc (Proxy mods -> FilePath
forall (mods :: [*]).
KnownSymbol (FoldDescription mods) =>
Proxy mods -> FilePath
reflectDescription (Proxy mods
forall k (t :: k). Proxy t
Proxy :: Proxy mods))
        RequestBody -> (RequestBody -> RequestBody) -> RequestBody
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap MediaType MediaTypeObject
 -> Identity (InsOrdHashMap MediaType MediaTypeObject))
-> RequestBody -> Identity RequestBody
forall s a. HasContent s a => Lens' s a
content ((InsOrdHashMap MediaType MediaTypeObject
  -> Identity (InsOrdHashMap MediaType MediaTypeObject))
 -> RequestBody -> Identity RequestBody)
-> InsOrdHashMap MediaType MediaTypeObject
-> RequestBody
-> RequestBody
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(MediaType, MediaTypeObject)]
-> InsOrdHashMap MediaType MediaTypeObject
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList [(MediaType
t, MediaTypeObject
forall a. Monoid a => a
mempty MediaTypeObject
-> (MediaTypeObject -> MediaTypeObject) -> MediaTypeObject
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> MediaTypeObject -> Identity MediaTypeObject
forall s a. HasSchema s a => Lens' s a
schema ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> MediaTypeObject -> Identity MediaTypeObject)
-> Referenced Schema -> MediaTypeObject -> MediaTypeObject
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema
ref) | MediaType
t <- NonEmpty MediaType -> [MediaType]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty MediaType -> [MediaType])
-> NonEmpty MediaType -> [MediaType]
forall a b. (a -> b) -> a -> b
$ Proxy ct -> NonEmpty MediaType
forall k (ctype :: k).
Accept ctype =>
Proxy ctype -> NonEmpty MediaType
contentTypes (Proxy ct
forall k (t :: k). Proxy t
Proxy :: Proxy ct)]

#if MIN_VERSION_servant(0,18,2)
instance (HasOpenApi sub) => HasOpenApi (Fragment a :> sub) where
  toOpenApi :: Proxy (Fragment a :> sub) -> OpenApi
toOpenApi Proxy (Fragment a :> sub)
_ = Proxy sub -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)
#endif

-- =======================================================================
-- Below are the definitions that should be in Servant.API.ContentTypes
-- =======================================================================

class AllAccept cs where
  allContentType :: Proxy cs -> [MediaType]

instance AllAccept '[] where
  allContentType :: Proxy '[] -> [MediaType]
allContentType Proxy '[]
_ = []

instance (Accept c, AllAccept cs) => AllAccept (c ': cs) where
  allContentType :: Proxy (c : cs) -> [MediaType]
allContentType Proxy (c : cs)
_ = Proxy c -> MediaType
forall k (ctype :: k). Accept ctype => Proxy ctype -> MediaType
contentType (Proxy c
forall k (t :: k). Proxy t
Proxy :: Proxy c) MediaType -> [MediaType] -> [MediaType]
forall a. a -> [a] -> [a]
: Proxy cs -> [MediaType]
forall k (cs :: k). AllAccept cs => Proxy cs -> [MediaType]
allContentType (Proxy cs
forall k (t :: k). Proxy t
Proxy :: Proxy cs)

class ToResponseHeader h where
  toResponseHeader :: Proxy h -> (HeaderName, OpenApi.Header)

instance (KnownSymbol sym, ToParamSchema a) => ToResponseHeader (Header sym a) where
  toResponseHeader :: Proxy (Header sym a) -> (HeaderName, Header)
toResponseHeader Proxy (Header sym a)
_ = (HeaderName
hname, Header
forall a. Monoid a => a
mempty Header -> (Header -> Header) -> Header
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> Header -> Identity Header
forall s a. HasSchema s a => Lens' s a
schema ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> Header -> Identity Header)
-> Referenced Schema -> Header -> Header
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema
hschema)
    where
      hname :: HeaderName
hname = FilePath -> HeaderName
Text.pack (Proxy sym -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym))
      hschema :: Referenced Schema
hschema = Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema) -> Schema -> Referenced Schema
forall a b. (a -> b) -> a -> b
$ Proxy a -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

class AllToResponseHeader hs where
  toAllResponseHeaders :: Proxy hs -> InsOrdHashMap HeaderName OpenApi.Header

instance AllToResponseHeader '[] where
  toAllResponseHeaders :: Proxy '[] -> InsOrdHashMap HeaderName Header
toAllResponseHeaders Proxy '[]
_ = InsOrdHashMap HeaderName Header
forall a. Monoid a => a
mempty

instance (ToResponseHeader h, AllToResponseHeader hs) => AllToResponseHeader (h ': hs) where
  toAllResponseHeaders :: Proxy (h : hs) -> InsOrdHashMap HeaderName Header
toAllResponseHeaders Proxy (h : hs)
_ = HeaderName
-> Header
-> InsOrdHashMap HeaderName Header
-> InsOrdHashMap HeaderName Header
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert HeaderName
headerName Header
headerBS InsOrdHashMap HeaderName Header
hdrs
    where
      (HeaderName
headerName, Header
headerBS) = Proxy h -> (HeaderName, Header)
forall k (h :: k).
ToResponseHeader h =>
Proxy h -> (HeaderName, Header)
toResponseHeader (Proxy h
forall k (t :: k). Proxy t
Proxy :: Proxy h)
      hdrs :: InsOrdHashMap HeaderName Header
hdrs = Proxy hs -> InsOrdHashMap HeaderName Header
forall k (hs :: k).
AllToResponseHeader hs =>
Proxy hs -> InsOrdHashMap HeaderName Header
toAllResponseHeaders (Proxy hs
forall k (t :: k). Proxy t
Proxy :: Proxy hs)

instance AllToResponseHeader hs => AllToResponseHeader (HList hs) where
  toAllResponseHeaders :: Proxy (HList hs) -> InsOrdHashMap HeaderName Header
toAllResponseHeaders Proxy (HList hs)
_ = Proxy hs -> InsOrdHashMap HeaderName Header
forall k (hs :: k).
AllToResponseHeader hs =>
Proxy hs -> InsOrdHashMap HeaderName Header
toAllResponseHeaders (Proxy hs
forall k (t :: k). Proxy t
Proxy :: Proxy hs)