{-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.Auth.Docs
  (
  -- | The purpose of this package is provide the instance for 'servant-auth'
  -- combinators needed for 'servant-docs' documentation generation.
  --
  -- >>> type API = Auth '[JWT, Cookie, BasicAuth] Int :> Get '[JSON] Int
  -- >>> putStr $ markdown $ docs (Proxy :: Proxy API)
  -- ## GET /
  -- ...
  -- ... Authentication
  -- ...
  -- This part of the API is protected by the following authentication mechanisms:
  -- ...
  --  * JSON Web Tokens ([JWTs](https://en.wikipedia.org/wiki/JSON_Web_Token))
  --  * [Cookies](https://en.wikipedia.org/wiki/HTTP_cookie)
  --  * [Basic Authentication](https://en.wikipedia.org/wiki/Basic_access_authentication)
  -- ...
  -- Clients must supply the following data
  -- ...
  -- One of the following:
  -- ...
  --  * A JWT Token signed with this server's key
  --  * Cookies automatically set by browsers, plus a header
  --  * Cookies automatically set by browsers, plus a header
  -- ...

  -- * Re-export
    JWT
  , BasicAuth
  , Cookie
  , Auth
  ) where

import Control.Lens          ((%~), (&), (|>))
import Data.Kind             (Type)
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) =
    Proxy api -> (Endpoint, Action) -> DocOptions -> API
forall {k} (api :: k).
HasDocs api =>
Proxy api -> (Endpoint, Action) -> DocOptions -> API
docsFor (Proxy api
forall {k} (t :: k). Proxy t
Proxy :: Proxy api) (Endpoint
endpoint, Action
action Action -> (Action -> Action) -> Action
forall a b. a -> (a -> b) -> b
& ([DocAuthentication] -> Identity [DocAuthentication])
-> Action -> Identity Action
Lens' Action [DocAuthentication]
authInfo (([DocAuthentication] -> Identity [DocAuthentication])
 -> Action -> Identity Action)
-> ([DocAuthentication] -> [DocAuthentication]) -> Action -> Action
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([DocAuthentication] -> DocAuthentication -> [DocAuthentication]
forall s a. Snoc s s a a => s -> a -> s
|> DocAuthentication
info))
    where
      (String
intro, String
reqData) = [(String, String)] -> (String, String)
pretty ([(String, String)] -> (String, String))
-> [(String, String)] -> (String, String)
forall a b. (a -> b) -> a -> b
$ Proxy auths -> [(String, String)]
forall (x :: [*]) (proxy :: [*] -> *).
AllDocs x =>
proxy x -> [(String, String)]
forall (proxy :: [*] -> *). proxy auths -> [(String, String)]
allDocs (Proxy auths
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 [] = String -> (String, String)
forall a. HasCallStack => String -> a
error String
"shouldn't happen"
pretty [(String
i, String
d)] =
  ( String
"This part of the API is protected by " String -> String -> String
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"
  String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
" * " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n * " ((String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String) -> [(String, String)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, String)]
rs)
  , String
"\nOne of the following:\n\n"
  String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
" * " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n * " ((String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String) -> [(String, String)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, String)]
rs)
  )


class AllDocs (x :: [Type]) where
  allDocs :: proxy x
              -- intro, req
          -> [(String, String)]

instance (OneDoc a, AllDocs as) => AllDocs (a ': as) where
  allDocs :: forall (proxy :: [*] -> *). proxy (a : as) -> [(String, String)]
allDocs proxy (a : as)
_ = Proxy a -> (String, String)
forall a (proxy :: * -> *). OneDoc a => proxy a -> (String, String)
forall (proxy :: * -> *). proxy a -> (String, String)
oneDoc (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: Proxy as -> [(String, String)]
forall (x :: [*]) (proxy :: [*] -> *).
AllDocs x =>
proxy x -> [(String, String)]
forall (proxy :: [*] -> *). proxy as -> [(String, String)]
allDocs (Proxy as
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")

-- $setup
-- >>> instance ToSample Int where toSamples _ = singleSample 1729