{-# OPTIONS_GHC -Wno-orphans #-}

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

import Data.Proxy (Proxy (..))
import Data.String (fromString)
import Data.Swagger
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.Swagger.Handler (DocNode (DocSecurityScheme), SwaggerHandler (..), singletonNode)

instance (TraitAbsence (BasicAuth' x scheme m e a) Request, KnownSymbol scheme) => Get (SwaggerHandler m) (BasicAuth' x scheme m e a) Request where
  {-# INLINE getTrait #-}
  getTrait ::
    BasicAuth' x scheme m e a ->
    SwaggerHandler 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
-> SwaggerHandler
     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" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @scheme))
        securityScheme :: SecurityScheme
securityScheme =
          SecurityScheme
            { _securitySchemeType :: SecuritySchemeType
_securitySchemeType = SecuritySchemeType
SecuritySchemeBasic
            , _securitySchemeDescription :: Maybe Text
_securitySchemeDescription = forall a. Maybe a
Nothing
            }
     in forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler forall a b. (a -> b) -> a -> b
$ forall a. a -> Tree a
singletonNode (Text -> SecurityScheme -> DocNode
DocSecurityScheme Text
schemeName SecurityScheme
securityScheme)