{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE CPP #-}
module Servant.Auth.Swagger
(
JWT
, BasicAuth
, Auth
, HasSecurity (..)
) where
import Control.Lens ((&), (<>~))
import Data.Kind (Type)
import Data.Proxy (Proxy (Proxy))
import Data.Swagger (ApiKeyLocation (..), ApiKeyParams (..),
SecurityRequirement (..), SecurityScheme (..),
#if MIN_VERSION_swagger2(2,6,0)
SecurityDefinitions(..),
#endif
SecuritySchemeType (..), allOperations, security,
securityDefinitions)
import GHC.Exts (fromList)
import Servant.API hiding (BasicAuth)
import Servant.Auth
import Servant.Swagger
import qualified Data.Text as T
instance (AllHasSecurity xs, HasSwagger api) => HasSwagger (Auth xs r :> api) where
toSwagger :: Proxy (Auth xs r :> api) -> Swagger
toSwagger Proxy (Auth xs r :> api)
_
= Proxy api -> Swagger
forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy api
forall {k} (t :: k). Proxy t
Proxy :: Proxy api)
Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (SecurityDefinitions -> Identity SecurityDefinitions)
-> Swagger -> Identity Swagger
forall s a. HasSecurityDefinitions s a => Lens' s a
Lens' Swagger SecurityDefinitions
securityDefinitions ((SecurityDefinitions -> Identity SecurityDefinitions)
-> Swagger -> Identity Swagger)
-> SecurityDefinitions -> Swagger -> Swagger
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ Definitions SecurityScheme -> SecurityDefinitions
mkSec ([Item (Definitions SecurityScheme)] -> Definitions SecurityScheme
forall l. IsList l => [Item l] -> l
fromList [(Text, SecurityScheme)]
[Item (Definitions SecurityScheme)]
secs)
Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> Swagger -> Identity Swagger
Traversal' Swagger Operation
allOperations((Operation -> Identity Operation) -> Swagger -> Identity Swagger)
-> (([SecurityRequirement] -> Identity [SecurityRequirement])
-> Operation -> Identity Operation)
-> ([SecurityRequirement] -> Identity [SecurityRequirement])
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([SecurityRequirement] -> Identity [SecurityRequirement])
-> Operation -> Identity Operation
forall s a. HasSecurity s a => Lens' s a
Lens' Operation [SecurityRequirement]
security (([SecurityRequirement] -> Identity [SecurityRequirement])
-> Swagger -> Identity Swagger)
-> [SecurityRequirement] -> Swagger -> Swagger
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [SecurityRequirement]
secReqs
where
secs :: [(Text, SecurityScheme)]
secs = Proxy xs -> [(Text, SecurityScheme)]
forall (x :: [*]).
AllHasSecurity x =>
Proxy x -> [(Text, SecurityScheme)]
securities (Proxy xs
forall {k} (t :: k). Proxy t
Proxy :: Proxy xs)
secReqs :: [SecurityRequirement]
secReqs = [ InsOrdHashMap Text [Text] -> SecurityRequirement
SecurityRequirement ([Item (InsOrdHashMap Text [Text])] -> InsOrdHashMap Text [Text]
forall l. IsList l => [Item l] -> l
fromList [(Text
s,[])]) | (Text
s,SecurityScheme
_) <- [(Text, SecurityScheme)]
secs]
mkSec :: Definitions SecurityScheme -> SecurityDefinitions
mkSec =
#if MIN_VERSION_swagger2(2,6,0)
Definitions SecurityScheme -> SecurityDefinitions
SecurityDefinitions
#else
id
#endif
class HasSecurity x where
securityName :: Proxy x -> T.Text
securityScheme :: Proxy x -> SecurityScheme
instance HasSecurity BasicAuth where
securityName :: Proxy BasicAuth -> Text
securityName Proxy BasicAuth
_ = Text
"BasicAuth"
securityScheme :: Proxy BasicAuth -> SecurityScheme
securityScheme Proxy BasicAuth
_ = SecuritySchemeType -> Maybe Text -> SecurityScheme
SecurityScheme SecuritySchemeType
type_ (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
desc)
where
type_ :: SecuritySchemeType
type_ = SecuritySchemeType
SecuritySchemeBasic
desc :: Text
desc = Text
"Basic access authentication"
instance HasSecurity JWT where
securityName :: Proxy JWT -> Text
securityName Proxy JWT
_ = Text
"JwtSecurity"
securityScheme :: Proxy JWT -> SecurityScheme
securityScheme Proxy JWT
_ = SecuritySchemeType -> Maybe Text -> SecurityScheme
SecurityScheme SecuritySchemeType
type_ (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
desc)
where
type_ :: SecuritySchemeType
type_ = ApiKeyParams -> SecuritySchemeType
SecuritySchemeApiKey (Text -> ApiKeyLocation -> ApiKeyParams
ApiKeyParams Text
"Authorization" ApiKeyLocation
ApiKeyHeader)
desc :: Text
desc = Text
"JSON Web Token-based API key"
class AllHasSecurity (x :: [Type]) where
securities :: Proxy x -> [(T.Text,SecurityScheme)]
instance {-# OVERLAPPABLE #-} (HasSecurity x, AllHasSecurity xs) => AllHasSecurity (x ': xs) where
securities :: Proxy (x : xs) -> [(Text, SecurityScheme)]
securities Proxy (x : xs)
_ = (Proxy x -> Text
forall x. HasSecurity x => Proxy x -> Text
securityName Proxy x
px, Proxy x -> SecurityScheme
forall x. HasSecurity x => Proxy x -> SecurityScheme
securityScheme Proxy x
px) (Text, SecurityScheme)
-> [(Text, SecurityScheme)] -> [(Text, SecurityScheme)]
forall a. a -> [a] -> [a]
: Proxy xs -> [(Text, SecurityScheme)]
forall (x :: [*]).
AllHasSecurity x =>
Proxy x -> [(Text, SecurityScheme)]
securities Proxy xs
pxs
where
px :: Proxy x
px :: Proxy x
px = Proxy x
forall {k} (t :: k). Proxy t
Proxy
pxs :: Proxy xs
pxs :: Proxy xs
pxs = Proxy xs
forall {k} (t :: k). Proxy t
Proxy
instance {-# OVERLAPPING #-} AllHasSecurity xs => AllHasSecurity (Cookie ': xs) where
securities :: Proxy (Cookie : xs) -> [(Text, SecurityScheme)]
securities Proxy (Cookie : xs)
_ = Proxy xs -> [(Text, SecurityScheme)]
forall (x :: [*]).
AllHasSecurity x =>
Proxy x -> [(Text, SecurityScheme)]
securities Proxy xs
pxs
where
pxs :: Proxy xs
pxs :: Proxy xs
pxs = Proxy xs
forall {k} (t :: k). Proxy t
Proxy
instance AllHasSecurity '[] where
securities :: Proxy '[] -> [(Text, SecurityScheme)]
securities Proxy '[]
_ = []