eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Servant docs curl (#1401)

Browse source 
servant-dosc: generate sample curl request
This commit is contained in:
Dan Fithian 2021-08-19 07:11:00 -04:00 committed by GitHub
parent 19ec395e66
commit 47bd25266f
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
6 changed files with 109 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.gitignore vendored
View file

@ -30,6 +30,7 @@ doc/_build
doc/venv
doc/tutorial/static/api.js
doc/tutorial/static/jq.js
shell.nix
# nix
result*

16
changelog.d/servant-docs-curl Normal file
View file

@ -0,0 +1,16 @@
synopsis: Add sample cURL requests to generated documentation
prs: #1401
description: {
Add sample cURL requests to generated documentation.
Those supplying changes to the Request `header` field manually using
lenses will need to add a sample bytestring value.
`headers <>~ ["unicorn"]`
becomes
`headers <>~ [("unicorn", "sample value")]`
}

8
servant-docs/example/greet.hs
View file

@ -75,7 +75,7 @@ intro2 = DocIntro "This title is below the last"
-- API specification
type TestApi =
-- GET /hello/:name?capital={true, false} returns a Greet as JSON or PlainText
"hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet
"hello" :> Capture "name" Text :> Header "X-Num-Fairies" Int :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet
-- POST /greet with a Greet as JSON in the request body,
-- returns a Greet as JSON
@ -93,9 +93,9 @@ testApi = Proxy
extra :: ExtraInfo TestApi
extra =
extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete '[JSON] NoContent)) $
defAction & headers <>~ ["unicorns"]
defAction & headers <>~ [("X-Num-Unicorns", "1")]
& notes <>~ [ DocNote "Title" ["This is some text"]
, DocNote "Second secton" ["And some more"]
, DocNote "Second section" ["And some more"]
]
-- Generate the data that lets us have API docs. This
@ -109,4 +109,4 @@ docsGreet :: API
docsGreet = docsWith defaultDocOptions [intro1, intro2] extra testApi
main :: IO ()
main = putStrLn $ markdown docsGreet
main = putStrLn $ markdownWith (defRenderingOptions { _renderCurlBasePath = Just "http://localhost:80" }) docsGreet

33
servant-docs/example/greet.md
View file

@ -51,6 +51,15 @@ You'll also note that multiple intros are possible.
"Hello, haskeller"
```
### Sample Request:
```bash
curl -XPOST \
-H "Content-Type: application/json;charset=utf-8" \
-d "\"HELLO, HASKELLER\"" \
http://localhost:80/greet
```
## DELETE /greet/:greetid
### Title
@ -67,7 +76,7 @@ And some more
### Headers:
- This endpoint is sensitive to the value of the **unicorns** HTTP header.
- This endpoint is sensitive to the value of the **X-Num-Unicorns** HTTP header.
### Response:
@ -85,12 +94,24 @@ And some more
```
### Sample Request:
```bash
curl -XDELETE \
-H "X-Num-Unicorns: 1" \
http://localhost:80/greet/:greetid
```
## GET /hello/:name
### Captures:
- *name*: name of the person to greet
### Headers:
- This endpoint is sensitive to the value of the **X-Num-Fairies** HTTP header.
### GET Parameters:
- capital
@ -120,3 +141,13 @@ And some more
```javascript
"Hello, haskeller"
```
### Sample Request:
```bash
curl -XGET \
-H "X-Num-Fairies: 1729" \
http://localhost:80/hello/:name
```

73
servant-docs/src/Servant/Docs/Internal.hs
View file

@ -25,8 +25,8 @@ import Control.Applicative
import Control.Arrow
(second)
import Control.Lens
(makeLenses, mapped, over, set, traversed, view, (%~), (&),
(.~), (<>~), (^.), (|>))
(makeLenses, mapped, each, over, set, to, toListOf, traversed, view,
_1, (%~), (&), (.~), (<>~), (^.), (|>))
import qualified Data.ByteString.Char8 as BSC
import Data.ByteString.Lazy.Char8
(ByteString)
@ -59,6 +59,9 @@ import Data.String.Conversions
import Data.Text
(Text, unpack)
import GHC.Generics
(Generic, Rep, K1(K1), M1(M1), U1(U1), V1,
(:*:)((:*:)), (:+:)(L1, R1))
import qualified GHC.Generics as G
import GHC.TypeLits
import Servant.API
import Servant.API.ContentTypes
@ -295,7 +298,7 @@ defResponse = Response
data Action = Action
{ _authInfo :: [DocAuthentication] -- user supplied info
, _captures :: [DocCapture] -- type collected + user supplied info
, _headers :: [Text] -- type collected
, _headers :: [HTTP.Header] -- type collected
, _params :: [DocQueryParam] -- type collected + user supplied info
, _fragment :: Maybe DocFragment -- type collected + user supplied info
, _notes :: [DocNote] -- user supplied
@ -356,12 +359,14 @@ data ShowContentTypes = AllContentTypes -- ^ For each example, show each conten
--
-- @since 0.11.1
data RenderingOptions = RenderingOptions
{ _requestExamples :: !ShowContentTypes
{ _requestExamples :: !ShowContentTypes
-- ^ How many content types to display for request body examples?
, _responseExamples :: !ShowContentTypes
, _responseExamples :: !ShowContentTypes
-- ^ How many content types to display for response body examples?
, _notesHeading :: !(Maybe String)
, _notesHeading :: !(Maybe String)
-- ^ Optionally group all 'notes' together under a common heading.
, _renderCurlBasePath :: !(Maybe String)
-- ^ Optionally render example curl requests under a common base path (e.g. `http://localhost:80`).
} deriving (Show)
-- | Default API generation options.
@ -373,9 +378,10 @@ data RenderingOptions = RenderingOptions
-- @since 0.11.1
defRenderingOptions :: RenderingOptions
defRenderingOptions = RenderingOptions
{ _requestExamples = AllContentTypes
, _responseExamples = AllContentTypes
, _notesHeading = Nothing
{ _requestExamples = AllContentTypes
, _responseExamples = AllContentTypes
, _notesHeading = Nothing
, _renderCurlBasePath = Nothing
}
-- gimme some lenses
@ -412,7 +418,7 @@ docsWithOptions p = docsFor p (defEndpoint, defAction)
-- > extra :: ExtraInfo TestApi
-- > extra =
-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
-- > defAction & headers <>~ ["unicorns"]
-- > defAction & headers <>~ [("X-Num-Unicorns", 1)]
-- > & notes <>~ [ DocNote "Title" ["This is some text"]
-- > , DocNote "Second section" ["And some more"]
-- > ]
@ -507,7 +513,7 @@ samples = map ("",)
-- | Default sample Generic-based inputs/outputs.
defaultSamples :: forall a. (Generic a, GToSample (Rep a)) => Proxy a -> [(Text, a)]
defaultSamples _ = second to <$> gtoSamples (Proxy :: Proxy (Rep a))
defaultSamples _ = second G.to <$> gtoSamples (Proxy :: Proxy (Rep a))
-- | @'ToSample'@ for Generics.
--
@ -643,7 +649,7 @@ markdown = markdownWith defRenderingOptions
--
-- @since 0.11.1
markdownWith :: RenderingOptions -> API -> String
markdownWith RenderingOptions{..} api = unlines $
markdownWith RenderingOptions{..} api = unlines $
introsStr (api ^. apiIntros)
++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)
@ -654,11 +660,12 @@ markdownWith RenderingOptions{..} api = unlines $
notesStr (action ^. notes) ++
authStr (action ^. authInfo) ++
capturesStr (action ^. captures) ++
headersStr (action ^. headers) ++
headersStr (toListOf (headers . each . _1 . to (T.pack . BSC.unpack . CI.original)) action) ++
paramsStr meth (action ^. params) ++
fragmentStr (action ^. fragment) ++
rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++
responseStr (action ^. response) ++
maybe [] (curlStr endpoint (action ^. headers) (action ^. rqbody)) _renderCurlBasePath ++
[]
where str = "## " ++ BSC.unpack meth
@ -814,7 +821,6 @@ markdownWith RenderingOptions{..} api = unlines $
("text", "css") -> "css"
(_, _) -> ""
contentStr mime_type body =
"" :
"```" <> markdownForType mime_type :
@ -839,6 +845,36 @@ markdownWith RenderingOptions{..} api = unlines $
xs ->
formatBodies _responseExamples xs
curlStr :: Endpoint -> [HTTP.Header] -> [(Text, M.MediaType, ByteString)] -> String -> [String]
curlStr endpoint hdrs reqBodies basePath =
[ "### Sample Request:"
, ""
, "```bash"
, "curl -X" ++ BSC.unpack (endpoint ^. method) ++ " \\"
] <>
maybe [] pure mbMediaTypeStr <>
headersStrs <>
maybe [] pure mbReqBodyStr <>
[ " " ++ basePath ++ showPath (endpoint ^. path)
, "```"
, ""
]
where escapeQuotes :: String -> String
escapeQuotes = concatMap $ \c -> case c of
'\"' -> "\\\""
_ -> [c]
mbReqBody = listToMaybe reqBodies
mbMediaTypeStr = mkMediaTypeStr <$> mbReqBody
headersStrs = mkHeaderStr <$> hdrs
mbReqBodyStr = mkReqBodyStr <$> mbReqBody
mkMediaTypeStr (_, media_type, _) =
" -H \"Content-Type: " ++ show media_type ++ "\" \\"
mkHeaderStr (hdrName, hdrVal) =
" -H \"" ++ escapeQuotes (cs (CI.original hdrName)) ++ ": " ++
escapeQuotes (cs hdrVal) ++ "\" \\"
mkReqBodyStr (_, _, body) = " -d \"" ++ escapeQuotes (cs body) ++ "\" \\"
-- * Instances
-- | The generated docs for @a ':<|>' b@ just appends the docs
@ -977,14 +1013,17 @@ instance {-# OVERLAPPING #-}
status = fromInteger $ natVal (Proxy :: Proxy status)
p = Proxy :: Proxy a
instance (KnownSymbol sym, HasDocs api)
instance (ToHttpApiData a, ToSample a, KnownSymbol sym, HasDocs api)
=> HasDocs (Header' mods sym a :> api) where
docsFor Proxy (endpoint, action) =
docsFor subApiP (endpoint, action')
where subApiP = Proxy :: Proxy api
action' = over headers (|> headername) action
headername = T.pack $ symbolVal (Proxy :: Proxy sym)
action' = over headers (|> (headerName, headerVal)) action
headerName = CI.mk . cs $ symbolVal (Proxy :: Proxy sym)
headerVal = case toSample (Proxy :: Proxy a) of
Just x -> cs $ toHeader x
Nothing -> "<no header sample provided>"
instance (KnownSymbol sym, ToParam (QueryParam' mods sym a), HasDocs api)
=> HasDocs (QueryParam' mods sym a :> api) where

1
servant-docs/test/Servant/DocsSpec.hs
View file

@ -130,7 +130,6 @@ spec = describe "Servant.Docs" $ do
md `shouldContain` "\"dt1field1\":\"field 1\""
it "contains response samples - dt1field2" $
md `shouldContain` "\"dt1field2\":13"
it "contains request body samples" $
md `shouldContain` "17"