{-# OPTIONS_GHC -Wno-orphans #-}

-- | OpenApi implementation of `BasicAuth'` trait.
module WebGear.OpenApi.Trait.Auth.Basic where

import Data.OpenApi
import Data.Proxy (Proxy (..))
import Data.String (fromString)
import GHC.TypeLits (KnownSymbol, symbolVal)
import WebGear.Core.Request (Request)
import WebGear.Core.Trait (Attribute, Get (..), TraitAbsence (Absence), With)
import WebGear.Core.Trait.Auth.Basic (BasicAuth' (..))
import WebGear.OpenApi.Handler (DocNode (DocSecurityScheme), OpenApiHandler (..), singletonNode)

instance (TraitAbsence (BasicAuth' x scheme m e a) Request, KnownSymbol scheme) => Get (OpenApiHandler m) (BasicAuth' x scheme m e a) Request where
  {-# INLINE getTrait #-}
  getTrait ::
    BasicAuth' x scheme m e a ->
    OpenApiHandler m (Request `With` ts) (Either (Absence (BasicAuth' x scheme m e a) Request) (Attribute (BasicAuth' x scheme m e a) Request))
  getTrait :: forall (ts :: [*]).
BasicAuth' x scheme m e a
-> OpenApiHandler
     m
     (With Request ts)
     (Either
        (Absence (BasicAuth' x scheme m e a) Request)
        (Attribute (BasicAuth' x scheme m e a) Request))
getTrait BasicAuth' x scheme m e a
_ =
    let schemeName :: Text
schemeName = Text
"http" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString (Proxy scheme -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @scheme))
        securityScheme :: SecurityScheme
securityScheme =
          SecurityScheme
            { _securitySchemeType :: SecuritySchemeType
_securitySchemeType = HttpSchemeType -> SecuritySchemeType
SecuritySchemeHttp HttpSchemeType
HttpSchemeBasic
            , _securitySchemeDescription :: Maybe Text
_securitySchemeDescription = Maybe Text
forall a. Maybe a
Nothing
            }
     in Tree DocNode
-> OpenApiHandler
     m
     (With Request ts)
     (Either
        (Absence (BasicAuth' x scheme m e a) Request)
        (Attribute (BasicAuth' x scheme m e a) Request))
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode
 -> OpenApiHandler
      m
      (With Request ts)
      (Either
         (Absence (BasicAuth' x scheme m e a) Request)
         (Attribute (BasicAuth' x scheme m e a) Request)))
-> Tree DocNode
-> OpenApiHandler
     m
     (With Request ts)
     (Either
        (Absence (BasicAuth' x scheme m e a) Request)
        (Attribute (BasicAuth' x scheme m e a) Request))
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
forall a. a -> Tree a
singletonNode (Text -> SecurityScheme -> DocNode
DocSecurityScheme Text
schemeName SecurityScheme
securityScheme)