{-# OPTIONS_GHC -Wno-orphans #-}

-- | OpenApi implementation of 'Header' trait.
module WebGear.OpenApi.Trait.Header () where

import Control.Lens ((%~), (&), (.~), (<>~), (?~))
import Control.Monad.State.Strict (MonadState)
import qualified Data.HashMap.Strict.InsOrd as Map
import Data.OpenApi (
  Header,
  HeaderName,
  OpenApi,
  Param,
  ParamLocation (..),
  Referenced (..),
  Response,
  ToSchema,
  allOperations,
  description,
  headers,
  in_,
  name,
  parameters,
  required,
  responses,
  schema,
  toSchema,
 )
import Data.OpenApi.Internal.Utils (swaggerMappend)
import Data.Proxy (Proxy (Proxy))
import Data.String (fromString)
import Data.Text (Text)
import GHC.TypeLits (KnownSymbol, symbolVal)
import WebGear.Core.Handler (Description (..))
import WebGear.Core.Modifiers (Existence (..))
import WebGear.Core.Trait (Get (..), Set (..))
import qualified WebGear.Core.Trait.Header as WG
import WebGear.OpenApi.Handler (Documentation, OpenApiHandler (..), consumeDescription)

instance (KnownSymbol name, ToSchema val) => Get (OpenApiHandler m) (WG.RequestHeader Required ps name val) where
  {-# INLINE getTrait #-}
  getTrait :: forall (ts :: [*]).
Prerequisite (RequestHeader 'Required ps name val) ts =>
RequestHeader 'Required ps name val
-> OpenApiHandler
     m
     (With Request ts)
     (Either
        (Absence (RequestHeader 'Required ps name val))
        (Attribute (RequestHeader 'Required ps name val) Request))
getTrait RequestHeader 'Required ps name val
WG.RequestHeader = (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler
     m
     (With Request ts)
     (Either
        (Absence (RequestHeader 'Required ps name val))
        (Attribute (RequestHeader 'Required ps name val) Request))
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
(OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
OpenApiHandler ((OpenApi -> State Documentation OpenApi)
 -> OpenApiHandler
      m
      (With Request ts)
      (Either
         (Absence (RequestHeader 'Required ps name val))
         (Attribute (RequestHeader 'Required ps name val) Request)))
-> (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler
     m
     (With Request ts)
     (Either
        (Absence (RequestHeader 'Required ps name val))
        (Attribute (RequestHeader 'Required ps name val) Request))
forall a b. (a -> b) -> a -> b
$ Proxy name
-> Proxy val -> Bool -> OpenApi -> State Documentation OpenApi
forall (name :: Symbol) val (m :: * -> *).
(KnownSymbol name, ToSchema val, MonadState Documentation m) =>
Proxy name -> Proxy val -> Bool -> OpenApi -> m OpenApi
addRequestHeader (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @val) Bool
True

instance (KnownSymbol name, ToSchema val) => Get (OpenApiHandler m) (WG.RequestHeader Optional ps name val) where
  {-# INLINE getTrait #-}
  getTrait :: forall (ts :: [*]).
Prerequisite (RequestHeader 'Optional ps name val) ts =>
RequestHeader 'Optional ps name val
-> OpenApiHandler
     m
     (With Request ts)
     (Either
        (Absence (RequestHeader 'Optional ps name val))
        (Attribute (RequestHeader 'Optional ps name val) Request))
getTrait RequestHeader 'Optional ps name val
WG.RequestHeader = (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler
     m
     (With Request ts)
     (Either
        (Absence (RequestHeader 'Optional ps name val))
        (Attribute (RequestHeader 'Optional ps name val) Request))
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
(OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
OpenApiHandler ((OpenApi -> State Documentation OpenApi)
 -> OpenApiHandler
      m
      (With Request ts)
      (Either
         (Absence (RequestHeader 'Optional ps name val))
         (Attribute (RequestHeader 'Optional ps name val) Request)))
-> (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler
     m
     (With Request ts)
     (Either
        (Absence (RequestHeader 'Optional ps name val))
        (Attribute (RequestHeader 'Optional ps name val) Request))
forall a b. (a -> b) -> a -> b
$ Proxy name
-> Proxy val -> Bool -> OpenApi -> State Documentation OpenApi
forall (name :: Symbol) val (m :: * -> *).
(KnownSymbol name, ToSchema val, MonadState Documentation m) =>
Proxy name -> Proxy val -> Bool -> OpenApi -> m OpenApi
addRequestHeader (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @val) Bool
False

instance (KnownSymbol name, ToSchema val) => Set (OpenApiHandler m) (WG.ResponseHeader Required name val) where
  {-# INLINE setTrait #-}
  setTrait :: forall (ts :: [*]).
ResponseHeader 'Required name val
-> (With Response ts
    -> Response
    -> Attribute (ResponseHeader 'Required name val) Response
    -> With Response (ResponseHeader 'Required name val : ts))
-> OpenApiHandler
     m
     (With Response ts,
      Attribute (ResponseHeader 'Required name val) Response)
     (With Response (ResponseHeader 'Required name val : ts))
setTrait ResponseHeader 'Required name val
WG.ResponseHeader With Response ts
-> Response
-> Attribute (ResponseHeader 'Required name val) Response
-> With Response (ResponseHeader 'Required name val : ts)
_ = (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler
     m
     (With Response ts,
      Attribute (ResponseHeader 'Required name val) Response)
     (With Response (ResponseHeader 'Required name val : ts))
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
(OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
OpenApiHandler ((OpenApi -> State Documentation OpenApi)
 -> OpenApiHandler
      m
      (With Response ts,
       Attribute (ResponseHeader 'Required name val) Response)
      (With Response (ResponseHeader 'Required name val : ts)))
-> (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler
     m
     (With Response ts,
      Attribute (ResponseHeader 'Required name val) Response)
     (With Response (ResponseHeader 'Required name val : ts))
forall a b. (a -> b) -> a -> b
$ Proxy name
-> Proxy val -> Bool -> OpenApi -> State Documentation OpenApi
forall (name :: Symbol) val (m :: * -> *).
(KnownSymbol name, ToSchema val, MonadState Documentation m) =>
Proxy name -> Proxy val -> Bool -> OpenApi -> m OpenApi
addResponseHeader (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @val) Bool
True

instance (KnownSymbol name, ToSchema val) => Set (OpenApiHandler m) (WG.ResponseHeader Optional name val) where
  {-# INLINE setTrait #-}
  setTrait :: forall (ts :: [*]).
ResponseHeader 'Optional name val
-> (With Response ts
    -> Response
    -> Attribute (ResponseHeader 'Optional name val) Response
    -> With Response (ResponseHeader 'Optional name val : ts))
-> OpenApiHandler
     m
     (With Response ts,
      Attribute (ResponseHeader 'Optional name val) Response)
     (With Response (ResponseHeader 'Optional name val : ts))
setTrait ResponseHeader 'Optional name val
WG.ResponseHeader With Response ts
-> Response
-> Attribute (ResponseHeader 'Optional name val) Response
-> With Response (ResponseHeader 'Optional name val : ts)
_ = (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler
     m
     (With Response ts,
      Attribute (ResponseHeader 'Optional name val) Response)
     (With Response (ResponseHeader 'Optional name val : ts))
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
(OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
OpenApiHandler ((OpenApi -> State Documentation OpenApi)
 -> OpenApiHandler
      m
      (With Response ts,
       Attribute (ResponseHeader 'Optional name val) Response)
      (With Response (ResponseHeader 'Optional name val : ts)))
-> (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler
     m
     (With Response ts,
      Attribute (ResponseHeader 'Optional name val) Response)
     (With Response (ResponseHeader 'Optional name val : ts))
forall a b. (a -> b) -> a -> b
$ Proxy name
-> Proxy val -> Bool -> OpenApi -> State Documentation OpenApi
forall (name :: Symbol) val (m :: * -> *).
(KnownSymbol name, ToSchema val, MonadState Documentation m) =>
Proxy name -> Proxy val -> Bool -> OpenApi -> m OpenApi
addResponseHeader (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @val) Bool
False

addRequestHeader ::
  forall name val m.
  (KnownSymbol name, ToSchema val, MonadState Documentation m) =>
  Proxy name ->
  Proxy val ->
  Bool ->
  OpenApi ->
  m OpenApi
addRequestHeader :: forall (name :: Symbol) val (m :: * -> *).
(KnownSymbol name, ToSchema val, MonadState Documentation m) =>
Proxy name -> Proxy val -> Bool -> OpenApi -> m OpenApi
addRequestHeader Proxy name
_ Proxy val
_ Bool
isRequired OpenApi
doc = do
  Maybe Description
desc <- m (Maybe Description)
forall (m :: * -> *).
MonadState Documentation m =>
m (Maybe Description)
consumeDescription
  let param :: Param
param =
        (Param
forall a. Monoid a => a
mempty :: Param)
          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
.~ forall a. IsString a => String -> a
fromString @Text (Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name -> String) -> Proxy name -> String
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name)
          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 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
isRequired
          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 val -> Schema
forall a. ToSchema a => Proxy a -> Schema
toSchema (Proxy val -> Schema) -> Proxy val -> Schema
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @val)
          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
.~ (Description -> Text) -> Maybe Description -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Description -> Text
getDescription Maybe Description
desc
  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
$ OpenApi
doc 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)
-> (([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] -> OpenApi -> OpenApi
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [Param -> Referenced Param
forall a. a -> Referenced a
Inline Param
param]

addResponseHeader ::
  forall name val m.
  (KnownSymbol name, ToSchema val, MonadState Documentation m) =>
  Proxy name ->
  Proxy val ->
  Bool ->
  OpenApi ->
  m OpenApi
addResponseHeader :: forall (name :: Symbol) val (m :: * -> *).
(KnownSymbol name, ToSchema val, MonadState Documentation m) =>
Proxy name -> Proxy val -> Bool -> OpenApi -> m OpenApi
addResponseHeader Proxy name
_ Proxy val
_ Bool
isRequired OpenApi
doc = do
  Maybe Description
desc <- m (Maybe Description)
forall (m :: * -> *).
MonadState Documentation m =>
m (Maybe Description)
consumeDescription
  let headerName :: Text
headerName = forall a. IsString a => String -> a
fromString @HeaderName (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name -> String) -> Proxy name -> String
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name
      header :: Header
header =
        forall a. Monoid a => a
mempty @Header
          Header -> (Header -> Header) -> Header
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool)) -> Header -> Identity Header
forall s a. HasRequired s a => Lens' s a
Lens' Header (Maybe Bool)
required ((Maybe Bool -> Identity (Maybe Bool))
 -> Header -> Identity Header)
-> Bool -> Header -> Header
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
isRequired
          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
?~ Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Proxy val -> Schema
forall a. ToSchema a => Proxy a -> Schema
toSchema (Proxy val -> Schema) -> Proxy val -> Schema
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @val)
          Header -> (Header -> Header) -> Header
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Header -> Identity Header
forall s a. HasDescription s a => Lens' s a
Lens' Header (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> Header -> Identity Header)
-> Maybe Text -> Header -> Header
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Description -> Text) -> Maybe Description -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Description -> Text
getDescription Maybe Description
desc
      resp :: Response
resp = forall a. Monoid a => a
mempty @Response 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 a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [(Text
headerName, Header -> Referenced Header
forall a. a -> Referenced a
Inline Header
header)]
  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
$
    if Text
headerName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Content-Type"
      then OpenApi
doc
      else OpenApi
doc 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)
-> ((InsOrdHashMap HttpStatusCode (Referenced Response)
     -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
    -> Operation -> Identity Operation)
-> (InsOrdHashMap HttpStatusCode (Referenced Response)
    -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Responses -> Identity Responses)
-> Operation -> Identity Operation
forall s a. HasResponses s a => Lens' s a
Lens' Operation Responses
responses ((Responses -> Identity Responses)
 -> Operation -> Identity Operation)
-> ((InsOrdHashMap HttpStatusCode (Referenced Response)
     -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
    -> Responses -> Identity Responses)
-> (InsOrdHashMap HttpStatusCode (Referenced Response)
    -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
-> Operation
-> Identity Operation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InsOrdHashMap HttpStatusCode (Referenced Response)
 -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
-> Responses -> Identity Responses
forall s a. HasResponses s a => Lens' s a
Lens'
  Responses (InsOrdHashMap HttpStatusCode (Referenced Response))
responses ((InsOrdHashMap HttpStatusCode (Referenced Response)
  -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
 -> OpenApi -> Identity OpenApi)
-> (InsOrdHashMap HttpStatusCode (Referenced Response)
    -> InsOrdHashMap HttpStatusCode (Referenced Response))
-> OpenApi
-> OpenApi
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Referenced Response -> Referenced Response)
-> InsOrdHashMap HttpStatusCode (Referenced Response)
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall v1 v2 k.
(v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2
Map.map (Referenced Response -> Referenced Response -> Referenced Response
forall m. SwaggerMonoid m => m -> m -> m
`swaggerMappend` Response -> Referenced Response
forall a. a -> Referenced a
Inline Response
resp)