diff --git a/.gitignore b/.gitignore index a74ddee2..6cec8e9d 100644 --- a/.gitignore +++ b/.gitignore @@ -30,6 +30,7 @@ doc/_build doc/venv doc/tutorial/static/api.js doc/tutorial/static/jq.js +shell.nix # nix result* diff --git a/changelog.d/servant-docs-curl b/changelog.d/servant-docs-curl new file mode 100644 index 00000000..96731337 --- /dev/null +++ b/changelog.d/servant-docs-curl @@ -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")]` +} diff --git a/servant-docs/example/greet.hs b/servant-docs/example/greet.hs index ec36c7ca..68edfa5e 100644 --- a/servant-docs/example/greet.hs +++ b/servant-docs/example/greet.hs @@ -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 diff --git a/servant-docs/example/greet.md b/servant-docs/example/greet.md index fea5ce66..1283f628 100644 --- a/servant-docs/example/greet.md +++ b/servant-docs/example/greet.md @@ -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 +``` + + diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index d19636bf..31c2c141 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -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 -> "" instance (KnownSymbol sym, ToParam (QueryParam' mods sym a), HasDocs api) => HasDocs (QueryParam' mods sym a :> api) where diff --git a/servant-docs/test/Servant/DocsSpec.hs b/servant-docs/test/Servant/DocsSpec.hs index 357beed8..4a9efaee 100644 --- a/servant-docs/test/Servant/DocsSpec.hs +++ b/servant-docs/test/Servant/DocsSpec.hs @@ -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"