{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE CPP #-}
module Servant.Auth.Swagger
  (
  -- | The purpose of this package is provide the instance for 'servant-auth'
  -- combinators needed for 'servant-swagger' documentation generation.
  --
  -- Currently only JWT and BasicAuth are supported.

  -- * Re-export
    JWT
  , BasicAuth
  , Auth

  -- * Needed to define instances of @HasSwagger@
  , 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 '[]
_ = []