{-# 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)
#if MIN_VERSION_servant(0,19,0)
import           Servant.API.Generic        (ToServantApi)
#endif

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
Lens' OpenApi (InsOrdHashMap FilePath PathItem)
paths ((InsOrdHashMap FilePath PathItem
  -> Identity (InsOrdHashMap FilePath PathItem))
 -> OpenApi -> Identity OpenApi)
-> ((Maybe (IxValue (InsOrdHashMap FilePath PathItem))
     -> Identity (Maybe (IxValue (InsOrdHashMap FilePath PathItem))))
    -> InsOrdHashMap FilePath PathItem
    -> Identity (InsOrdHashMap FilePath PathItem))
-> (Maybe (IxValue (InsOrdHashMap FilePath PathItem))
    -> Identity (Maybe (IxValue (InsOrdHashMap FilePath 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 (IxValue (InsOrdHashMap FilePath PathItem))
  -> Identity (Maybe (IxValue (InsOrdHashMap FilePath PathItem))))
 -> OpenApi -> Identity OpenApi)
-> IxValue (InsOrdHashMap FilePath PathItem) -> OpenApi -> OpenApi
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ IxValue (InsOrdHashMap FilePath 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 :: forall sub api.
(IsSubAPI sub api, HasOpenApi sub) =>
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 :: 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
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
Lens' OpenApi Components
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
Lens' Components (Definitions Schema)
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 :: 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
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 :: 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)
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
Lens' OpenApi (InsOrdHashMap FilePath PathItem)
paths((InsOrdHashMap FilePath PathItem
  -> Identity (InsOrdHashMap FilePath PathItem))
 -> OpenApi -> Identity OpenApi)
-> ((Maybe (IxValue (InsOrdHashMap FilePath PathItem))
     -> Identity (Maybe PathItem))
    -> InsOrdHashMap FilePath PathItem
    -> Identity (InsOrdHashMap FilePath PathItem))
-> (Maybe (IxValue (InsOrdHashMap FilePath 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 (IxValue (InsOrdHashMap FilePath 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
Lens' Response (InsOrdHashMap MediaType MediaTypeObject)
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
Lens' MediaTypeObject (Maybe (Referenced Schema))
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 Text (Referenced Header)
 -> Identity (InsOrdHashMap Text (Referenced Header)))
-> Response -> Identity Response
forall s a. HasHeaders s a => Lens' s a
Lens' Response (InsOrdHashMap Text (Referenced Header))
headers ((InsOrdHashMap Text (Referenced Header)
  -> Identity (InsOrdHashMap Text (Referenced Header)))
 -> Response -> Identity Response)
-> InsOrdHashMap Text (Referenced Header) -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InsOrdHashMap Text (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)
forall (proxy :: k1 -> *).
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 Text (Referenced Header)
responseHeaders      = Header -> Referenced Header
forall a. a -> Referenced a
Inline (Header -> Referenced Header)
-> InsOrdHashMap Text Header
-> InsOrdHashMap Text (Referenced Header)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy hs -> InsOrdHashMap Text Header
forall {k} (hs :: k).
AllToResponseHeader hs =>
Proxy hs -> InsOrdHashMap Text 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 :: forall {k1} (proxy :: * -> *) (method :: k1).
OpenApiMethod method =>
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
Lens' OpenApi (InsOrdHashMap FilePath PathItem)
paths((InsOrdHashMap FilePath PathItem
  -> Identity (InsOrdHashMap FilePath PathItem))
 -> OpenApi -> Identity OpenApi)
-> ((Maybe (IxValue (InsOrdHashMap FilePath PathItem))
     -> Identity (Maybe PathItem))
    -> InsOrdHashMap FilePath PathItem
    -> Identity (InsOrdHashMap FilePath PathItem))
-> (Maybe (IxValue (InsOrdHashMap FilePath 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 (IxValue (InsOrdHashMap FilePath 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)
forall (proxy :: k1 -> *).
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
Lens' Operation [Referenced Param]
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
Lens' Operation (Maybe (Referenced RequestBody))
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 :: Text -> Text
markdownCode Text
s = Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"

addDefaultResponse404 :: ParamName -> OpenApi -> OpenApi
addDefaultResponse404 :: Text -> OpenApi -> OpenApi
addDefaultResponse404 Text
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 a. a -> DeclareT (Definitions Schema) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Response
response404)
  where
    sname :: Text
sname = Text -> Text
markdownCode Text
pname
    description404 :: Text
description404 = Text
sname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not found"
    alter404 :: Response -> Response
alter404 = (Text -> Identity Text) -> Response -> Identity Response
forall s a. HasDescription s a => Lens' s a
Lens' Response Text
description ((Text -> Identity Text) -> Response -> Identity Response)
-> (Text -> Text) -> Response -> Response
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((Text
sname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" or ") Text -> Text -> Text
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
& (Text -> Identity Text) -> Response -> Identity Response
forall s a. HasDescription s a => Lens' s a
Lens' Response Text
description ((Text -> Identity Text) -> Response -> Identity Response)
-> Text -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
description404

addDefaultResponse400 :: ParamName -> OpenApi -> OpenApi
addDefaultResponse400 :: Text -> OpenApi -> OpenApi
addDefaultResponse400 Text
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 a. a -> DeclareT (Definitions Schema) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Response
response400)
  where
    sname :: Text
sname = Text -> Text
markdownCode Text
pname
    description400 :: Text
description400 = Text
"Invalid " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sname
    alter400 :: Response -> Response
alter400 = (Text -> Identity Text) -> Response -> Identity Response
forall s a. HasDescription s a => Lens' s a
Lens' Response Text
description ((Text -> Identity Text) -> Response -> Identity Response)
-> (Text -> Text) -> Response -> Response
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
" or " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sname))
    response400 :: Response
response400 = Response
forall a. Monoid a => a
mempty Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> Response -> Identity Response
forall s a. HasDescription s a => Lens' s a
Lens' Response Text
description ((Text -> Identity Text) -> Response -> Identity Response)
-> Text -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
description400

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

instance OpenApiMethod 'GET     where openApiMethod :: forall (proxy :: StdMethod -> *).
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
Lens' PathItem (Maybe Operation)
get
instance OpenApiMethod 'PUT     where openApiMethod :: forall (proxy :: StdMethod -> *).
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
Lens' PathItem (Maybe Operation)
put
instance OpenApiMethod 'POST    where openApiMethod :: forall (proxy :: StdMethod -> *).
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
Lens' PathItem (Maybe Operation)
post
instance OpenApiMethod 'DELETE  where openApiMethod :: forall (proxy :: StdMethod -> *).
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
Lens' PathItem (Maybe Operation)
delete
instance OpenApiMethod 'OPTIONS where openApiMethod :: forall (proxy :: StdMethod -> *).
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
Lens' PathItem (Maybe Operation)
options
instance OpenApiMethod 'HEAD    where openApiMethod :: forall (proxy :: StdMethod -> *).
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
Lens' PathItem (Maybe Operation)
head_
instance OpenApiMethod 'PATCH   where openApiMethod :: forall (proxy :: StdMethod -> *).
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
Lens' PathItem (Maybe Operation)
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
        { _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 Text
_pathItemSummary = PathItem -> Maybe Text
_pathItemSummary PathItem
s Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PathItem -> Maybe Text
_pathItemSummary PathItem
t
        , _pathItemDescription :: Maybe Text
_pathItemDescription = PathItem -> Maybe Text
_pathItemDescription PathItem
s Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PathItem -> Maybe Text
_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
        { _openApiOpenapi :: OpenApiSpecVersion
_openApiOpenapi = OpenApi -> OpenApiSpecVersion
_openApiOpenapi OpenApi
s OpenApiSpecVersion -> OpenApiSpecVersion -> OpenApiSpecVersion
forall a. Semigroup a => a -> a -> a
<> OpenApi -> OpenApiSpecVersion
_openApiOpenapi OpenApi
t
        , _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 a. Maybe a -> Maybe a -> Maybe a
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)

#if MIN_VERSION_servant(0,20,0)
-- | @'WithResource'@ combinator does not change our specification at all.
instance (HasOpenApi sub) => HasOpenApi (WithResource res :> sub) where
  toOpenApi :: Proxy (WithResource res :> sub) -> OpenApi
toOpenApi Proxy (WithResource res :> 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

-- | @'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
& Text -> OpenApi -> OpenApi
addDefaultResponse404 Text
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 :: Text
tname = FilePath -> Text
Text.pack FilePath
pname
      transDesc :: FilePath -> Maybe Text
transDesc FilePath
""   = Maybe Text
forall a. Maybe a
Nothing
      transDesc FilePath
desc = Text -> Maybe Text
forall a. a -> Maybe a
Just (FilePath -> Text
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
& (Text -> Identity Text) -> Param -> Identity Param
forall s a. HasName s a => Lens' s a
Lens' Param Text
name ((Text -> Identity Text) -> Param -> Identity Param)
-> Text -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
tname
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Param -> Identity Param
forall s a. HasDescription s a => Lens' s a
Lens' Param (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text)) -> Param -> Identity Param)
-> Maybe Text -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe Text
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
Lens' Param (Maybe Bool)
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
Lens' Param ParamLocation
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
Lens' Param (Maybe (Referenced Schema))
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 Text -> Identity (Maybe Text))
    -> Operation -> Identity Operation)
-> (Maybe Text -> Identity (Maybe Text))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Text -> Identity (Maybe Text))
-> Operation -> Identity Operation
forall s a. HasDescription s a => Lens' s a
Lens' Operation (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> OpenApi -> Identity OpenApi)
-> (Maybe Text -> Maybe Text) -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text -> Maybe Text
forall a. a -> Maybe a
Just (FilePath -> Text
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 Text -> Maybe Text -> Maybe Text
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 Text -> Identity (Maybe Text))
    -> Operation -> Identity Operation)
-> (Maybe Text -> Identity (Maybe Text))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Text -> Identity (Maybe Text))
-> Operation -> Identity Operation
forall s a. HasSummary s a => Lens' s a
Lens' Operation (Maybe Text)
summary ((Maybe Text -> Identity (Maybe Text))
 -> OpenApi -> Identity OpenApi)
-> (Maybe Text -> Maybe Text) -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text -> Maybe Text
forall a. a -> Maybe a
Just (FilePath -> Text
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 Text -> Maybe Text -> Maybe Text
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
& Text -> OpenApi -> OpenApi
addDefaultResponse400 Text
tname
    where
      tname :: Text
tname = FilePath -> Text
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 Text
transDesc FilePath
""   = Maybe Text
forall a. Maybe a
Nothing
      transDesc FilePath
desc = Text -> Maybe Text
forall a. a -> Maybe a
Just (FilePath -> Text
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
& (Text -> Identity Text) -> Param -> Identity Param
forall s a. HasName s a => Lens' s a
Lens' Param Text
name ((Text -> Identity Text) -> Param -> Identity Param)
-> Text -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
tname
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Param -> Identity Param
forall s a. HasDescription s a => Lens' s a
Lens' Param (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text)) -> Param -> Identity Param)
-> Maybe Text -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe Text
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
Lens' Param (Maybe Bool)
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
Lens' Param ParamLocation
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
Lens' Param (Maybe (Referenced Schema))
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
& Text -> OpenApi -> OpenApi
addDefaultResponse400 Text
tname
    where
      tname :: Text
tname = FilePath -> Text
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
& (Text -> Identity Text) -> Param -> Identity Param
forall s a. HasName s a => Lens' s a
Lens' Param Text
name ((Text -> Identity Text) -> Param -> Identity Param)
-> Text -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
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
Lens' Param ParamLocation
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
Lens' Param (Maybe (Referenced Schema))
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
Lens' Schema (Maybe OpenApiType)
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
Lens' Schema (Maybe OpenApiItems)
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
& Text -> OpenApi -> OpenApi
addDefaultResponse400 Text
tname
    where
      tname :: Text
tname = FilePath -> Text
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
& (Text -> Identity Text) -> Param -> Identity Param
forall s a. HasName s a => Lens' s a
Lens' Param Text
name ((Text -> Identity Text) -> Param -> Identity Param)
-> Text -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
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
Lens' Param ParamLocation
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
Lens' Param (Maybe Bool)
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
Lens' Param (Maybe (Referenced Schema))
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
Lens' Schema (Maybe Value)
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
& Text -> OpenApi -> OpenApi
addDefaultResponse400 Text
tname
    where
      tname :: Text
tname = FilePath -> Text
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 Text
transDesc FilePath
""   = Maybe Text
forall a. Maybe a
Nothing
      transDesc FilePath
desc = Text -> Maybe Text
forall a. a -> Maybe a
Just (FilePath -> Text
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
& (Text -> Identity Text) -> Param -> Identity Param
forall s a. HasName s a => Lens' s a
Lens' Param Text
name ((Text -> Identity Text) -> Param -> Identity Param)
-> Text -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
tname
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Param -> Identity Param
forall s a. HasDescription s a => Lens' s a
Lens' Param (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text)) -> Param -> Identity Param)
-> Maybe Text -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe Text
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
Lens' Param (Maybe Bool)
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
Lens' Param ParamLocation
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
Lens' Param (Maybe (Referenced Schema))
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
& Text -> OpenApi -> OpenApi
addDefaultResponse400 Text
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
Lens' OpenApi Components
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
Lens' Components (Definitions Schema)
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 :: Text
tname = Text
"body"
      transDesc :: FilePath -> Maybe Text
transDesc FilePath
""   = Maybe Text
forall a. Maybe a
Nothing
      transDesc FilePath
desc = Text -> Maybe Text
forall a. a -> Maybe a
Just (FilePath -> Text
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 Text -> Identity (Maybe Text))
-> RequestBody -> Identity RequestBody
forall s a. HasDescription s a => Lens' s a
Lens' RequestBody (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> RequestBody -> Identity RequestBody)
-> Maybe Text -> RequestBody -> RequestBody
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe Text
transDesc (Proxy mods -> FilePath
forall (mods :: [*]).
KnownSymbol (FoldDescription mods) =>
Proxy mods -> FilePath
reflectDescription (Proxy mods
forall {k} (t :: k). Proxy t
Proxy :: Proxy mods))
        -- ReqBody' is always required, as per the Servant documentation
        RequestBody -> (RequestBody -> RequestBody) -> RequestBody
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool))
-> RequestBody -> Identity RequestBody
forall s a. HasRequired s a => Lens' s a
Lens' RequestBody (Maybe Bool)
required ((Maybe Bool -> Identity (Maybe Bool))
 -> RequestBody -> Identity RequestBody)
-> Bool -> RequestBody -> RequestBody
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True
        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
Lens' RequestBody (InsOrdHashMap MediaType MediaTypeObject)
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
Lens' MediaTypeObject (Maybe (Referenced Schema))
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
& Text -> OpenApi -> OpenApi
addDefaultResponse400 Text
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
Lens' OpenApi Components
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
Lens' Components (Definitions Schema)
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 :: Text
tname = Text
"body"
      transDesc :: FilePath -> Maybe Text
transDesc FilePath
""   = Maybe Text
forall a. Maybe a
Nothing
      transDesc FilePath
desc = Text -> Maybe Text
forall a. a -> Maybe a
Just (FilePath -> Text
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 Text -> Identity (Maybe Text))
-> RequestBody -> Identity RequestBody
forall s a. HasDescription s a => Lens' s a
Lens' RequestBody (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> RequestBody -> Identity RequestBody)
-> Maybe Text -> RequestBody -> RequestBody
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe Text
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
Lens' RequestBody (InsOrdHashMap MediaType MediaTypeObject)
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
Lens' MediaTypeObject (Maybe (Referenced Schema))
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 a. NonEmpty a -> [a]
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

#if MIN_VERSION_servant(0,19,0)
instance (HasOpenApi (ToServantApi sub)) => HasOpenApi (NamedRoutes sub) where
  toOpenApi :: Proxy (NamedRoutes sub) -> OpenApi
toOpenApi Proxy (NamedRoutes sub)
_ = Proxy (ToServantApi sub) -> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy (ToServantApi sub)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ToServantApi 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) -> (Text, Header)
toResponseHeader Proxy (Header sym a)
_ = (Text
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
Lens' Header (Maybe (Referenced Schema))
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 :: Text
hname = FilePath -> Text
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 Text Header
toAllResponseHeaders Proxy '[]
_ = InsOrdHashMap Text Header
forall a. Monoid a => a
mempty

instance (ToResponseHeader h, AllToResponseHeader hs) => AllToResponseHeader (h ': hs) where
  toAllResponseHeaders :: Proxy (h : hs) -> InsOrdHashMap Text Header
toAllResponseHeaders Proxy (h : hs)
_ = Text
-> Header -> InsOrdHashMap Text Header -> InsOrdHashMap Text Header
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert Text
headerName Header
headerBS InsOrdHashMap Text Header
hdrs
    where
      (Text
headerName, Header
headerBS) = Proxy h -> (Text, Header)
forall {k} (h :: k).
ToResponseHeader h =>
Proxy h -> (Text, Header)
toResponseHeader (Proxy h
forall {k} (t :: k). Proxy t
Proxy :: Proxy h)
      hdrs :: InsOrdHashMap Text Header
hdrs = Proxy hs -> InsOrdHashMap Text Header
forall {k} (hs :: k).
AllToResponseHeader hs =>
Proxy hs -> InsOrdHashMap Text 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 Text Header
toAllResponseHeaders Proxy (HList hs)
_ = Proxy hs -> InsOrdHashMap Text Header
forall {k} (hs :: k).
AllToResponseHeader hs =>
Proxy hs -> InsOrdHashMap Text Header
toAllResponseHeaders (Proxy hs
forall {k} (t :: k). Proxy t
Proxy :: Proxy hs)