diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,15 @@ [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-docs/CHANGELOG.md) [Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md) +0.12 +---- + +### Significant changes + +- Generate sample cURL requests + ([#1401](https://github.com/haskell-servant/servant/pull/1401/files)). + Breaking change: requires sample header values to be supplied with `headers`. + 0.11.9 ------ diff --git a/example/greet.hs b/example/greet.hs --- a/example/greet.hs +++ b/example/greet.hs @@ -75,7 +75,7 @@ -- 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 @@ 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 = 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.cabal b/servant-docs.cabal --- a/servant-docs.cabal +++ b/servant-docs.cabal @@ -1,6 +1,6 @@ -cabal-version: >=1.10 +cabal-version: 2.2 name: servant-docs -version: 0.11.9 +version: 0.12 synopsis: generate API docs for your servant webservice category: Servant, Web @@ -13,13 +13,13 @@ homepage: http://docs.servant.dev/ bug-reports: http://github.com/haskell-servant/servant/issues -license: BSD3 +license: BSD-3-Clause license-file: LICENSE author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com copyright: 2014-2016 Zalora South East Asia Pte Ltd, 2016-2019 Servant Contributors build-type: Simple -tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.2 || ==9.0.1 +tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.2 || ==9.0.1 extra-source-files: CHANGELOG.md @@ -47,12 +47,12 @@ -- Servant dependencies build-depends: - servant >= 0.18 && <0.19 + servant >= 0.18 && <0.20 -- Other dependencies: Lower bound around what is in the latest Stackage LTS. -- Here can be exceptions if we really need features from the newer versions. build-depends: - aeson >= 1.4.1.0 && < 1.6 + aeson >= 1.4.1.0 && < 3 , aeson-pretty >= 0.8.5 && < 0.9 , base-compat >= 0.10.5 && < 0.12 , case-insensitive >= 1.2.0.11 && < 1.3 @@ -102,7 +102,7 @@ -- Additional dependencies build-depends: - tasty >= 1.1.0.4 && < 1.3, + tasty >= 1.1.0.4 && < 1.5, tasty-golden >= 2.3.2 && < 2.4, tasty-hunit >= 0.10.0.1 && < 0.11, transformers >= 0.5.2.0 && < 0.6 diff --git a/src/Servant/Docs/Internal.hs b/src/Servant/Docs/Internal.hs --- a/src/Servant/Docs/Internal.hs +++ b/src/Servant/Docs/Internal.hs @@ -25,16 +25,14 @@ 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) import qualified Data.CaseInsensitive as CI import Data.Foldable - (toList) -import Data.Foldable - (fold) + (fold, toList) import Data.Hashable (Hashable) import Data.HashMap.Strict @@ -52,13 +50,14 @@ (comparing) import Data.Proxy (Proxy (Proxy)) -import Data.Semigroup - (Semigroup (..)) import Data.String.Conversions (cs) 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 +294,7 @@ 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 +355,14 @@ -- -- @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 +374,10 @@ -- @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 +414,7 @@ -- > 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 +509,7 @@ -- | 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 +645,7 @@ -- -- @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 +656,12 @@ 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 +817,6 @@ ("text", "css") -> "css" (_, _) -> "" - contentStr mime_type body = "" : "```" <> markdownForType mime_type : @@ -839,6 +841,36 @@ 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 +1009,17 @@ 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/src/Servant/Docs/Internal/Pretty.hs b/src/Servant/Docs/Internal/Pretty.hs --- a/src/Servant/Docs/Internal/Pretty.hs +++ b/src/Servant/Docs/Internal/Pretty.hs @@ -18,6 +18,7 @@ import Network.HTTP.Media ((//)) import Servant.API +import Servant.API.Verbs -- | PrettyJSON content type. data PrettyJSON @@ -46,6 +47,24 @@ Pretty (Put cs r) = Put (Pretty cs) r Pretty (Delete cs r) = Delete (Pretty cs) r Pretty (Patch cs r) = Patch (Pretty cs) r + Pretty (GetPartialContent cs r) = GetPartialContent (Pretty cs) r + Pretty (PutResetContent cs r) = PutResetContent (Pretty cs) r + Pretty (PatchResetContent cs r) = PatchResetContent (Pretty cs) r + Pretty (DeleteResetContent cs r) = DeleteResetContent (Pretty cs) r + Pretty (PostResetContent cs r) = PostResetContent (Pretty cs) r + Pretty (GetResetContent cs r) = GetResetContent (Pretty cs) r + Pretty (PutNonAuthoritative cs r) = PutNonAuthoritative (Pretty cs) r + Pretty (PatchNonAuthoritative cs r) = PatchNonAuthoritative (Pretty cs) r + Pretty (DeleteNonAuthoritative cs r) = DeleteNonAuthoritative (Pretty cs) r + Pretty (PostNonAuthoritative cs r) = PostNonAuthoritative (Pretty cs) r + Pretty (GetNonAuthoritative cs r) = GetNonAuthoritative (Pretty cs) r + Pretty (PutAccepted cs r) = PutAccepted (Pretty cs) r + Pretty (PatchAccepted cs r) = PatchAccepted (Pretty cs) r + Pretty (DeleteAccepted cs r) = DeleteAccepted (Pretty cs) r + Pretty (PostAccepted cs r) = PostAccepted (Pretty cs) r + Pretty (GetAccepted cs r) = GetAccepted (Pretty cs) r + Pretty (PutCreated cs r) = PutCreated (Pretty cs) r + Pretty (PostCreated cs r) = PostCreated (Pretty cs) r Pretty (ReqBody cs r) = ReqBody (Pretty cs) r Pretty (JSON ': xs) = PrettyJSON ': xs Pretty (x ': xs) = x ': Pretty xs diff --git a/test/Servant/DocsSpec.hs b/test/Servant/DocsSpec.hs --- a/test/Servant/DocsSpec.hs +++ b/test/Servant/DocsSpec.hs @@ -130,7 +130,6 @@ md `shouldContain` "\"dt1field1\":\"field 1\"" it "contains response samples - dt1field2" $ md `shouldContain` "\"dt1field2\":13" - it "contains request body samples" $ md `shouldContain` "17"