{-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.Auth.Docs
(
JWT
, BasicAuth
, Cookie
, Auth
) where
import Control.Lens ((%~), (&), (|>))
import Data.List (intercalate)
import Data.Monoid
import Data.Proxy (Proxy (Proxy))
import Servant.API hiding (BasicAuth)
import Servant.Auth
import Servant.Docs hiding (pretty)
import Servant.Docs.Internal (DocAuthentication (..), authInfo)
instance (AllDocs auths, HasDocs api) => HasDocs (Auth auths r :> api) where
docsFor :: Proxy (Auth auths r :> api)
-> (Endpoint, Action) -> DocOptions -> API
docsFor Proxy (Auth auths r :> api)
_ (Endpoint
endpoint, Action
action) =
forall {k} (api :: k).
HasDocs api =>
Proxy api -> (Endpoint, Action) -> DocOptions -> API
docsFor (forall {k} (t :: k). Proxy t
Proxy :: Proxy api) (Endpoint
endpoint, Action
action forall a b. a -> (a -> b) -> b
& Lens' Action [DocAuthentication]
authInfo forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall s a. Snoc s s a a => s -> a -> s
|> DocAuthentication
info))
where
(String
intro, String
reqData) = [(String, String)] -> (String, String)
pretty forall a b. (a -> b) -> a -> b
$ forall (x :: [*]) (proxy :: [*] -> *).
AllDocs x =>
proxy x -> [(String, String)]
allDocs (forall {k} (t :: k). Proxy t
Proxy :: Proxy auths)
info :: DocAuthentication
info = String -> String -> DocAuthentication
DocAuthentication String
intro String
reqData
pretty :: [(String, String)] -> (String, String)
pretty :: [(String, String)] -> (String, String)
pretty [] = forall a. HasCallStack => String -> a
error String
"shouldn't happen"
pretty [(String
i, String
d)] =
( String
"This part of the API is protected by " forall a. Semigroup a => a -> a -> a
<> String
i
, String
d
)
pretty [(String, String)]
rs =
( String
"This part of the API is protected by the following authentication mechanisms:\n\n"
forall a. [a] -> [a] -> [a]
++ String
" * " forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate String
"\n * " (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, String)]
rs)
, String
"\nOne of the following:\n\n"
forall a. [a] -> [a] -> [a]
++ String
" * " forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate String
"\n * " (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, String)]
rs)
)
class AllDocs (x :: [*]) where
allDocs :: proxy x
-> [(String, String)]
instance (OneDoc a, AllDocs as) => AllDocs (a ': as) where
allDocs :: forall (proxy :: [*] -> *). proxy (a : as) -> [(String, String)]
allDocs proxy (a : as)
_ = forall a (proxy :: * -> *). OneDoc a => proxy a -> (String, String)
oneDoc (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) forall a. a -> [a] -> [a]
: forall (x :: [*]) (proxy :: [*] -> *).
AllDocs x =>
proxy x -> [(String, String)]
allDocs (forall {k} (t :: k). Proxy t
Proxy :: Proxy as)
instance AllDocs '[] where
allDocs :: forall (proxy :: [*] -> *). proxy '[] -> [(String, String)]
allDocs proxy '[]
_ = []
class OneDoc a where
oneDoc :: proxy a -> (String, String)
instance OneDoc JWT where
oneDoc :: forall (proxy :: * -> *). proxy JWT -> (String, String)
oneDoc proxy JWT
_ =
(String
"JSON Web Tokens ([JWTs](https://en.wikipedia.org/wiki/JSON_Web_Token))"
, String
"A JWT Token signed with this server's key")
instance OneDoc Cookie where
oneDoc :: forall (proxy :: * -> *). proxy Cookie -> (String, String)
oneDoc proxy Cookie
_ =
(String
"[Cookies](https://en.wikipedia.org/wiki/HTTP_cookie)"
, String
"Cookies automatically set by browsers, plus a header")
instance OneDoc BasicAuth where
oneDoc :: forall (proxy :: * -> *). proxy BasicAuth -> (String, String)
oneDoc proxy BasicAuth
_ =
( String
"[Basic Authentication](https://en.wikipedia.org/wiki/Basic_access_authentication)"
, String
"Cookies automatically set by browsers, plus a header")