module Web.Minion.OpenApi3 (
  OpenApi3Config (..),
  OpenApi3,
  AttachRequestSchema (..),
  IsOpenApi3Description (..),
  OpenApi3Description (..),
  ToResponses (..),
  openapi3,
  -- | Use these newtypes to implement instances for according auths/response bodies/request bodies
  -- We do not implement it for concrete types to avoid extra dependencies
  AsCookieJwt (..),
  AsJwt (..),
  AsHtml (..),
  AsSSE (..),
  AsBinary (..),
  AsMultipart (..),
  AttachSecuritySchema (..),
  AttachSecuritySchemas (..),
) where

import Data.OpenApi hiding (Header (..))
import Web.Minion hiding (description)
import Web.Minion.Router

import Control.Applicative ((<|>))
import Control.Arrow ((>>>))
import Control.Lens hiding (index)
import Control.Monad.IO.Class (MonadIO)
import Data.Bifunctor (Bifunctor (..))
import Data.ByteString qualified as Bytes
import Data.CaseInsensitive qualified as CI
import Data.Data (Proxy (..))
import Data.Foldable (Foldable (..))
import Data.HashMap.Strict.InsOrd qualified as HM
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.Maybe (listToMaybe)
import Data.OpenApi.Declare (runDeclare)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Network.HTTP.Types (Status (..))
import Network.HTTP.Types qualified as Http
import Text.Blaze
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Web.HttpApiData (ToHttpApiData (..))
import Web.Minion.Auth.Basic (Basic)
import Web.Minion.Files (indexTemplate, ui)
import Web.Minion.Introspect qualified as I
import Web.Minion.Media
import Web.Minion.Response.Header qualified as Header
import Web.Minion.Response.Status
import Web.Minion.Response.Union
import Web.Minion.Static

data OpenApi3Config = OpenApi3Config
  { OpenApi3Config -> FilePath
openapi3File :: !FilePath
  , OpenApi3Config -> FilePath
staticDir :: !FilePath
  }

data OpenApi3

class AttachRequestSchema a where
  attachRequestSchema :: OpenApi -> OpenApi

type instance I.Introspection OpenApi3 I.QueryParam = ToParamSchema
type instance I.Introspection OpenApi3 I.Capture = ToParamSchema
type instance I.Introspection OpenApi3 I.Captures = ToParamSchema
type instance I.Introspection OpenApi3 I.Header = ToParamSchema
type instance I.Introspection OpenApi3 I.Request = AttachRequestSchema
type instance I.Introspection OpenApi3 I.Response = ToResponses
type instance I.Introspection OpenApi3 I.Description = IsOpenApi3Description

class IsOpenApi3Description a where
  toOpenApi3Description :: a -> OpenApi3Description

instance IsOpenApi3Description OpenApi3Description where
  toOpenApi3Description :: OpenApi3Description -> OpenApi3Description
toOpenApi3Description = OpenApi3Description -> OpenApi3Description
forall a. a -> a
id

data OpenApi3Description = DescriptionText Text | SummaryText Text

instance (AttachSecuritySchemas as) => AttachRequestSchema (Auth as a) where
  attachRequestSchema :: OpenApi -> OpenApi
attachRequestSchema = forall (as :: [*]). AttachSecuritySchemas as => OpenApi -> OpenApi
forall {k} (as :: k).
AttachSecuritySchemas as =>
OpenApi -> OpenApi
attachSecuritySchemas @as

class AttachSecuritySchemas as where
  attachSecuritySchemas :: OpenApi -> OpenApi

instance AttachSecuritySchemas '[] where
  attachSecuritySchemas :: OpenApi -> OpenApi
attachSecuritySchemas = OpenApi -> OpenApi
forall a. a -> a
id

instance (AttachSecuritySchema a, AttachSecuritySchemas as) => AttachSecuritySchemas (a ': as) where
  attachSecuritySchemas :: OpenApi -> OpenApi
attachSecuritySchemas = forall (as :: [a]). AttachSecuritySchemas as => OpenApi -> OpenApi
forall {k} (as :: k).
AttachSecuritySchemas as =>
OpenApi -> OpenApi
attachSecuritySchemas @as (OpenApi -> OpenApi) -> (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: a). AttachSecuritySchema a => OpenApi -> OpenApi
forall {k} (a :: k). AttachSecuritySchema a => OpenApi -> OpenApi
attachSecuritySchema @a

class AttachSecuritySchema a where
  attachSecuritySchema :: OpenApi -> OpenApi

instance AttachSecuritySchema Basic where
  attachSecuritySchema :: OpenApi -> OpenApi
attachSecuritySchema = Text -> OpenApi -> OpenApi
addSecurityRequirement Text
identifier (OpenApi -> OpenApi) -> (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SecurityScheme -> OpenApi -> OpenApi
addSecurityScheme Text
identifier SecurityScheme
securityScheme
   where
    identifier :: Text
identifier = Text
"BasicAuth"
    securityScheme :: SecurityScheme
securityScheme =
      SecurityScheme
        { _securitySchemeType :: SecuritySchemeType
_securitySchemeType = HttpSchemeType -> SecuritySchemeType
SecuritySchemeHttp HttpSchemeType
HttpSchemeBasic
        , _securitySchemeDescription :: Maybe Text
_securitySchemeDescription = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Basic Authentication"
        }

newtype AsJwt a = AsJwt a
instance AttachSecuritySchema (AsJwt a) where
  attachSecuritySchema :: OpenApi -> OpenApi
attachSecuritySchema = Text -> OpenApi -> OpenApi
addSecurityRequirement Text
identifier (OpenApi -> OpenApi) -> (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SecurityScheme -> OpenApi -> OpenApi
addSecurityScheme Text
identifier SecurityScheme
securityScheme
   where
    identifier :: Text
identifier = Text
"JWT"
    securityScheme :: SecurityScheme
securityScheme =
      SecurityScheme
        { _securitySchemeType :: SecuritySchemeType
_securitySchemeType = HttpSchemeType -> SecuritySchemeType
SecuritySchemeHttp (HttpSchemeType -> SecuritySchemeType)
-> HttpSchemeType -> SecuritySchemeType
forall a b. (a -> b) -> a -> b
$ Maybe Text -> HttpSchemeType
HttpSchemeBearer (Maybe Text -> HttpSchemeType) -> Maybe Text -> HttpSchemeType
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"JWT"
        , _securitySchemeDescription :: Maybe Text
_securitySchemeDescription = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Bearer Authentication"
        }

newtype AsCookieJwt a = AsCookieJwt a

instance AttachSecuritySchema (AsCookieJwt a) where
  attachSecuritySchema :: OpenApi -> OpenApi
attachSecuritySchema = Text -> OpenApi -> OpenApi
addSecurityRequirement Text
identifier (OpenApi -> OpenApi) -> (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SecurityScheme -> OpenApi -> OpenApi
addSecurityScheme Text
identifier SecurityScheme
securityScheme
   where
    identifier :: Text
identifier = Text
"Cookie"
    securityScheme :: SecurityScheme
securityScheme =
      SecurityScheme
        { _securitySchemeType :: SecuritySchemeType
_securitySchemeType = HttpSchemeType -> SecuritySchemeType
SecuritySchemeHttp (HttpSchemeType -> SecuritySchemeType)
-> HttpSchemeType -> SecuritySchemeType
forall a b. (a -> b) -> a -> b
$ Maybe Text -> HttpSchemeType
HttpSchemeBearer (Maybe Text -> HttpSchemeType) -> Maybe Text -> HttpSchemeType
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"JWT"
        , _securitySchemeDescription :: Maybe Text
_securitySchemeDescription = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Cookie Authentication"
        }

addSecurityScheme :: Text -> SecurityScheme -> OpenApi -> OpenApi
addSecurityScheme :: Text -> SecurityScheme -> OpenApi -> OpenApi
addSecurityScheme Text
securityIdentifier SecurityScheme
securityScheme OpenApi
openApi =
  OpenApi
openApi
    { _openApiComponents =
        (_openApiComponents openApi)
          { _componentsSecuritySchemes =
              _componentsSecuritySchemes (_openApiComponents openApi)
                <> SecurityDefinitions (HM.singleton securityIdentifier securityScheme)
          }
    }

addSecurityRequirement :: Text -> OpenApi -> OpenApi
addSecurityRequirement :: Text -> OpenApi -> OpenApi
addSecurityRequirement Text
securityRequirement =
  (Operation -> Identity Operation) -> OpenApi -> Identity OpenApi
Traversal' OpenApi Operation
allOperations
    ((Operation -> Identity Operation) -> OpenApi -> Identity OpenApi)
-> (([SecurityRequirement] -> Identity [SecurityRequirement])
    -> Operation -> Identity Operation)
-> ([SecurityRequirement] -> Identity [SecurityRequirement])
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SecurityRequirement] -> Identity [SecurityRequirement])
-> Operation -> Identity Operation
forall s a. HasSecurity s a => Lens' s a
Lens' Operation [SecurityRequirement]
security
    (([SecurityRequirement] -> Identity [SecurityRequirement])
 -> OpenApi -> Identity OpenApi)
-> ([SecurityRequirement] -> [SecurityRequirement])
-> OpenApi
-> OpenApi
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((InsOrdHashMap Text [Text] -> SecurityRequirement
SecurityRequirement (InsOrdHashMap Text [Text] -> SecurityRequirement)
-> InsOrdHashMap Text [Text] -> SecurityRequirement
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> InsOrdHashMap Text [Text]
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
HM.singleton Text
securityRequirement []) SecurityRequirement
-> [SecurityRequirement] -> [SecurityRequirement]
forall a. a -> [a] -> [a]
:)

instance (ToSchema a, AllContentTypes cts) => AttachRequestSchema (ReqBody cts a) where
  attachRequestSchema :: OpenApi -> OpenApi
attachRequestSchema =
    RequestBody -> OpenApi -> OpenApi
addRequestBody RequestBody
reqB
      (OpenApi -> OpenApi) -> (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> OpenApi -> OpenApi
addDefaultResponse400 Text
tname
      (OpenApi -> OpenApi) -> (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (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
    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
    tname :: Text
tname = Text
"body"
    (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
    reqB :: RequestBody
reqB =
      (RequestBody
forall a. Monoid a => a
mempty :: RequestBody)
        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 <- forall (cts :: [*]). AllContentTypes cts => [MediaType]
forall {k} (cts :: k). AllContentTypes cts => [MediaType]
allContentTypes @cts]

newtype AsHtml a = AsHtml a
instance ToResponses (AsHtml a) where
  toResponses :: (Responses, Definitions Schema)
toResponses = (Responses
resps, [])
   where
    resps :: Responses
resps =
      Responses
        { _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
_responsesResponses = InsOrdHashMap HttpStatusCode (Referenced Response)
forall a. Monoid a => a
mempty InsOrdHashMap HttpStatusCode (Referenced Response)
-> (InsOrdHashMap HttpStatusCode (Referenced Response)
    -> InsOrdHashMap HttpStatusCode (Referenced Response))
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall a b. a -> (a -> b) -> b
& Index (InsOrdHashMap HttpStatusCode (Referenced Response))
-> Lens'
     (InsOrdHashMap HttpStatusCode (Referenced Response))
     (Maybe
        (IxValue (InsOrdHashMap HttpStatusCode (Referenced Response))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
Index (InsOrdHashMap HttpStatusCode (Referenced Response))
200 ((Maybe (Referenced Response)
  -> Identity (Maybe (Referenced Response)))
 -> InsOrdHashMap HttpStatusCode (Referenced Response)
 -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
-> Referenced Response
-> InsOrdHashMap HttpStatusCode (Referenced Response)
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Response
resp
        , _responsesDefault :: Maybe (Referenced Response)
_responsesDefault = Maybe (Referenced Response)
forall a. Maybe a
Nothing
        }
    resp :: Referenced Response
resp =
      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
"text/html", MediaTypeObject
forall a. Monoid a => a
mempty)]
        )

newtype AsBinary a = AsBinary a
instance ToResponses (AsBinary a) where
  toResponses :: (Responses, Definitions Schema)
toResponses = (Responses
resps, [])
   where
    resps :: Responses
resps =
      Responses
        { _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
_responsesResponses = InsOrdHashMap HttpStatusCode (Referenced Response)
forall a. Monoid a => a
mempty InsOrdHashMap HttpStatusCode (Referenced Response)
-> (InsOrdHashMap HttpStatusCode (Referenced Response)
    -> InsOrdHashMap HttpStatusCode (Referenced Response))
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall a b. a -> (a -> b) -> b
& Index (InsOrdHashMap HttpStatusCode (Referenced Response))
-> Lens'
     (InsOrdHashMap HttpStatusCode (Referenced Response))
     (Maybe
        (IxValue (InsOrdHashMap HttpStatusCode (Referenced Response))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
Index (InsOrdHashMap HttpStatusCode (Referenced Response))
200 ((Maybe (Referenced Response)
  -> Identity (Maybe (Referenced Response)))
 -> InsOrdHashMap HttpStatusCode (Referenced Response)
 -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
-> Referenced Response
-> InsOrdHashMap HttpStatusCode (Referenced Response)
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Response
resp
        , _responsesDefault :: Maybe (Referenced Response)
_responsesDefault = Maybe (Referenced Response)
forall a. Maybe a
Nothing
        }
    resp :: Referenced Response
resp =
      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
"octet/stream", MediaTypeObject
forall a. Monoid a => a
mempty)]
        )

newtype AsSSE a = AsSSE a

-- | It's just a stub for now
instance ToResponses (AsSSE a) where
  toResponses :: (Responses, Definitions Schema)
toResponses = (Responses
resps, [])
   where
    resps :: Responses
resps =
      Responses
        { _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
_responsesResponses = InsOrdHashMap HttpStatusCode (Referenced Response)
forall a. Monoid a => a
mempty InsOrdHashMap HttpStatusCode (Referenced Response)
-> (InsOrdHashMap HttpStatusCode (Referenced Response)
    -> InsOrdHashMap HttpStatusCode (Referenced Response))
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall a b. a -> (a -> b) -> b
& Index (InsOrdHashMap HttpStatusCode (Referenced Response))
-> Lens'
     (InsOrdHashMap HttpStatusCode (Referenced Response))
     (Maybe
        (IxValue (InsOrdHashMap HttpStatusCode (Referenced Response))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
Index (InsOrdHashMap HttpStatusCode (Referenced Response))
200 ((Maybe (Referenced Response)
  -> Identity (Maybe (Referenced Response)))
 -> InsOrdHashMap HttpStatusCode (Referenced Response)
 -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
-> Referenced Response
-> InsOrdHashMap HttpStatusCode (Referenced Response)
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Response
resp
        , _responsesDefault :: Maybe (Referenced Response)
_responsesDefault = Maybe (Referenced Response)
forall a. Maybe a
Nothing
        }
    resp :: Referenced Response
resp =
      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
"text/event-stream", MediaTypeObject
forall a. Monoid a => a
mempty)]
        )

newtype AsMultipart a = AsMultipart a

instance AttachRequestSchema (AsMultipart a) where
  attachRequestSchema :: OpenApi -> OpenApi
attachRequestSchema =
    RequestBody -> OpenApi -> OpenApi
addRequestBody RequestBody
reqB
      (OpenApi -> OpenApi) -> (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> OpenApi -> OpenApi
addDefaultResponse400 Text
tname
   where
    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
    tname :: Text
tname = Text
"body"
    reqB :: RequestBody
reqB =
      (RequestBody
forall a. Monoid a => a
mempty :: RequestBody)
        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
"multipart/form-data", MediaTypeObject
forall a. Monoid a => a
mempty)]

instance (ToSchema a, AllContentTypes cts) => ToResponses (RespBody cts a) where
  toResponses :: (Responses, Definitions Schema)
toResponses = (Responses
resps, 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
    resps :: Responses
resps =
      Responses
        { _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
_responsesResponses = InsOrdHashMap HttpStatusCode (Referenced Response)
forall a. Monoid a => a
mempty InsOrdHashMap HttpStatusCode (Referenced Response)
-> (InsOrdHashMap HttpStatusCode (Referenced Response)
    -> InsOrdHashMap HttpStatusCode (Referenced Response))
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall a b. a -> (a -> b) -> b
& Index (InsOrdHashMap HttpStatusCode (Referenced Response))
-> Lens'
     (InsOrdHashMap HttpStatusCode (Referenced Response))
     (Maybe
        (IxValue (InsOrdHashMap HttpStatusCode (Referenced Response))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
Index (InsOrdHashMap HttpStatusCode (Referenced Response))
200 ((Maybe (Referenced Response)
  -> Identity (Maybe (Referenced Response)))
 -> InsOrdHashMap HttpStatusCode (Referenced Response)
 -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
-> Referenced Response
-> InsOrdHashMap HttpStatusCode (Referenced Response)
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Response
resp
        , _responsesDefault :: Maybe (Referenced Response)
_responsesDefault = Maybe (Referenced Response)
forall a. Maybe a
Nothing
        }
    resp :: Referenced Response
resp =
      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)
-> Referenced Schema -> MediaTypeObject -> MediaTypeObject
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema
ref) | MediaType
t <- [MediaType]
responseContentTypes]
        )

    responseContentTypes :: [MediaType]
responseContentTypes = forall (cts :: k). AllContentTypes cts => [MediaType]
forall {k} (cts :: k). AllContentTypes cts => [MediaType]
allContentTypes @cts

instance ToResponses NoBody where
  toResponses :: (Responses, Definitions Schema)
toResponses = (Responses
resps, Definitions Schema
forall a. Monoid a => a
mempty)
   where
    resps :: Responses
resps =
      Responses
        { _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
_responsesResponses = InsOrdHashMap HttpStatusCode (Referenced Response)
forall a. Monoid a => a
mempty InsOrdHashMap HttpStatusCode (Referenced Response)
-> (InsOrdHashMap HttpStatusCode (Referenced Response)
    -> InsOrdHashMap HttpStatusCode (Referenced Response))
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall a b. a -> (a -> b) -> b
& Index (InsOrdHashMap HttpStatusCode (Referenced Response))
-> Lens'
     (InsOrdHashMap HttpStatusCode (Referenced Response))
     (Maybe
        (IxValue (InsOrdHashMap HttpStatusCode (Referenced Response))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
Index (InsOrdHashMap HttpStatusCode (Referenced Response))
200 ((Maybe (Referenced Response)
  -> Identity (Maybe (Referenced Response)))
 -> InsOrdHashMap HttpStatusCode (Referenced Response)
 -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
-> Referenced Response
-> InsOrdHashMap HttpStatusCode (Referenced Response)
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Response
resp
        , _responsesDefault :: Maybe (Referenced Response)
_responsesDefault = Maybe (Referenced Response)
forall a. Maybe a
Nothing
        }
    resp :: Referenced Response
resp = Response -> Referenced Response
forall a. a -> Referenced a
Inline Response
forall a. Monoid a => a
mempty

instance ToResponses LazyBytes where
  toResponses :: (Responses, Definitions Schema)
toResponses = (Responses
resps, Definitions Schema
forall a. Monoid a => a
mempty)
   where
    resps :: Responses
resps =
      Responses
        { _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
_responsesResponses = InsOrdHashMap HttpStatusCode (Referenced Response)
forall a. Monoid a => a
mempty InsOrdHashMap HttpStatusCode (Referenced Response)
-> (InsOrdHashMap HttpStatusCode (Referenced Response)
    -> InsOrdHashMap HttpStatusCode (Referenced Response))
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall a b. a -> (a -> b) -> b
& Index (InsOrdHashMap HttpStatusCode (Referenced Response))
-> Lens'
     (InsOrdHashMap HttpStatusCode (Referenced Response))
     (Maybe
        (IxValue (InsOrdHashMap HttpStatusCode (Referenced Response))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
Index (InsOrdHashMap HttpStatusCode (Referenced Response))
200 ((Maybe (Referenced Response)
  -> Identity (Maybe (Referenced Response)))
 -> InsOrdHashMap HttpStatusCode (Referenced Response)
 -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
-> Referenced Response
-> InsOrdHashMap HttpStatusCode (Referenced Response)
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Response
resp
        , _responsesDefault :: Maybe (Referenced Response)
_responsesDefault = Maybe (Referenced Response)
forall a. Maybe a
Nothing
        }
    resp :: Referenced Response
resp =
      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
"application/octet-stream", MediaTypeObject
forall a. Monoid a => a
mempty)]
        )

instance ToResponses Chunks where
  toResponses :: (Responses, Definitions Schema)
toResponses = forall a. ToResponses a => (Responses, Definitions Schema)
forall {k} (a :: k).
ToResponses a =>
(Responses, Definitions Schema)
toResponses @LazyBytes

instance (ToResponses a, ToResponses (Union as)) => ToResponses (Union (a ': as)) where
  toResponses :: (Responses, Definitions Schema)
toResponses =
    let (Responses
resp, Definitions Schema
def) = forall a. ToResponses a => (Responses, Definitions Schema)
forall {k} (a :: k).
ToResponses a =>
(Responses, Definitions Schema)
toResponses @a
        (Responses
resps, Definitions Schema
defs) = forall a. ToResponses a => (Responses, Definitions Schema)
forall {k} (a :: k).
ToResponses a =>
(Responses, Definitions Schema)
toResponses @(Union as)
     in (Responses
resp Responses -> Responses -> Responses
forall a. Semigroup a => a -> a -> a
<> Responses
resps, Definitions Schema
def Definitions Schema -> Definitions Schema -> Definitions Schema
forall a. Semigroup a => a -> a -> a
<> Definitions Schema
defs)

instance (ToResponses a, IsStatus status) => ToResponses (WithStatus status a) where
  toResponses :: (Responses, Definitions Schema)
toResponses =
    let (Responses{Maybe (Referenced Response)
InsOrdHashMap HttpStatusCode (Referenced Response)
_responsesResponses :: Responses -> InsOrdHashMap HttpStatusCode (Referenced Response)
_responsesDefault :: Responses -> Maybe (Referenced Response)
_responsesDefault :: Maybe (Referenced Response)
_responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
..}, Definitions Schema
def) = forall a. ToResponses a => (Responses, Definitions Schema)
forall {k} (a :: k).
ToResponses a =>
(Responses, Definitions Schema)
toResponses @a
        Status HttpStatusCode
code ByteString
_ = forall (status :: k). IsStatus status => Status
forall {k} (status :: k). IsStatus status => Status
status @status
     in ( Responses
            { _responsesDefault :: Maybe (Referenced Response)
_responsesDefault = Maybe (Referenced Response)
forall a. Maybe a
Nothing
            , _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
_responsesResponses =
                InsOrdHashMap HttpStatusCode (Referenced Response)
forall a. Monoid a => a
mempty
                  InsOrdHashMap HttpStatusCode (Referenced Response)
-> (InsOrdHashMap HttpStatusCode (Referenced Response)
    -> InsOrdHashMap HttpStatusCode (Referenced Response))
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall a b. a -> (a -> b) -> b
& Index (InsOrdHashMap HttpStatusCode (Referenced Response))
-> Lens'
     (InsOrdHashMap HttpStatusCode (Referenced Response))
     (Maybe
        (IxValue (InsOrdHashMap HttpStatusCode (Referenced Response))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
Index (InsOrdHashMap HttpStatusCode (Referenced Response))
code
                    ((Maybe (Referenced Response)
  -> Identity (Maybe (Referenced Response)))
 -> InsOrdHashMap HttpStatusCode (Referenced Response)
 -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
-> Maybe (Referenced Response)
-> InsOrdHashMap HttpStatusCode (Referenced Response)
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ( InsOrdHashMap HttpStatusCode (Referenced Response)
_responsesResponses InsOrdHashMap HttpStatusCode (Referenced Response)
-> Getting
     (Maybe (Referenced Response))
     (InsOrdHashMap HttpStatusCode (Referenced Response))
     (Maybe (Referenced Response))
-> Maybe (Referenced Response)
forall s a. s -> Getting a s a -> a
^. Index (InsOrdHashMap HttpStatusCode (Referenced Response))
-> Lens'
     (InsOrdHashMap HttpStatusCode (Referenced Response))
     (Maybe
        (IxValue (InsOrdHashMap HttpStatusCode (Referenced Response))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
Index (InsOrdHashMap HttpStatusCode (Referenced Response))
code
                          Maybe (Referenced Response)
-> Maybe (Referenced Response) -> Maybe (Referenced Response)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Referenced Response] -> Maybe (Referenced Response)
forall a. [a] -> Maybe a
listToMaybe (InsOrdHashMap HttpStatusCode (Referenced Response)
-> [Referenced Response]
forall a. InsOrdHashMap HttpStatusCode a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList InsOrdHashMap HttpStatusCode (Referenced Response)
_responsesResponses)
                          Maybe (Referenced Response)
-> Maybe (Referenced Response) -> Maybe (Referenced Response)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Referenced Response)
_responsesDefault
                       )
            }
        , Definitions Schema
def
        )

class ToResponses a where
  toResponses :: (Responses, Definitions Schema)

openapi3 ::
  forall m ts st.
  (HandleArgs ts st m, MonadIO m) =>
  OpenApi3Config ->
  Router' OpenApi3 ts m ->
  Router' Void Void m
openapi3 :: forall (m :: * -> *) ts (st :: [*]).
(HandleArgs ts st m, MonadIO m) =>
OpenApi3Config -> Router' OpenApi3 ts m -> Router' Void Void m
openapi3 OpenApi3Config{FilePath
$sel:openapi3File:OpenApi3Config :: OpenApi3Config -> FilePath
$sel:staticDir:OpenApi3Config :: OpenApi3Config -> FilePath
openapi3File :: FilePath
staticDir :: FilePath
..} Router' OpenApi3 ts m
r =
  [ Text -> Router' Void Void m -> Router' Void Void m
forall i ts (m :: * -> *). Text -> Router' i ts m -> Router' i ts m
Piece (FilePath -> Text
Text.pack FilePath
openapi3File) (Router' Void Void m -> Router' Void Void m)
-> Router' Void Void m -> Router' Void Void m
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> ByteString -> (DelayedArgs '[] ~> m OpenApi) -> Router' Void Void m
forall o (m :: * -> *) ts i (st :: [*]).
(HandleArgs ts st m, ToJSON o, MonadIO m,
 Introspection i 'Response (RespBody '[Json] o)) =>
ByteString -> (DelayedArgs st ~> m o) -> Router' i ts m
handleJson ByteString
GET (OpenApi -> m OpenApi
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OpenApi -> m OpenApi) -> OpenApi -> m OpenApi
forall a b. (a -> b) -> a -> b
$ Router' OpenApi3 ts m -> OpenApi
forall (m :: * -> *) ts. Router' OpenApi3 ts m -> OpenApi
generateOpenApi3 Router' OpenApi3 ts m
r)
  , Text -> Router' Void Void m -> Router' Void Void m
forall i ts (m :: * -> *). Text -> Router' i ts m -> Router' i ts m
Piece (FilePath -> Text
Text.pack FilePath
staticDir)
      (Router' Void Void m -> Router' Void Void m)
-> Router' Void Void m -> Router' Void Void m
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> [ Router' Void Void m -> Router' Void Void m
"index.html" (Router' Void Void m -> Router' Void Void m)
-> Router' Void Void m -> Router' Void Void m
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> Router' Void Void m
getIndex
         , Map FilePath MediaType
-> [(FilePath, ByteString)] -> Router' Void Void m
forall (m :: * -> *) i.
(Monad m,
 Introspection
   i
   'Response
   (AddHeaders
      '[AddHeader "Content-Type" RawHeaderValue] LazyBytes)) =>
Map FilePath MediaType
-> [(FilePath, ByteString)] -> Router' i Void m
staticFiles Map FilePath MediaType
defaultExtsMap [(FilePath, ByteString)]
ui'
         , Item (Router' Void Void m)
Router' Void Void m
getIndex
         ]
  ]
 where
  ui' :: [(FilePath, ByteString)]
ui' = ((FilePath, ByteString) -> (FilePath, ByteString))
-> [(FilePath, ByteString)] -> [(FilePath, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> FilePath)
-> (FilePath, ByteString) -> (FilePath, ByteString)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'))) [(FilePath, ByteString)]
ui
  getIndex :: Router' Void Void m
getIndex = ByteString
-> (DelayedArgs '[]
    ~> m (AddHeaders
            '[AddHeader "Content-Type" RawHeaderValue] LazyBytes))
-> Router' Void Void m
forall o (m :: * -> *) ts i (st :: [*]).
(HandleArgs ts st m, ToResponse m o, CanRespond o,
 Introspection i 'Response o) =>
ByteString -> (DelayedArgs st ~> m o) -> Router' i ts m
handle ByteString
GET do
    AddHeaders '[AddHeader "Content-Type" RawHeaderValue] LazyBytes
-> m (AddHeaders
        '[AddHeader "Content-Type" RawHeaderValue] LazyBytes)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddHeaders '[AddHeader "Content-Type" RawHeaderValue] LazyBytes
 -> m (AddHeaders
         '[AddHeader "Content-Type" RawHeaderValue] LazyBytes))
-> AddHeaders '[AddHeader "Content-Type" RawHeaderValue] LazyBytes
-> m (AddHeaders
        '[AddHeader "Content-Type" RawHeaderValue] LazyBytes)
forall a b. (a -> b) -> a -> b
$
      Header.AddHeaders
        { $sel:headers:AddHeaders :: HList '[AddHeader "Content-Type" RawHeaderValue]
headers = forall {k} (name :: k) a. a -> AddHeader name a
forall (name :: Symbol) a. a -> AddHeader name a
Header.AddHeader @"Content-Type" (ByteString -> RawHeaderValue
Header.RawHeaderValue ByteString
"text/html") AddHeader "Content-Type" RawHeaderValue
-> HList '[] -> HList '[AddHeader "Content-Type" RawHeaderValue]
forall t (ts1 :: [*]). t -> HList ts1 -> HList (t : ts1)
:# HList '[]
HNil
        , $sel:body:AddHeaders :: LazyBytes
body = ByteString -> LazyBytes
LazyBytes ByteString
index
        }

  index :: ByteString
index =
    Text
indexTemplate
      Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"SWAGGER_UI_SCHEMA" (FilePath -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece FilePath
openapi3File)
      Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"SWAGGER_UI_DIR" (FilePath -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece FilePath
staticDir)
      Text -> (Text -> Markup) -> Markup
forall a b. a -> (a -> b) -> b
& Text -> Markup
forall a. ToMarkup a => a -> Markup
preEscapedToMarkup
      Markup -> (Markup -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& Markup -> ByteString
renderHtml

generateOpenApi3 :: forall m ts. Router' OpenApi3 ts m -> OpenApi
generateOpenApi3 :: forall (m :: * -> *) ts. Router' OpenApi3 ts m -> OpenApi
generateOpenApi3 = \case
  Capture @a MakeError -> Text -> m a
_ Text
pname Router' OpenApi3 (ts :+ WithPiece a) m
r ->
    Router' OpenApi3 (ts :+ WithPiece a) m -> OpenApi
forall (m :: * -> *) ts. Router' OpenApi3 ts m -> OpenApi
generateOpenApi3 Router' OpenApi3 (ts :+ WithPiece a) m
r OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& forall a. ToParamSchema a => Text -> OpenApi -> OpenApi
openapi3Capture @a Text
pname
  Captures @a MakeError -> [Text] -> m [a]
_ Text
pname Router' OpenApi3 (ts :+ WithPieces a) m
r ->
    Router' OpenApi3 (ts :+ WithPieces a) m -> OpenApi
forall (m :: * -> *) ts. Router' OpenApi3 ts m -> OpenApi
generateOpenApi3 Router' OpenApi3 (ts :+ WithPieces a) m
r OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& forall a. ToParamSchema a => Text -> OpenApi -> OpenApi
openapi3Capture @a Text
pname
  Header @a @presence HeaderName
hname MakeError -> [ByteString] -> m (Arg presence parsing a)
_ Router' OpenApi3 (ts :+ WithHeader presence parsing m a) m
r ->
    Router' OpenApi3 (ts :+ WithHeader presence parsing m a) m
-> OpenApi
forall (m :: * -> *) ts. Router' OpenApi3 ts m -> OpenApi
generateOpenApi3 Router' OpenApi3 (ts :+ WithHeader presence parsing m a) m
r OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& forall {k} (presence :: k) a.
(IsRequired presence, ToParamSchema a) =>
HeaderName -> OpenApi -> OpenApi
forall presence a.
(IsRequired presence, ToParamSchema a) =>
HeaderName -> OpenApi -> OpenApi
opeanapi3Header @presence @a HeaderName
hname
  Request @r ErrorBuilder -> Request -> m r
_ Router' OpenApi3 (ts :+ WithReq m r) m
r -> Router' OpenApi3 (ts :+ WithReq m r) m -> OpenApi
forall (m :: * -> *) ts. Router' OpenApi3 ts m -> OpenApi
generateOpenApi3 Router' OpenApi3 (ts :+ WithReq m r) m
r OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& forall a. AttachRequestSchema a => OpenApi -> OpenApi
forall {k} (a :: k). AttachRequestSchema a => OpenApi -> OpenApi
attachRequestSchema @r
  HideIntrospection Router' i1 ts m
_ -> OpenApi
forall a. Monoid a => a
mempty
  Piece Text
path Router' OpenApi3 ts m
r -> FilePath -> OpenApi -> OpenApi
prependPath (Text -> FilePath
Text.unpack Text
path) (Router' OpenApi3 ts m -> OpenApi
forall (m :: * -> *) ts. Router' OpenApi3 ts m -> OpenApi
generateOpenApi3 Router' OpenApi3 ts m
r)
  Middleware MiddlewareM m
_ Router' OpenApi3 ts m
r -> Router' OpenApi3 ts m -> OpenApi
forall (m :: * -> *) ts. Router' OpenApi3 ts m -> OpenApi
generateOpenApi3 Router' OpenApi3 ts m
r
  Alt [Router' OpenApi3 ts m]
rs -> (Router' OpenApi3 ts m -> OpenApi)
-> [Router' OpenApi3 ts m] -> OpenApi
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Router' OpenApi3 ts m -> OpenApi
forall (m :: * -> *) ts. Router' OpenApi3 ts m -> OpenApi
generateOpenApi3 [Router' OpenApi3 ts m]
rs
  MapArgs RHList ts -> RHList ts'
_ Router' OpenApi3 ts' m
r -> Router' OpenApi3 ts' m -> OpenApi
forall (m :: * -> *) ts. Router' OpenApi3 ts m -> OpenApi
generateOpenApi3 Router' OpenApi3 ts' m
r
  Description (desc -> OpenApi3Description
forall a. IsOpenApi3Description a => a -> OpenApi3Description
toOpenApi3Description -> OpenApi3Description
desc) Router' OpenApi3 ts m
r -> case OpenApi3Description
desc of
    DescriptionText Text
txt -> Router' OpenApi3 ts m -> OpenApi
forall (m :: * -> *) ts. Router' OpenApi3 ts m -> OpenApi
generateOpenApi3 Router' OpenApi3 ts m
r 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 Text
txt Maybe Text -> Maybe Text -> Maybe Text
forall a. Semigroup a => a -> a -> a
<>)
    SummaryText Text
txt -> Router' OpenApi3 ts m -> OpenApi
forall (m :: * -> *) ts. Router' OpenApi3 ts m -> OpenApi
generateOpenApi3 Router' OpenApi3 ts m
r 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 Text
txt Maybe Text -> Maybe Text -> Maybe Text
forall a. Semigroup a => a -> a -> a
<>)
  QueryParam @a @presence ByteString
bname MakeError -> Maybe (Maybe ByteString) -> m (Arg presence parsing a)
_ Router' OpenApi3 (ts :+ WithQueryParam presence parsing m a) m
r -> Router' OpenApi3 (ts :+ WithQueryParam presence parsing m a) m
-> OpenApi
forall (m :: * -> *) ts. Router' OpenApi3 ts m -> OpenApi
generateOpenApi3 Router' OpenApi3 (ts :+ WithQueryParam presence parsing m a) m
r OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& forall {k} (presence :: k) a.
(IsRequired presence, ToParamSchema a) =>
ByteString -> OpenApi -> OpenApi
forall presence a.
(IsRequired presence, ToParamSchema a) =>
ByteString -> OpenApi -> OpenApi
openapi3QueryParam @presence @a ByteString
bname
  Handle @o ByteString
httpMethod HList (DelayedArgs st) -> m o
_ ->
    let
      method :: Lens' PathItem (Maybe Operation)
      method :: Lens' PathItem (Maybe Operation)
method = case ByteString
httpMethod of
        ByteString
"GET" -> (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasGet s a => Lens' s a
Lens' PathItem (Maybe Operation)
get
        ByteString
"POST" -> (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasPost s a => Lens' s a
Lens' PathItem (Maybe Operation)
post
        ByteString
"PATCH" -> (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasPatch s a => Lens' s a
Lens' PathItem (Maybe Operation)
patch
        ByteString
"DELETE" -> (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasDelete s a => Lens' s a
Lens' PathItem (Maybe Operation)
delete
        ByteString
"PUT" -> (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasPut s a => Lens' s a
Lens' PathItem (Maybe Operation)
put
        ByteString
"TRACE" -> (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasTrace s a => Lens' s a
Lens' PathItem (Maybe Operation)
trace
        ByteString
"OPTIONS" -> (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasOptions s a => Lens' s a
Lens' PathItem (Maybe Operation)
options
        ByteString
"HEAD" -> (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasHead s a => Lens' s a
Lens' PathItem (Maybe Operation)
head_
        ByteString
_ -> (PathItem -> Maybe Operation)
-> (PathItem -> Maybe Operation -> PathItem)
-> Lens' PathItem (Maybe Operation)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (Maybe Operation -> PathItem -> Maybe Operation
forall a b. a -> b -> a
const Maybe Operation
forall a. Maybe a
Nothing) PathItem -> Maybe Operation -> PathItem
forall a b. a -> b -> a
const
      (Responses
resp, Definitions Schema
defs) = forall a. ToResponses a => (Responses, Definitions Schema)
forall {k} (a :: k).
ToResponses a =>
(Responses, Definitions Schema)
toResponses @o
     in
      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 Index (InsOrdHashMap FilePath PathItem)
"/" ((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
Lens' PathItem (Maybe Operation)
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{_operationResponses = resp}))
        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

openapi3QueryParam :: forall presence a. (IsRequired presence, ToParamSchema a) => Bytes.ByteString -> OpenApi -> OpenApi
openapi3QueryParam :: forall {k} (presence :: k) a.
(IsRequired presence, ToParamSchema a) =>
ByteString -> OpenApi -> OpenApi
openapi3QueryParam ByteString
bname = Param -> OpenApi -> OpenApi
addParam Param
param (OpenApi -> OpenApi) -> (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> OpenApi -> OpenApi
addDefaultResponse400 Text
tname
 where
  tname :: Text
tname = ByteString -> Text
Text.decodeUtf8 ByteString
bname
  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 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
?~ forall (a :: k). IsRequired a => Bool
forall {k} (a :: k). IsRequired a => Bool
isRequired @presence
      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 (Proxy a -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a))

openapi3Capture :: forall a. (ToParamSchema a) => Text -> OpenApi -> OpenApi
openapi3Capture :: forall a. ToParamSchema a => Text -> OpenApi -> OpenApi
openapi3Capture Text
tname =
  Param -> OpenApi -> OpenApi
addParam Param
param
    (OpenApi -> OpenApi) -> (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> FilePath -> OpenApi -> OpenApi
prependPath FilePath
capture_
    (OpenApi -> OpenApi) -> (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> OpenApi -> OpenApi
addDefaultResponse404 Text
tname
 where
  sname :: FilePath
sname = Text -> FilePath
Text.unpack Text
tname
  capture_ :: FilePath
capture_ = FilePath
"{" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
sname 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 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))

opeanapi3Header :: forall presence a. (IsRequired presence, ToParamSchema a) => Http.HeaderName -> OpenApi -> OpenApi
opeanapi3Header :: forall {k} (presence :: k) a.
(IsRequired presence, ToParamSchema a) =>
HeaderName -> OpenApi -> OpenApi
opeanapi3Header HeaderName
hname =
  Param -> OpenApi -> OpenApi
addParam Param
param
    (OpenApi -> OpenApi) -> (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> OpenApi -> OpenApi
addDefaultResponse400 Text
tname
 where
  tname :: Text
tname = ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ HeaderName -> ByteString
forall s. CI s -> s
CI.original HeaderName
hname
  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 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
?~ forall (a :: k). IsRequired a => Bool
forall {k} (a :: k). IsRequired a => Bool
isRequired @presence
      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 (Proxy a -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a))

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]
:)

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

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
"`"