@@ -22,7 +22,7 @@ module Servant.Docs.Internal where
23import Control.Applicative
23import Control.Applicative
24import Control.Arrow (second)
24import Control.Arrow (second)
25−import Control.Lens (makeLenses, over, traversed, (%~),
25+import Control.Lens (makeLenses, mapped, over, traversed, view, (%~),
26 (&), (.~), (<>~), (^.), (|>))
26 (&), (.~), (<>~), (^.), (|>))
27import qualified Control.Monad.Omega as Omega
27import qualified Control.Monad.Omega as Omega
28import Data.ByteString.Conversion (ToByteString, toByteString)
28import Data.ByteString.Conversion (ToByteString, toByteString)
@@ -140,6 +140,12 @@ data DocIntro = DocIntro
140 , _introBody :: [String] -- ^ Each String is a paragraph.
140 , _introBody :: [String] -- ^ Each String is a paragraph.
141 } deriving (Eq, Show)
141 } deriving (Eq, Show)
143+-- | A type to represent Authentication information about an endpoint.
144+data DocAuthentication = DocAuthentication
145+ { _authIntro :: String
146+ , _authDataRequired :: String
147+ } deriving (Eq, Ord, Show)
143instance Ord DocIntro where
149instance Ord DocIntro where
144 compare = comparing _introTitle
150 compare = comparing _introTitle
@@ -230,7 +236,8 @@ defResponse = Response
230-- You can tweak an 'Action' (like the default 'defAction') with these lenses
236-- You can tweak an 'Action' (like the default 'defAction') with these lenses
231-- to transform an action and add some information to it.
237-- to transform an action and add some information to it.
232data Action = Action
238data Action = Action
239+ { _authInfo :: [DocAuthentication] -- user supplied info
233− { _captures :: [DocCapture] -- type collected + user supplied info
240+ , _captures :: [DocCapture] -- type collected + user supplied info
234 , _headers :: [Text] -- type collected
241 , _headers :: [Text] -- type collected
235 , _params :: [DocQueryParam] -- type collected + user supplied info
242 , _params :: [DocQueryParam] -- type collected + user supplied info
236 , _notes :: [DocNote] -- user supplied
243 , _notes :: [DocNote] -- user supplied
@@ -247,8 +254,8 @@ data Action = Action
247-- 'combineAction' to mush two together taking the response, body and content
254-- 'combineAction' to mush two together taking the response, body and content
248-- types from the very left.
255-- types from the very left.
249combineAction :: Action -> Action -> Action
256combineAction :: Action -> Action -> Action
250−Action c h p n m ts body resp `combineAction` Action c' h' p' n' m' _ _ _ =
257+Action a c h p n m ts body resp `combineAction` Action a' c' h' p' n' m' _ _ _ =
251− Action (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') ts body resp
258+ Action (a <> a') (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') ts body resp
253-- Default 'Action'. Has no 'captures', no GET 'params', expects
260-- Default 'Action'. Has no 'captures', no GET 'params', expects
254-- no request body ('rqbody') and the typical response is 'defResponse'.
261-- no request body ('rqbody') and the typical response is 'defResponse'.
@@ -268,6 +275,7 @@ defAction =
271 defResponse
279 defResponse
273-- | Create an API that's comprised of a single endpoint.
281-- | Create an API that's comprised of a single endpoint.
@@ -277,6 +285,7 @@ single :: Endpoint -> Action -> API
277single e a = API mempty (HM.singleton e a)
285single e a = API mempty (HM.singleton e a)
279-- gimme some lenses
287-- gimme some lenses
288+makeLenses ''DocAuthentication
280makeLenses ''DocOptions
289makeLenses ''DocOptions
281makeLenses ''API
290makeLenses ''API
282makeLenses ''Endpoint
291makeLenses ''Endpoint
@@ -454,7 +463,7 @@ instance AllHeaderSamples '[] where
455instance (ToByteString l, AllHeaderSamples ls, ToSample l, KnownSymbol h)
464instance (ToByteString l, AllHeaderSamples ls, ToSample l, KnownSymbol h)
456 => AllHeaderSamples (Header h l ': ls) where
465 => AllHeaderSamples (Header h l ': ls) where
457− allHeaderToSample _ = (mkHeader (toSample (Proxy :: Proxy l))) :
466+ allHeaderToSample _ = mkHeader (toSample (Proxy :: Proxy l)) :
458 allHeaderToSample (Proxy :: Proxy ls)
467 allHeaderToSample (Proxy :: Proxy ls)
459 where headerName = CI.mk . cs $ symbolVal (Proxy :: Proxy h)
468 where headerName = CI.mk . cs $ symbolVal (Proxy :: Proxy h)
460 mkHeader (Just x) = (headerName, cs $ toByteString x)
469 mkHeader (Just x) = (headerName, cs $ toByteString x)
@@ -504,6 +513,10 @@ class ToParam t where
504class ToCapture c where
513class ToCapture c where
505 toCapture :: Proxy c -> DocCapture
514 toCapture :: Proxy c -> DocCapture
516+-- | The class that helps us get documentation for authenticated endpoints
517+class ToAuthInfo a where
518+ toAuthInfo :: Proxy a -> DocAuthentication
507-- | Generate documentation in Markdown format for
520-- | Generate documentation in Markdown format for
508-- the given 'API'.
521-- the given 'API'.
509markdown :: API -> String
522markdown :: API -> String
@@ -516,6 +529,7 @@ markdown api = unlines $
518 notesStr (action ^. notes) ++
531 notesStr (action ^. notes) ++
532+ authStr (action ^. authInfo) ++
519 capturesStr (action ^. captures) ++
533 capturesStr (action ^. captures) ++
520 headersStr (action ^. headers) ++
534 headersStr (action ^. headers) ++
521 paramsStr (action ^. params) ++
535 paramsStr (action ^. params) ++
@@ -548,6 +562,20 @@ markdown api = unlines $
566+ authStr :: [DocAuthentication] -> [String]
568+ let authIntros = mapped %~ view authIntro $ auths
569+ clientInfos = mapped %~ view authDataRequired $ auths
570+ in "#### Authentication":
572+ unlines authIntros :
574+ "Clients must supply the following data" :
575+ unlines clientInfos :
551 capturesStr :: [DocCapture] -> [String]
579 capturesStr :: [DocCapture] -> [String]
552 capturesStr [] = []
580 capturesStr [] = []
553 capturesStr l =
581 capturesStr l =
@@ -797,6 +825,13 @@ instance HasDocs sublayout => HasDocs (Vault :> sublayout) where
797instance HasDocs sublayout => HasDocs (WithNamedContext name context sublayout) where
825instance HasDocs sublayout => HasDocs (WithNamedContext name context sublayout) where
798 docsFor Proxy = docsFor (Proxy :: Proxy sublayout)
826 docsFor Proxy = docsFor (Proxy :: Proxy sublayout)
828+instance (ToAuthInfo (BasicAuth realm usr), HasDocs sublayout) => HasDocs (BasicAuth realm usr :> sublayout) where
829+ docsFor Proxy (endpoint, action) =
830+ docsFor (Proxy :: Proxy sublayout) (endpoint, action')
832+ authProxy = Proxy :: Proxy (BasicAuth realm usr)
833+ action' = over authInfo (|> toAuthInfo authProxy) action
800-- ToSample instances for simple types
835-- ToSample instances for simple types
801instance ToSample ()
836instance ToSample ()
802instance ToSample Bool
837instance ToSample Bool