{-# OPTIONS_GHC -Wno-orphans #-}

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

import Control.Lens ((&), (.~), (?~))
import Data.OpenApi hiding (Response)
import Data.Proxy (Proxy (Proxy))
import Data.String (fromString)
import Data.Text (Text)
import GHC.TypeLits (KnownSymbol, symbolVal)
import WebGear.Core.Modifiers (Existence (..))
import WebGear.Core.Request (Request)
import WebGear.Core.Response (Response)
import WebGear.Core.Trait (Get (..), Set (..), Trait, TraitAbsence)
import qualified WebGear.Core.Trait.Header as WG
import WebGear.OpenApi.Handler (DocNode (..), OpenApiHandler (..), nullNode, singletonNode)

mkParam ::
  forall name val.
  (KnownSymbol name, ToSchema val) =>
  Proxy name ->
  Proxy val ->
  Bool ->
  Param
mkParam :: Proxy name -> Proxy val -> Bool -> Param
mkParam Proxy name
_ Proxy val
_ Bool
isRequired =
  (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
name ((Text -> Identity Text) -> Param -> Identity Param)
-> Text -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String -> Text
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
$ Proxy name
forall k (t :: k). 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
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
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
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
$ Proxy val
forall k (t :: k). Proxy t
Proxy @val)

instance (KnownSymbol name, ToSchema val, TraitAbsence (WG.Header Required ps name val) Request) => Get (OpenApiHandler m) (WG.Header Required ps name val) Request where
  {-# INLINEABLE getTrait #-}
  getTrait :: Header 'Required ps name val
-> OpenApiHandler
     m
     (Linked ts Request)
     (Either
        (Absence (Header 'Required ps name val) Request)
        (Attribute (Header 'Required ps name val) Request))
getTrait Header 'Required ps name val
WG.Header =
    Tree DocNode
-> OpenApiHandler
     m
     (Linked ts Request)
     (Either
        (Absence (Header 'Required ps name val) Request)
        (Attribute (Header 'Required ps name val) Request))
forall k k k (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode
 -> OpenApiHandler
      m
      (Linked ts Request)
      (Either
         (Absence (Header 'Required ps name val) Request)
         (Attribute (Header 'Required ps name val) Request)))
-> Tree DocNode
-> OpenApiHandler
     m
     (Linked ts Request)
     (Either
        (Absence (Header 'Required ps name val) Request)
        (Attribute (Header 'Required ps name val) Request))
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
forall a. a -> Tree a
singletonNode (Param -> DocNode
DocRequestHeader (Param -> DocNode) -> Param -> DocNode
forall a b. (a -> b) -> a -> b
$ Proxy name -> Proxy val -> Bool -> Param
forall (name :: Symbol) val.
(KnownSymbol name, ToSchema val) =>
Proxy name -> Proxy val -> Bool -> Param
mkParam (Proxy name
forall k (t :: k). Proxy t
Proxy @name) (Proxy val
forall k (t :: k). Proxy t
Proxy @val) Bool
True)

instance (KnownSymbol name, ToSchema val, TraitAbsence (WG.Header Optional ps name val) Request) => Get (OpenApiHandler m) (WG.Header Optional ps name val) Request where
  {-# INLINEABLE getTrait #-}
  getTrait :: Header 'Optional ps name val
-> OpenApiHandler
     m
     (Linked ts Request)
     (Either
        (Absence (Header 'Optional ps name val) Request)
        (Attribute (Header 'Optional ps name val) Request))
getTrait Header 'Optional ps name val
WG.Header =
    Tree DocNode
-> OpenApiHandler
     m
     (Linked ts Request)
     (Either
        (Absence (Header 'Optional ps name val) Request)
        (Attribute (Header 'Optional ps name val) Request))
forall k k k (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode
 -> OpenApiHandler
      m
      (Linked ts Request)
      (Either
         (Absence (Header 'Optional ps name val) Request)
         (Attribute (Header 'Optional ps name val) Request)))
-> Tree DocNode
-> OpenApiHandler
     m
     (Linked ts Request)
     (Either
        (Absence (Header 'Optional ps name val) Request)
        (Attribute (Header 'Optional ps name val) Request))
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
forall a. a -> Tree a
singletonNode (Param -> DocNode
DocRequestHeader (Param -> DocNode) -> Param -> DocNode
forall a b. (a -> b) -> a -> b
$ Proxy name -> Proxy val -> Bool -> Param
forall (name :: Symbol) val.
(KnownSymbol name, ToSchema val) =>
Proxy name -> Proxy val -> Bool -> Param
mkParam (Proxy name
forall k (t :: k). Proxy t
Proxy @name) (Proxy val
forall k (t :: k). Proxy t
Proxy @val) Bool
False)

instance (KnownSymbol name, ToSchema val, Trait (WG.Header Required ps name val) Response) => Set (OpenApiHandler m) (WG.Header Required ps name val) Response where
  {-# INLINEABLE setTrait #-}
  setTrait :: Header 'Required ps name val
-> (Linked ts Response
    -> Response
    -> Attribute (Header 'Required ps name val) Response
    -> Linked (Header 'Required ps name val : ts) Response)
-> OpenApiHandler
     m
     (Linked ts Response,
      Attribute (Header 'Required ps name val) Response)
     (Linked (Header 'Required ps name val : ts) Response)
setTrait Header 'Required ps name val
WG.Header Linked ts Response
-> Response
-> Attribute (Header 'Required ps name val) Response
-> Linked (Header 'Required ps name val : ts) Response
_ =
    let headerName :: Text
headerName = String -> Text
forall a. IsString a => String -> a
fromString (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
$ Proxy name
forall k (t :: k). Proxy t
Proxy @name
        header :: Header
header =
          Monoid 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
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
True
            Header -> (Header -> Header) -> Header
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> Header -> Identity Header
forall s a. HasSchema s a => Lens' s a
schema ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> Header -> Identity Header)
-> Referenced Schema -> Header -> Header
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ 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
$ Proxy val
forall k (t :: k). Proxy t
Proxy @val)
     in if Text
headerName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Content-Type"
          then Tree DocNode
-> OpenApiHandler
     m
     (Linked ts Response,
      Attribute (Header 'Required ps name val) Response)
     (Linked (Header 'Required ps name val : ts) Response)
forall k k k (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler Tree DocNode
forall a. Tree a
nullNode
          else Tree DocNode
-> OpenApiHandler
     m
     (Linked ts Response,
      Attribute (Header 'Required ps name val) Response)
     (Linked (Header 'Required ps name val : ts) Response)
forall k k k (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode
 -> OpenApiHandler
      m
      (Linked ts Response,
       Attribute (Header 'Required ps name val) Response)
      (Linked (Header 'Required ps name val : ts) Response))
-> Tree DocNode
-> OpenApiHandler
     m
     (Linked ts Response,
      Attribute (Header 'Required ps name val) Response)
     (Linked (Header 'Required ps name val : ts) Response)
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
forall a. a -> Tree a
singletonNode (Text -> Header -> DocNode
DocResponseHeader Text
headerName Header
header)

instance (KnownSymbol name, ToSchema val, Trait (WG.Header Optional ps name val) Response) => Set (OpenApiHandler m) (WG.Header Optional ps name val) Response where
  {-# INLINEABLE setTrait #-}
  setTrait :: Header 'Optional ps name val
-> (Linked ts Response
    -> Response
    -> Attribute (Header 'Optional ps name val) Response
    -> Linked (Header 'Optional ps name val : ts) Response)
-> OpenApiHandler
     m
     (Linked ts Response,
      Attribute (Header 'Optional ps name val) Response)
     (Linked (Header 'Optional ps name val : ts) Response)
setTrait Header 'Optional ps name val
WG.Header Linked ts Response
-> Response
-> Attribute (Header 'Optional ps name val) Response
-> Linked (Header 'Optional ps name val : ts) Response
_ =
    let headerName :: Text
headerName = String -> Text
forall a. IsString a => String -> a
fromString (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
$ Proxy name
forall k (t :: k). Proxy t
Proxy @name
        header :: Header
header =
          Monoid 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
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
True
            Header -> (Header -> Header) -> Header
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> Header -> Identity Header
forall s a. HasSchema s a => Lens' s a
schema ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> Header -> Identity Header)
-> Referenced Schema -> Header -> Header
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ 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
$ Proxy val
forall k (t :: k). Proxy t
Proxy @val)
     in Tree DocNode
-> OpenApiHandler
     m
     (Linked ts Response,
      Attribute (Header 'Optional ps name val) Response)
     (Linked (Header 'Optional ps name val : ts) Response)
forall k k k (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode
 -> OpenApiHandler
      m
      (Linked ts Response,
       Attribute (Header 'Optional ps name val) Response)
      (Linked (Header 'Optional ps name val : ts) Response))
-> Tree DocNode
-> OpenApiHandler
     m
     (Linked ts Response,
      Attribute (Header 'Optional ps name val) Response)
     (Linked (Header 'Optional ps name val : ts) Response)
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
forall a. a -> Tree a
singletonNode (Text -> Header -> DocNode
DocResponseHeader Text
headerName Header
header)