47bd252 · typeable/servant

git.iko.soy/typeable/servant

Servant docs curl (#1401)

servant-dosc: generate sample curl request

commit47bd25266fed2a65d0caed64833e733bb633291d authorDan Fithian <dfithian@users.noreply.github.com> dateThu 19 Aug 2021, 07:11 (5 years ago) parent19ec395

6 files changed+109−23

compare with master

unifiedsplit

.gitignore+1 changelog.d/servant-docs-curl+16 servant-docs/example/greet.hs+4−4 servant-docs/example/greet.md+32−1 servant-docs/src/Servant/Docs/Internal.hs+56−17 servant-docs/test/Servant/DocsSpec.hs−1

.gitignore+1

@@ -30,6 +30,7 @@ doc/_build

3030doc/venv

3131doc/tutorial/static/api.js

3232doc/tutorial/static/jq.js

33+shell.nix

3334

3435# nix

3536result*

changelog.d/servant-docs-curlnew file+16

@@ -0,0 +1,16 @@

1+synopsis: Add sample cURL requests to generated documentation

2+prs: #1401

4+description: {

6+Add sample cURL requests to generated documentation.

8+Those supplying changes to the Request `header` field manually using

9+lenses will need to add a sample bytestring value.

10+

11+`headers <>~ ["unicorn"]`

12+

13+becomes

14+

15+`headers <>~ [("unicorn", "sample value")]`

16+}

servant-docs/example/greet.hs+4−4

@@ -75,7 +75,7 @@ intro2 = DocIntro "This title is below the last"

7575-- API specification

7676type TestApi =

7777 -- GET /hello/:name?capital={true, false} returns a Greet as JSON or PlainText

78− "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet

78+ "hello" :> Capture "name" Text :> Header "X-Num-Fairies" Int :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet

7979

8080 -- POST /greet with a Greet as JSON in the request body,

8181 -- returns a Greet as JSON

@@ -93,9 +93,9 @@ testApi = Proxy

9393extra :: ExtraInfo TestApi

9494extra =

9595 extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete '[JSON] NoContent)) $

96− defAction & headers <>~ ["unicorns"]

96+ defAction & headers <>~ [("X-Num-Unicorns", "1")]

9797 & notes <>~ [ DocNote "Title" ["This is some text"]

98− , DocNote "Second secton" ["And some more"]

98+ , DocNote "Second section" ["And some more"]

9999 ]

100100

101101-- Generate the data that lets us have API docs. This

@@ -109,4 +109,4 @@ docsGreet :: API

109109docsGreet = docsWith defaultDocOptions [intro1, intro2] extra testApi

110110

111111main :: IO ()

112−main = putStrLn $ markdown docsGreet

112+main = putStrLn $ markdownWith (defRenderingOptions { _renderCurlBasePath = Just "http://localhost:80" }) docsGreet

servant-docs/example/greet.md+32−1

@@ -51,6 +51,15 @@ You'll also note that multiple intros are possible.

5151"Hello, haskeller"

5252```

5353

54+### Sample Request:

55+

56+```bash

57+curl -XPOST \

58+ -H "Content-Type: application/json;charset=utf-8" \

59+ -d "\"HELLO, HASKELLER\"" \

60+ http://localhost:80/greet

61+```

62+

5463## DELETE /greet/:greetid

5564

5665### Title

@@ -67,7 +76,7 @@ And some more

6776

6877### Headers:

6978

70−- This endpoint is sensitive to the value of the **unicorns** HTTP header.

79+- This endpoint is sensitive to the value of the **X-Num-Unicorns** HTTP header.

7180

7281### Response:

7382

@@ -85,12 +94,24 @@ And some more

8594

8695```

8796

97+### Sample Request:

98+

99+```bash

100+curl -XDELETE \

101+ -H "X-Num-Unicorns: 1" \

102+ http://localhost:80/greet/:greetid

103+```

104+

88105## GET /hello/:name

89106

90107### Captures:

91108

92109- *name*: name of the person to greet

93110

111+### Headers:

112+

113+- This endpoint is sensitive to the value of the **X-Num-Fairies** HTTP header.

114+

94115### GET Parameters:

95116

96117- capital

@@ -120,3 +141,13 @@ And some more

120141```javascript

121142"Hello, haskeller"

122143```

144+

145+### Sample Request:

146+

147+```bash

148+curl -XGET \

149+ -H "X-Num-Fairies: 1729" \

150+ http://localhost:80/hello/:name

151+```

152+

153+

servant-docs/src/Servant/Docs/Internal.hs+56−17

@@ -25,8 +25,8 @@ import Control.Applicative

2525import Control.Arrow

2626 (second)

2727import Control.Lens

28− (makeLenses, mapped, over, set, traversed, view, (%~), (&),

29− (.~), (<>~), (^.), (|>))

28+ (makeLenses, mapped, each, over, set, to, toListOf, traversed, view,

29+ _1, (%~), (&), (.~), (<>~), (^.), (|>))

3030import qualified Data.ByteString.Char8 as BSC

3131import Data.ByteString.Lazy.Char8

3232 (ByteString)

@@ -59,6 +59,9 @@ import Data.String.Conversions

5959import Data.Text

6060 (Text, unpack)

6161import GHC.Generics

62+ (Generic, Rep, K1(K1), M1(M1), U1(U1), V1,

63+ (:*:)((:*:)), (:+:)(L1, R1))

64+import qualified GHC.Generics as G

6265import GHC.TypeLits

6366import Servant.API

6467import Servant.API.ContentTypes

@@ -295,7 +298,7 @@ defResponse = Response

295298data Action = Action

296299 { _authInfo :: [DocAuthentication] -- user supplied info

297300 , _captures :: [DocCapture] -- type collected + user supplied info

298− , _headers :: [Text] -- type collected

301+ , _headers :: [HTTP.Header] -- type collected

299302 , _params :: [DocQueryParam] -- type collected + user supplied info

300303 , _fragment :: Maybe DocFragment -- type collected + user supplied info

301304 , _notes :: [DocNote] -- user supplied

@@ -356,12 +359,14 @@ data ShowContentTypes = AllContentTypes -- ^ For each example, show each conten

356359--

357360-- @since 0.11.1

358361data RenderingOptions = RenderingOptions

359− { _requestExamples :: !ShowContentTypes

362+ { _requestExamples :: !ShowContentTypes

360363 -- ^ How many content types to display for request body examples?

361− , _responseExamples :: !ShowContentTypes

364+ , _responseExamples :: !ShowContentTypes

362365 -- ^ How many content types to display for response body examples?

363− , _notesHeading :: !(Maybe String)

366+ , _notesHeading :: !(Maybe String)

364367 -- ^ Optionally group all 'notes' together under a common heading.

368+ , _renderCurlBasePath :: !(Maybe String)

369+ -- ^ Optionally render example curl requests under a common base path (e.g. `http://localhost:80`).

365370 } deriving (Show)

366371

367372-- | Default API generation options.

@@ -373,9 +378,10 @@ data RenderingOptions = RenderingOptions

373378-- @since 0.11.1

374379defRenderingOptions :: RenderingOptions

375380defRenderingOptions = RenderingOptions

376− { _requestExamples = AllContentTypes

377− , _responseExamples = AllContentTypes

378− , _notesHeading = Nothing

381+ { _requestExamples = AllContentTypes

382+ , _responseExamples = AllContentTypes

383+ , _notesHeading = Nothing

384+ , _renderCurlBasePath = Nothing

379385 }

380386

381387-- gimme some lenses

@@ -412,7 +418,7 @@ docsWithOptions p = docsFor p (defEndpoint, defAction)

412418-- > extra :: ExtraInfo TestApi

413419-- > extra =

414420-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $

415−-- > defAction & headers <>~ ["unicorns"]

421+-- > defAction & headers <>~ [("X-Num-Unicorns", 1)]

416422-- > & notes <>~ [ DocNote "Title" ["This is some text"]

417423-- > , DocNote "Second section" ["And some more"]

418424-- > ]

@@ -507,7 +513,7 @@ samples = map ("",)

507513

508514-- | Default sample Generic-based inputs/outputs.

509515defaultSamples :: forall a. (Generic a, GToSample (Rep a)) => Proxy a -> [(Text, a)]

510−defaultSamples _ = second to <$> gtoSamples (Proxy :: Proxy (Rep a))

516+defaultSamples _ = second G.to <$> gtoSamples (Proxy :: Proxy (Rep a))

511517

512518-- | @'ToSample'@ for Generics.

513519--

@@ -643,7 +649,7 @@ markdown = markdownWith defRenderingOptions

643649--

644650-- @since 0.11.1

645651markdownWith :: RenderingOptions -> API -> String

646−markdownWith RenderingOptions{..} api = unlines $

652+markdownWith RenderingOptions{..} api = unlines $

647653 introsStr (api ^. apiIntros)

648654 ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)

649655

@@ -654,11 +660,12 @@ markdownWith RenderingOptions{..} api = unlines $

654660 notesStr (action ^. notes) ++

655661 authStr (action ^. authInfo) ++

656662 capturesStr (action ^. captures) ++

657− headersStr (action ^. headers) ++

663+ headersStr (toListOf (headers . each . _1 . to (T.pack . BSC.unpack . CI.original)) action) ++

658664 paramsStr meth (action ^. params) ++

659665 fragmentStr (action ^. fragment) ++

660666 rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++

661667 responseStr (action ^. response) ++

668+ maybe [] (curlStr endpoint (action ^. headers) (action ^. rqbody)) _renderCurlBasePath ++

662669 []

663670

664671 where str = "## " ++ BSC.unpack meth

@@ -814,7 +821,6 @@ markdownWith RenderingOptions{..} api = unlines $

814821 ("text", "css") -> "css"

815822 (_, _) -> ""

816823

817−

818824 contentStr mime_type body =

819825 "" :

820826 "```" <> markdownForType mime_type :

@@ -839,6 +845,36 @@ markdownWith RenderingOptions{..} api = unlines $

839845 xs ->

840846 formatBodies _responseExamples xs

841847

848+ curlStr :: Endpoint -> [HTTP.Header] -> [(Text, M.MediaType, ByteString)] -> String -> [String]

849+ curlStr endpoint hdrs reqBodies basePath =

850+ [ "### Sample Request:"

851+ , ""

852+ , "```bash"

853+ , "curl -X" ++ BSC.unpack (endpoint ^. method) ++ " \\"

854+ ] <>

855+ maybe [] pure mbMediaTypeStr <>

856+ headersStrs <>

857+ maybe [] pure mbReqBodyStr <>

858+ [ " " ++ basePath ++ showPath (endpoint ^. path)

859+ , "```"

860+ , ""

861+ ]

862+

863+ where escapeQuotes :: String -> String

864+ escapeQuotes = concatMap $ \c -> case c of

865+ '\"' -> "\\\""

866+ _ -> [c]

867+ mbReqBody = listToMaybe reqBodies

868+ mbMediaTypeStr = mkMediaTypeStr <$> mbReqBody

869+ headersStrs = mkHeaderStr <$> hdrs

870+ mbReqBodyStr = mkReqBodyStr <$> mbReqBody

871+ mkMediaTypeStr (_, media_type, _) =

872+ " -H \"Content-Type: " ++ show media_type ++ "\" \\"

873+ mkHeaderStr (hdrName, hdrVal) =

874+ " -H \"" ++ escapeQuotes (cs (CI.original hdrName)) ++ ": " ++

875+ escapeQuotes (cs hdrVal) ++ "\" \\"

876+ mkReqBodyStr (_, _, body) = " -d \"" ++ escapeQuotes (cs body) ++ "\" \\"

877+

842878-- * Instances

843879

844880-- | The generated docs for @a ':<|>' b@ just appends the docs

@@ -977,14 +1013,17 @@ instance {-# OVERLAPPING #-}

9771013 status = fromInteger $ natVal (Proxy :: Proxy status)

9781014 p = Proxy :: Proxy a

9791015

980−instance (KnownSymbol sym, HasDocs api)

1016+instance (ToHttpApiData a, ToSample a, KnownSymbol sym, HasDocs api)

9811017 => HasDocs (Header' mods sym a :> api) where

9821018 docsFor Proxy (endpoint, action) =

9831019 docsFor subApiP (endpoint, action')

9841020

9851021 where subApiP = Proxy :: Proxy api

986− action' = over headers (|> headername) action

987− headername = T.pack $ symbolVal (Proxy :: Proxy sym)

1022+ action' = over headers (|> (headerName, headerVal)) action

1023+ headerName = CI.mk . cs $ symbolVal (Proxy :: Proxy sym)

1024+ headerVal = case toSample (Proxy :: Proxy a) of

1025+ Just x -> cs $ toHeader x

1026+ Nothing -> "<no header sample provided>"

9881027

9891028instance (KnownSymbol sym, ToParam (QueryParam' mods sym a), HasDocs api)

9901029 => HasDocs (QueryParam' mods sym a :> api) where

servant-docs/test/Servant/DocsSpec.hs−1

@@ -130,7 +130,6 @@ spec = describe "Servant.Docs" $ do

130130 md `shouldContain` "\"dt1field1\":\"field 1\""

131131 it "contains response samples - dt1field2" $

132132 md `shouldContain` "\"dt1field2\":13"

133−

134133 it "contains request body samples" $

135134 md `shouldContain` "17"

136135