{-# OPTIONS_GHC -Wno-orphans #-}

-- | Swagger implementation of 'JWTAuth'' trait.
module WebGear.Swagger.Trait.Auth.JWT where

import Data.String (fromString)
import Data.Swagger
import Data.Typeable (Proxy (..))
import GHC.TypeLits (KnownSymbol, symbolVal)
import WebGear.Core.Request (Request)
import WebGear.Core.Trait (Attribute, Get (..), TraitAbsence (..), With)
import WebGear.Core.Trait.Auth.JWT (JWTAuth' (..))
import WebGear.Swagger.Handler (DocNode (DocSecurityScheme), SwaggerHandler (..), singletonNode)

instance
  (TraitAbsence (JWTAuth' x scheme m e a) Request, KnownSymbol scheme) =>
  Get (SwaggerHandler m) (JWTAuth' x scheme m e a) Request
  where
  {-# INLINE getTrait #-}
  getTrait ::
    JWTAuth' x scheme m e a ->
    SwaggerHandler m (Request `With` ts) (Either (Absence (JWTAuth' x scheme m e a) Request) (Attribute (JWTAuth' x scheme m e a) Request))
  getTrait :: forall (ts :: [*]).
JWTAuth' x scheme m e a
-> SwaggerHandler
     m
     (With Request ts)
     (Either
        (Absence (JWTAuth' x scheme m e a) Request)
        (Attribute (JWTAuth' x scheme m e a) Request))
getTrait JWTAuth' x scheme m e a
_ =
    let schemeName :: Text
schemeName = 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))
        -- Swagger 2.0 does not support JWT: https://stackoverflow.com/a/32995636
        securityScheme :: SecurityScheme
securityScheme =
          SecurityScheme
            { _securitySchemeType :: SecuritySchemeType
_securitySchemeType =
                ApiKeyParams -> SecuritySchemeType
SecuritySchemeApiKey
                  ( ApiKeyParams
                      { _apiKeyName :: Text
_apiKeyName = Text
"JWT"
                      , _apiKeyIn :: ApiKeyLocation
_apiKeyIn = ApiKeyLocation
ApiKeyHeader
                      }
                  )
            , _securitySchemeDescription :: Maybe Text
_securitySchemeDescription = forall a. a -> Maybe a
Just (Text
"Enter the token with the `" forall a. Semigroup a => a -> a -> a
<> Text
schemeName forall a. Semigroup a => a -> a -> a
<> Text
": ` prefix")
            }
     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)