diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,51 @@ [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-server/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.17 +---- + +### Significant changes + +- Add NoContentVerb [#1028](https://github.com/haskell-servant/servant/issues/1028) [#1219](https://github.com/haskell-servant/servant/pull/1219) [#1228](https://github.com/haskell-servant/servant/pull/1228) + + The `NoContent` API endpoints should now use `NoContentVerb` combinator. + The API type changes are usually of the kind + + ```diff + - :<|> PostNoContent '[JSON] NoContent + + :<|> PostNoContent + ``` + + i.e. one doesn't need to specify the content-type anymore. There is no content. + +- `Capture` can be `Lenient` [#1155](https://github.com/haskell-servant/servant/issues/1155) [#1156](https://github.com/haskell-servant/servant/pull/1156) + + You can specify a lenient capture as + + ```haskell + :<|> "capture-lenient" :> Capture' '[Lenient] "foo" Int :> GET + ``` + + which will make the capture always succeed. Handlers will be of the + type `Either String CapturedType`, where `Left err` represents + the possible parse failure. + +- *servant-server* use queryString to parse QueryParam, QueryParams and QueryFlag [#1249](https://github.com/haskell-servant/servant/pull/1249) [#1262](https://github.com/haskell-servant/servant/pull/1262) + + Some APIs need query parameters rewriting, e.g. in order to support + for multiple casing (camel, snake, etc) or something to that effect. + + This could be easily achieved by using WAI Middleware and modyfing + request's `Query`. But QueryParam, QueryParams and QueryFlag use + `rawQueryString`. By using `queryString` rather then `rawQueryString` + we can enable such rewritings. + +- *servant* *servant-server* Make packages `build-type: Simple` [#1263](https://github.com/haskell-servant/servant/pull/1263) + + We used `build-type: Custom`, but it's problematic e.g. + for cross-compiling. The benefit is small, as the doctests + can be run other ways too (though not so conviniently). + 0.16.2 ------ diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,33 +1,2 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -Wall #-} -module Main (main) where - -#ifndef MIN_VERSION_cabal_doctest -#define MIN_VERSION_cabal_doctest(x,y,z) 0 -#endif - -#if MIN_VERSION_cabal_doctest(1,0,0) - -import Distribution.Extra.Doctest ( defaultMainWithDoctests ) -main :: IO () -main = defaultMainWithDoctests "doctests" - -#else - -#ifdef MIN_VERSION_Cabal --- If the macro is defined, we have new cabal-install, --- but for some reason we don't have cabal-doctest in package-db --- --- Probably we are running cabal sdist, when otherwise using new-build --- workflow -#warning You are configuring this package without cabal-doctest installed. \ - The doctests test-suite will not work as a result. \ - To fix this, install cabal-doctest before configuring. -#endif - -import Distribution.Simple - -main :: IO () +import Distribution.Simple main = defaultMain - -#endif diff --git a/servant-server.cabal b/servant-server.cabal --- a/servant-server.cabal +++ b/servant-server.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: servant-server -version: 0.16.2 +version: 0.17 synopsis: A family of combinators for defining webservices APIs and serving them category: Servant, Web @@ -22,13 +22,13 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com copyright: 2014-2016 Zalora South East Asia Pte Ltd, 2016-2019 Servant Contributors -build-type: Custom +build-type: Simple tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.1 + || ==8.8.2 extra-source-files: CHANGELOG.md @@ -38,12 +38,6 @@ type: git location: http://github.com/haskell-servant/servant.git -custom-setup - setup-depends: - base >= 4 && <5, - Cabal, - cabal-doctest >= 1.0.6 && <1.1 - library exposed-modules: Servant @@ -69,7 +63,7 @@ -- Bundled with GHC: Lower bound to not force re-installs -- text and mtl are bundled starting with GHC-8.4 build-depends: - base >= 4.9 && < 4.13 + base >= 4.9 && < 4.14 , bytestring >= 0.10.8.1 && < 0.11 , containers >= 0.5.7.1 && < 0.7 , mtl >= 2.2.2 && < 2.3 @@ -80,13 +74,13 @@ -- Servant dependencies -- strict dependency as we re-export 'servant' things. build-depends: - servant >= 0.16.2 && < 0.16.3 + servant >= 0.16 && < 0.17.1 , http-api-data >= 0.4.1 && < 0.4.2 -- 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: - base-compat >= 0.10.5 && < 0.11 + base-compat >= 0.10.5 && < 0.12 , base64-bytestring >= 1.0.0.1 && < 1.1 , exceptions >= 0.10.0 && < 0.11 , http-media >= 0.7.1.3 && < 0.9 @@ -165,7 +159,7 @@ aeson >= 1.4.1.0 && < 1.5 , directory >= 1.3.0.0 && < 1.4 , hspec >= 2.6.0 && < 2.8 - , hspec-wai >= 0.9.0 && < 0.10 + , hspec-wai >= 0.10.1 && < 0.11 , QuickCheck >= 2.12.6.1 && < 2.14 , should-not-typecheck >= 2.1.0 && < 2.2 , temporary >= 1.3 && < 1.4 @@ -173,16 +167,3 @@ build-tool-depends: hspec-discover:hspec-discover >= 2.6.0 && <2.8 - -test-suite doctests - build-depends: - base - , servant-server - , doctest >= 0.16.0 && <0.17 - type: exitcode-stdio-1.0 - main-is: test/doctests.hs - buildable: True - default-language: Haskell2010 - ghc-options: -Wall -threaded - if impl(ghc >= 8.2) - x-doctest-options: -fdiagnostics-color=never diff --git a/src/Servant/Server.hs b/src/Servant/Server.hs --- a/src/Servant/Server.hs +++ b/src/Servant/Server.hs @@ -110,7 +110,7 @@ -- Example: -- -- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books --- > :<|> "books" :> ReqBody Book :> Post '[JSON] Book -- POST /books +-- > :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- POST /books -- > -- > server :: Server MyApi -- > server = listAllBooks :<|> postBook diff --git a/src/Servant/Server/Internal.hs b/src/Servant/Server/Internal.hs --- a/src/Servant/Server/Internal.hs +++ b/src/Servant/Server/Internal.hs @@ -64,7 +64,7 @@ (SockAddr) import Network.Wai (Application, Request, httpVersion, isSecure, lazyRequestBody, - rawQueryString, remoteHost, requestBody, requestHeaders, + queryString, remoteHost, requestBody, requestHeaders, requestMethod, responseLBS, responseStream, vault) import Prelude () import Prelude.Compat @@ -75,10 +75,12 @@ IsSecure (..), QueryFlag, QueryParam', QueryParams, Raw, ReflectMethod (reflectMethod), RemoteHost, ReqBody', SBool (..), SBoolI (..), SourceIO, Stream, StreamBody', - Summary, ToSourceIO (..), Vault, Verb, WithNamedContext) + Summary, ToSourceIO (..), Vault, Verb, NoContentVerb, + WithNamedContext) import Servant.API.ContentTypes (AcceptHeader (..), AllCTRender (..), AllCTUnrender (..), - AllMime, MimeRender (..), MimeUnrender (..), canHandleAcceptH) + AllMime, MimeRender (..), MimeUnrender (..), canHandleAcceptH, + NoContent) import Servant.API.Modifiers (FoldLenient, FoldRequired, RequestArgument, unfoldRequestArgument) @@ -87,7 +89,7 @@ import qualified Servant.Types.SourceT as S import Web.HttpApiData (FromHttpApiData, parseHeader, parseQueryParam, - parseUrlPieceMaybe, parseUrlPieces) + parseUrlPieces, parseUrlPiece) import Servant.Server.Internal.BasicAuth import Servant.Server.Internal.Context @@ -166,11 +168,11 @@ -- > server = getBook -- > where getBook :: Text -> Handler Book -- > getBook isbn = ... -instance (KnownSymbol capture, FromHttpApiData a, HasServer api context) +instance (KnownSymbol capture, FromHttpApiData a, HasServer api context, SBoolI (FoldLenient mods)) => HasServer (Capture' mods capture a :> api) context where type ServerT (Capture' mods capture a :> api) m = - a -> ServerT api m + If (FoldLenient mods) (Either String a) a -> ServerT api m hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s @@ -178,9 +180,11 @@ CaptureRouter $ route (Proxy :: Proxy api) context - (addCapture d $ \ txt -> case parseUrlPieceMaybe txt of - Nothing -> delayedFail err400 - Just v -> return v + (addCapture d $ \ txt -> case ( sbool :: SBool (FoldLenient mods) + , parseUrlPiece txt :: Either T.Text a) of + (SFalse, Left e) -> delayedFail err400 { errBody = cs e } + (SFalse, Right v) -> return v + (STrue, piece) -> return $ (either (Left . cs) Right) piece ) -- | If you use 'CaptureAll' in one of the endpoints for your API, @@ -260,6 +264,17 @@ let bdy = if allowedMethodHead method request then "" else body in Route $ responseLBS status ((hContentType, cs contentT) : headers) bdy +noContentRouter :: Method + -> Status + -> Delayed env (Handler b) + -> Router env +noContentRouter method status action = leafRouter route' + where + route' env request respond = + runAction (action `addMethodCheck` methodCheck method request) + env request respond $ \ _output -> + Route $ responseLBS status [] "" + instance {-# OVERLAPPABLE #-} ( AllCTRender ctypes a, ReflectMethod method, KnownNat status ) => HasServer (Verb method status ctypes a) context where @@ -283,7 +298,15 @@ where method = reflectMethod (Proxy :: Proxy method) status = toEnum . fromInteger $ natVal (Proxy :: Proxy status) +instance (ReflectMethod method) => + HasServer (NoContentVerb method) context where + type ServerT (NoContentVerb method) m = m NoContent + hoistServerWithContext _ _ nt s = nt s + + route Proxy _ = noContentRouter method status204 + where method = reflectMethod (Proxy :: Proxy method) + instance {-# OVERLAPPABLE #-} ( MimeRender ctype chunk, ReflectMethod method, KnownNat status, FramingRender framing, ToSourceIO chunk a @@ -429,7 +452,7 @@ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s route Proxy context subserver = - let querytext req = parseQueryText $ rawQueryString req + let querytext = queryToQueryText . queryString paramname = cs $ symbolVal (Proxy :: Proxy sym) parseParam :: Request -> DelayedIO (RequestArgument mods a) @@ -496,8 +519,8 @@ params :: [T.Text] params = mapMaybe snd . filter (looksLikeParam . fst) - . parseQueryText - . rawQueryString + . queryToQueryText + . queryString $ req looksLikeParam name = name == paramname || name == (paramname <> "[]") @@ -523,7 +546,7 @@ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s route Proxy context subserver = - let querytext r = parseQueryText $ rawQueryString r + let querytext = queryToQueryText . queryString param r = case lookup paramname (querytext r) of Just Nothing -> True -- param is there, with no value Just (Just v) -> examine v -- param with a value diff --git a/src/Servant/Server/Internal/DelayedIO.hs b/src/Servant/Server/Internal/DelayedIO.hs --- a/src/Servant/Server/Internal/DelayedIO.hs +++ b/src/Servant/Server/Internal/DelayedIO.hs @@ -12,13 +12,12 @@ import Control.Monad.Trans (MonadIO (..), MonadTrans (..)) import Control.Monad.Trans.Control - (ComposeSt, MonadBaseControl (..), MonadTransControl (..), - defaultLiftBaseWith, defaultRestoreM) + (MonadBaseControl (..)) import Control.Monad.Trans.Resource (MonadResource (..), ResourceT, runInternalState, - runResourceT, transResourceT, withInternalState) + transResourceT, withInternalState) import Network.Wai - (Application, Request, Response, ResponseReceived) + (Request) import Servant.Server.Internal.RouteResult import Servant.Server.Internal.ServerError diff --git a/test/Servant/ServerSpec.hs b/test/Servant/ServerSpec.hs --- a/test/Servant/ServerSpec.hs +++ b/test/Servant/ServerSpec.hs @@ -25,6 +25,8 @@ import qualified Data.ByteString.Base64 as Base64 import Data.Char (toUpper) +import Data.Maybe + (fromMaybe) import Data.Proxy (Proxy (Proxy)) import Data.String @@ -35,23 +37,23 @@ import GHC.Generics (Generic) import Network.HTTP.Types - (Status (..), hAccept, hContentType, imATeapot418, + (QueryItem, Status (..), hAccept, hContentType, imATeapot418, methodDelete, methodGet, methodHead, methodPatch, methodPost, methodPut, ok200, parseQuery) import Network.Wai - (Application, Request, pathInfo, queryString, rawQueryString, - requestHeaders, responseLBS) + (Application, Middleware, Request, pathInfo, queryString, + rawQueryString, requestHeaders, responseLBS) import Network.Wai.Test (defaultRequest, request, runSession, simpleBody, simpleHeaders, simpleStatus) import Servant.API ((:<|>) (..), (:>), AuthProtect, BasicAuth, - BasicAuthData (BasicAuthData), Capture, CaptureAll, Delete, - EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..), - JSON, NoContent (..), NoFraming, OctetStream, Patch, - PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw, - RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Verb, - addHeader) + BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll, + Delete, EmptyAPI, Get, Header, Headers, HttpVersion, + IsSecure (..), JSON, Lenient, NoContent (..), NoContentVerb, + NoFraming, OctetStream, Patch, PlainText, Post, Put, + QueryFlag, QueryParam, QueryParams, Raw, RemoteHost, ReqBody, + SourceIO, StdMethod (..), Stream, Strict, Verb, addHeader) import Servant.Server (Context ((:.), EmptyContext), Handler, Server, Tagged (..), emptyServer, err401, err403, err404, serve, serveWithContext) @@ -103,7 +105,7 @@ type VerbApi method status = Verb method status '[JSON] Person - :<|> "noContent" :> Verb method status '[JSON] NoContent + :<|> "noContent" :> NoContentVerb method :<|> "header" :> Verb method status '[JSON] (Headers '[Header "H" Int] Person) :<|> "headerNC" :> Verb method status '[JSON] (Headers '[Header "H" Int] NoContent) :<|> "accept" :> ( Verb method status '[JSON] Person @@ -140,7 +142,7 @@ it "returns no content on NoContent" $ do response <- THW.request method "/noContent" [] "" - liftIO $ statusCode (simpleStatus response) `shouldBe` status + liftIO $ statusCode (simpleStatus response) `shouldBe` 204 liftIO $ simpleBody response `shouldBe` "" -- HEAD should not return body @@ -204,14 +206,28 @@ ------------------------------------------------------------------------------ type CaptureApi = Capture "legs" Integer :> Get '[JSON] Animal + :<|> "ears" :> Capture' '[Lenient] "ears" Integer :> Get '[JSON] Animal + :<|> "eyes" :> Capture' '[Strict] "eyes" Integer :> Get '[JSON] Animal captureApi :: Proxy CaptureApi captureApi = Proxy -captureServer :: Integer -> Handler Animal -captureServer legs = case legs of - 4 -> return jerry - 2 -> return tweety - _ -> throwError err404 +captureServer :: Server CaptureApi +captureServer = getLegs :<|> getEars :<|> getEyes + where getLegs :: Integer -> Handler Animal + getLegs legs = case legs of + 4 -> return jerry + 2 -> return tweety + _ -> throwError err404 + + getEars :: Either String Integer -> Handler Animal + getEars (Left _) = return chimera -- ignore integer parse error, return weird animal + getEars (Right 2) = return jerry + getEars (Right _) = throwError err404 + + getEyes :: Integer -> Handler Animal + getEyes 2 = return jerry + getEyes _ = throwError err404 + captureSpec :: Spec captureSpec = do describe "Servant.API.Capture" $ do @@ -224,6 +240,17 @@ it "returns 400 if the decoding fails" $ do get "/notAnInt" `shouldRespondWith` 400 + it "returns an animal if eyes or ears are 2" $ do + get "/ears/2" `shouldRespondWith` 200 + get "/eyes/2" `shouldRespondWith` 200 + + it "returns a weird animal on Lenient Capture" $ do + response <- get "/ears/bla" + liftIO $ decode' (simpleBody response) `shouldBe` Just chimera + + it "returns 400 if parsing integer fails on Strict Capture" $ do + get "/eyes/bla" `shouldRespondWith` 400 + with (return (serve (Proxy :: Proxy (Capture "captured" String :> Raw)) (\ "captured" -> Tagged $ \request_ respond -> @@ -314,118 +341,124 @@ queryParamServer (Just name_) = return alice{name = name_} queryParamServer Nothing = return alice + + queryParamSpec :: Spec queryParamSpec = do + let mkRequest params pinfo = Network.Wai.Test.request defaultRequest + { rawQueryString = params + , queryString = parseQuery params + , pathInfo = pinfo + } + describe "Servant.API.QueryParam" $ do it "allows retrieving simple GET parameters" $ - (flip runSession) (serve queryParamApi qpServer) $ do - let params1 = "?name=bob" - response1 <- Network.Wai.Test.request defaultRequest{ - rawQueryString = params1, - queryString = parseQuery params1 - } - liftIO $ do - decode' (simpleBody response1) `shouldBe` Just alice{ - name = "bob" - } + flip runSession (serve queryParamApi qpServer) $ do + response1 <- mkRequest "?name=bob" [] + liftIO $ decode' (simpleBody response1) `shouldBe` Just alice + { name = "bob" + } it "allows retrieving lists in GET parameters" $ - (flip runSession) (serve queryParamApi qpServer) $ do - let params2 = "?names[]=bob&names[]=john" - response2 <- Network.Wai.Test.request defaultRequest{ - rawQueryString = params2, - queryString = parseQuery params2, - pathInfo = ["a"] - } - liftIO $ - decode' (simpleBody response2) `shouldBe` Just alice{ - name = "john" - } + flip runSession (serve queryParamApi qpServer) $ do + response2 <- mkRequest "?names[]=bob&names[]=john" ["a"] + liftIO $ decode' (simpleBody response2) `shouldBe` Just alice + { name = "john" + } it "parses a query parameter" $ - (flip runSession) (serve queryParamApi qpServer) $ do - let params = "?age=55" - response <- Network.Wai.Test.request defaultRequest{ - rawQueryString = params, - queryString = parseQuery params, - pathInfo = ["param"] - } - liftIO $ - decode' (simpleBody response) `shouldBe` Just alice{ - age = 55 - } + flip runSession (serve queryParamApi qpServer) $ do + response <- mkRequest "?age=55" ["param"] + liftIO $ decode' (simpleBody response) `shouldBe` Just alice + { age = 55 + } it "generates an error on query parameter parse failure" $ - (flip runSession) (serve queryParamApi qpServer) $ do - let params = "?age=foo" - response <- Network.Wai.Test.request defaultRequest{ - rawQueryString = params, - queryString = parseQuery params, - pathInfo = ["param"] - } + flip runSession (serve queryParamApi qpServer) $ do + response <- mkRequest "?age=foo" ["param"] liftIO $ statusCode (simpleStatus response) `shouldBe` 400 return () it "parses multiple query parameters" $ - (flip runSession) (serve queryParamApi qpServer) $ do - let params = "?ages=10&ages=22" - response <- Network.Wai.Test.request defaultRequest{ - rawQueryString = params, - queryString = parseQuery params, - pathInfo = ["multiparam"] - } - liftIO $ - decode' (simpleBody response) `shouldBe` Just alice{ - age = 32 - } + flip runSession (serve queryParamApi qpServer) $ do + response <- mkRequest "?ages=10&ages=22" ["multiparam"] + liftIO $ decode' (simpleBody response) `shouldBe` Just alice + { age = 32 + } it "generates an error on parse failures of multiple parameters" $ - (flip runSession) (serve queryParamApi qpServer) $ do - let params = "?ages=2&ages=foo" - response <- Network.Wai.Test.request defaultRequest{ - rawQueryString = params, - queryString = parseQuery params, - pathInfo = ["multiparam"] - } + flip runSession (serve queryParamApi qpServer) $ do + response <- mkRequest "?ages=2&ages=foo" ["multiparam"] liftIO $ statusCode (simpleStatus response) `shouldBe` 400 return () - it "allows retrieving value-less GET parameters" $ - (flip runSession) (serve queryParamApi qpServer) $ do - let params3 = "?capitalize" - response3 <- Network.Wai.Test.request defaultRequest{ - rawQueryString = params3, - queryString = parseQuery params3, - pathInfo = ["b"] - } - liftIO $ - decode' (simpleBody response3) `shouldBe` Just alice{ - name = "ALICE" - } + flip runSession (serve queryParamApi qpServer) $ do + response3 <- mkRequest "?capitalize" ["b"] + liftIO $ decode' (simpleBody response3) `shouldBe` Just alice + { name = "ALICE" + } - let params3' = "?capitalize=" - response3' <- Network.Wai.Test.request defaultRequest{ - rawQueryString = params3', - queryString = parseQuery params3', - pathInfo = ["b"] - } - liftIO $ - decode' (simpleBody response3') `shouldBe` Just alice{ - name = "ALICE" - } + response3' <- mkRequest "?capitalize=" ["b"] + liftIO $ decode' (simpleBody response3') `shouldBe` Just alice + { name = "ALICE" + } - let params3'' = "?unknown=" - response3'' <- Network.Wai.Test.request defaultRequest{ - rawQueryString = params3'', - queryString = parseQuery params3'', - pathInfo = ["b"] - } - liftIO $ - decode' (simpleBody response3'') `shouldBe` Just alice{ - name = "Alice" - } + response3'' <- mkRequest "?unknown=" ["b"] + liftIO $ decode' (simpleBody response3'') `shouldBe` Just alice + { name = "Alice" + } + describe "Uses queryString instead of rawQueryString" $ do + -- test query parameters rewriter + let queryRewriter :: Middleware + queryRewriter app req = app req + { queryString = fmap rewrite $ queryString req + } + where + rewrite :: QueryItem -> QueryItem + rewrite (k, v) = (fromMaybe k (BS.stripPrefix "person_" k), v) + + let app = queryRewriter $ serve queryParamApi qpServer + + it "allows rewriting for simple GET/query parameters" $ + flip runSession app $ do + response1 <- mkRequest "?person_name=bob" [] + liftIO $ decode' (simpleBody response1) `shouldBe` Just alice + { name = "bob" + } + + it "allows rewriting for lists in GET parameters" $ + flip runSession app $ do + response2 <- mkRequest "?person_names[]=bob&person_names[]=john" ["a"] + liftIO $ decode' (simpleBody response2) `shouldBe` Just alice + { name = "john" + } + + it "allows rewriting when parsing multiple query parameters" $ + flip runSession app $ do + response <- mkRequest "?person_ages=10&person_ages=22" ["multiparam"] + liftIO $ decode' (simpleBody response) `shouldBe` Just alice + { age = 32 + } + + it "allows retrieving value-less GET parameters" $ + flip runSession app $ do + response3 <- mkRequest "?person_capitalize" ["b"] + liftIO $ decode' (simpleBody response3) `shouldBe` Just alice + { name = "ALICE" + } + + response3' <- mkRequest "?person_capitalize=" ["b"] + liftIO $ decode' (simpleBody response3') `shouldBe` Just alice + { name = "ALICE" + } + + response3'' <- mkRequest "?person_unknown=" ["b"] + liftIO $ decode' (simpleBody response3'') `shouldBe` Just alice + { name = "Alice" + } + -- }}} ------------------------------------------------------------------------------ -- * reqBodySpec {{{ @@ -519,7 +552,7 @@ rawSpec = do describe "Servant.API.Raw" $ do it "runs applications" $ do - (flip runSession) (serve rawApi (rawApplication (const (42 :: Integer)))) $ do + flip runSession (serve rawApi (rawApplication (const (42 :: Integer)))) $ do response <- Network.Wai.Test.request defaultRequest{ pathInfo = ["foo"] } @@ -527,7 +560,7 @@ simpleBody response `shouldBe` "42" it "gets the pathInfo modified" $ do - (flip runSession) (serve rawApi (rawApplication pathInfo)) $ do + flip runSession (serve rawApi (rawApplication pathInfo)) $ do response <- Network.Wai.Test.request defaultRequest{ pathInfo = ["foo", "bar"] } @@ -779,6 +812,10 @@ tweety :: Animal tweety = Animal "Bird" 2 + +-- weird animal with non-integer amount of ears +chimera :: Animal +chimera = Animal "Chimera" (-1) beholder :: Animal beholder = Animal "Beholder" 0 diff --git a/test/doctests.hs b/test/doctests.hs deleted file mode 100644 --- a/test/doctests.hs +++ /dev/null @@ -1,27 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Main (doctests) --- Copyright : (C) 2012-14 Edward Kmett --- License : BSD-style (see the file LICENSE) --- Maintainer : Edward Kmett --- Stability : provisional --- Portability : portable --- --- This module provides doctests for a project based on the actual versions --- of the packages it was built with. It requires a corresponding Setup.lhs --- to be added to the project ------------------------------------------------------------------------------ -module Main where - -import Build_doctests - (flags, module_sources, pkgs) -import Data.Foldable - (traverse_) -import Test.DocTest - -main :: IO () -main = do - traverse_ putStrLn args - doctest args - where - args = flags ++ pkgs ++ module_sources