@@ -25,6 +25,8 @@ import qualified Data.ByteString as BS
2525import qualified Data.ByteString.Base64 as Base64
2626import Data.Char
2727 (toUpper)
28+import Data.Maybe
29+ (fromMaybe)
2830import Data.Proxy
2931 (Proxy (Proxy))
3032import Data.String
@@ -35,26 +37,26 @@ import qualified Data.Text as T
3537import GHC.Generics
3638 (Generic)
3739import Network.HTTP.Types
38− (Status (..), hAccept, hContentType, imATeapot418,
40+ (QueryItem, Status (..), hAccept, hContentType, imATeapot418,
3941 methodDelete, methodGet, methodHead, methodPatch, methodPost,
4042 methodPut, ok200, parseQuery)
4143import Network.Wai
42− (Application, Request, pathInfo, queryString, rawQueryString,
43− requestHeaders, responseLBS)
44+ (Application, Middleware, Request, pathInfo, queryString,
45+ rawQueryString, requestHeaders, responseLBS)
4446import Network.Wai.Test
4547 (defaultRequest, request, runSession, simpleBody,
4648 simpleHeaders, simpleStatus)
4749import Servant.API
4850 ((:<|>) (..), (:>), AuthProtect, BasicAuth,
49− BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll, Lenient, Strict, Delete,
50− EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..),
51− JSON, NoContent (..), NoFraming, OctetStream, Patch,
52− PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
53− RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Verb,
54− NoContentVerb, addHeader)
51+ BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll,
52+ Delete, EmptyAPI, Get, Header, Headers, HttpVersion,
53+ IsSecure (..), JSON, Lenient, NoContent (..), NoContentVerb,
54+ NoFraming, OctetStream, Patch, PlainText, Post, Put,
55+ QueryFlag, QueryParam, QueryParams, Raw, RemoteHost, ReqBody,
56+ SourceIO, StdMethod (..), Stream, Strict, Verb, addHeader)
5557import Servant.Server
5658 (Context ((:.), EmptyContext), Handler, Server, Tagged (..),
57− emptyServer, err400, err401, err403, err404, serve, serveWithContext)
59+ emptyServer, err401, err403, err404, serve, serveWithContext)
5860import Servant.Test.ComprehensiveAPI
5961import qualified Servant.Types.SourceT as S
6062import Test.Hspec
@@ -218,7 +220,7 @@ captureServer = getLegs :<|> getEars :<|> getEyes
218220 _ -> throwError err404
219221
220222 getEars :: Either String Integer -> Handler Animal
221− getEars (Left e) = return chimera -- ignore integer parse error, return weird animal
223+ getEars (Left _) = return chimera -- ignore integer parse error, return weird animal
222224 getEars (Right 2) = return jerry
223225 getEars (Right _) = throwError err404
224226
@@ -339,117 +341,123 @@ qpServer = queryParamServer :<|> qpNames :<|> qpCapitalize :<|> qpAge :<|> qpAge
339341 queryParamServer (Just name_) = return alice{name = name_}
340342 queryParamServer Nothing = return alice
341343
344+
345+
342346queryParamSpec :: Spec
343347queryParamSpec = do
348+ let mkRequest params pinfo = Network.Wai.Test.request defaultRequest
349+ { rawQueryString = params
350+ , queryString = parseQuery params
351+ , pathInfo = pinfo
352+ }
353+
344354 describe "Servant.API.QueryParam" $ do
345355 it "allows retrieving simple GET parameters" $
346− (flip runSession) (serve queryParamApi qpServer) $ do
347− let params1 = "?name=bob"
348− response1 <- Network.Wai.Test.request defaultRequest{
349− rawQueryString = params1,
350− queryString = parseQuery params1
351− }
352− liftIO $ do
353− decode' (simpleBody response1) `shouldBe` Just alice{
354− name = "bob"
355− }
356+ flip runSession (serve queryParamApi qpServer) $ do
357+ response1 <- mkRequest "?name=bob" []
358+ liftIO $ decode' (simpleBody response1) `shouldBe` Just alice
359+ { name = "bob"
360+ }
356361
357362 it "allows retrieving lists in GET parameters" $
358− (flip runSession) (serve queryParamApi qpServer) $ do
359− let params2 = "?names[]=bob&names[]=john"
360− response2 <- Network.Wai.Test.request defaultRequest{
361− rawQueryString = params2,
362− queryString = parseQuery params2,
363− pathInfo = ["a"]
364− }
365− liftIO $
366− decode' (simpleBody response2) `shouldBe` Just alice{
367− name = "john"
368− }
363+ flip runSession (serve queryParamApi qpServer) $ do
364+ response2 <- mkRequest "?names[]=bob&names[]=john" ["a"]
365+ liftIO $ decode' (simpleBody response2) `shouldBe` Just alice
366+ { name = "john"
367+ }
369368
370369 it "parses a query parameter" $
371− (flip runSession) (serve queryParamApi qpServer) $ do
372− let params = "?age=55"
373− response <- Network.Wai.Test.request defaultRequest{
374− rawQueryString = params,
375− queryString = parseQuery params,
376− pathInfo = ["param"]
377− }
378− liftIO $
379− decode' (simpleBody response) `shouldBe` Just alice{
380− age = 55
381− }
370+ flip runSession (serve queryParamApi qpServer) $ do
371+ response <- mkRequest "?age=55" ["param"]
372+ liftIO $ decode' (simpleBody response) `shouldBe` Just alice
373+ { age = 55
374+ }
382375
383376 it "generates an error on query parameter parse failure" $
384− (flip runSession) (serve queryParamApi qpServer) $ do
385− let params = "?age=foo"
386− response <- Network.Wai.Test.request defaultRequest{
387− rawQueryString = params,
388− queryString = parseQuery params,
389− pathInfo = ["param"]
390− }
377+ flip runSession (serve queryParamApi qpServer) $ do
378+ response <- mkRequest "?age=foo" ["param"]
391379 liftIO $ statusCode (simpleStatus response) `shouldBe` 400
392380 return ()
393381
394382 it "parses multiple query parameters" $
395− (flip runSession) (serve queryParamApi qpServer) $ do
396− let params = "?ages=10&ages=22"
397− response <- Network.Wai.Test.request defaultRequest{
398− rawQueryString = params,
399− queryString = parseQuery params,
400− pathInfo = ["multiparam"]
401− }
402− liftIO $
403− decode' (simpleBody response) `shouldBe` Just alice{
404− age = 32
405− }
383+ flip runSession (serve queryParamApi qpServer) $ do
384+ response <- mkRequest "?ages=10&ages=22" ["multiparam"]
385+ liftIO $ decode' (simpleBody response) `shouldBe` Just alice
386+ { age = 32
387+ }
406388
407389 it "generates an error on parse failures of multiple parameters" $
408− (flip runSession) (serve queryParamApi qpServer) $ do
409− let params = "?ages=2&ages=foo"
410− response <- Network.Wai.Test.request defaultRequest{
411− rawQueryString = params,
412− queryString = parseQuery params,
413− pathInfo = ["multiparam"]
414− }
390+ flip runSession (serve queryParamApi qpServer) $ do
391+ response <- mkRequest "?ages=2&ages=foo" ["multiparam"]
415392 liftIO $ statusCode (simpleStatus response) `shouldBe` 400
416393 return ()
417394
418−
419395 it "allows retrieving value-less GET parameters" $
420− (flip runSession) (serve queryParamApi qpServer) $ do
421− let params3 = "?capitalize"
422− response3 <- Network.Wai.Test.request defaultRequest{
423− rawQueryString = params3,
424− queryString = parseQuery params3,
425− pathInfo = ["b"]
426− }
427− liftIO $
428− decode' (simpleBody response3) `shouldBe` Just alice{
429− name = "ALICE"
430− }
431−
432− let params3' = "?capitalize="
433− response3' <- Network.Wai.Test.request defaultRequest{
434− rawQueryString = params3',
435− queryString = parseQuery params3',
436− pathInfo = ["b"]
437− }
438− liftIO $
439− decode' (simpleBody response3') `shouldBe` Just alice{
440− name = "ALICE"
441− }
442−
443− let params3'' = "?unknown="
444− response3'' <- Network.Wai.Test.request defaultRequest{
445− rawQueryString = params3'',
446− queryString = parseQuery params3'',
447− pathInfo = ["b"]
448− }
449− liftIO $
450− decode' (simpleBody response3'') `shouldBe` Just alice{
451− name = "Alice"
452− }
396+ flip runSession (serve queryParamApi qpServer) $ do
397+ response3 <- mkRequest "?capitalize" ["b"]
398+ liftIO $ decode' (simpleBody response3) `shouldBe` Just alice
399+ { name = "ALICE"
400+ }
401+
402+ response3' <- mkRequest "?capitalize=" ["b"]
403+ liftIO $ decode' (simpleBody response3') `shouldBe` Just alice
404+ { name = "ALICE"
405+ }
406+
407+ response3'' <- mkRequest "?unknown=" ["b"]
408+ liftIO $ decode' (simpleBody response3'') `shouldBe` Just alice
409+ { name = "Alice"
410+ }
411+
412+ describe "Uses queryString instead of rawQueryString" $ do
413+ -- test query parameters rewriter
414+ let queryRewriter :: Middleware
415+ queryRewriter app req = app req
416+ { queryString = fmap rewrite $ queryString req
417+ }
418+ where
419+ rewrite :: QueryItem -> QueryItem
420+ rewrite (k, v) = (fromMaybe k (BS.stripPrefix "person_" k), v)
421+
422+ let app = queryRewriter $ serve queryParamApi qpServer
423+
424+ it "allows rewriting for simple GET/query parameters" $
425+ flip runSession app $ do
426+ response1 <- mkRequest "?person_name=bob" []
427+ liftIO $ decode' (simpleBody response1) `shouldBe` Just alice
428+ { name = "bob"
429+ }
430+
431+ it "allows rewriting for lists in GET parameters" $
432+ flip runSession app $ do
433+ response2 <- mkRequest "?person_names[]=bob&person_names[]=john" ["a"]
434+ liftIO $ decode' (simpleBody response2) `shouldBe` Just alice
435+ { name = "john"
436+ }
437+
438+ it "allows rewriting when parsing multiple query parameters" $
439+ flip runSession app $ do
440+ response <- mkRequest "?person_ages=10&person_ages=22" ["multiparam"]
441+ liftIO $ decode' (simpleBody response) `shouldBe` Just alice
442+ { age = 32
443+ }
444+
445+ it "allows retrieving value-less GET parameters" $
446+ flip runSession app $ do
447+ response3 <- mkRequest "?person_capitalize" ["b"]
448+ liftIO $ decode' (simpleBody response3) `shouldBe` Just alice
449+ { name = "ALICE"
450+ }
451+
452+ response3' <- mkRequest "?person_capitalize=" ["b"]
453+ liftIO $ decode' (simpleBody response3') `shouldBe` Just alice
454+ { name = "ALICE"
455+ }
456+
457+ response3'' <- mkRequest "?person_unknown=" ["b"]
458+ liftIO $ decode' (simpleBody response3'') `shouldBe` Just alice
459+ { name = "Alice"
460+ }
453461
454462-- }}}
455463------------------------------------------------------------------------------
@@ -544,7 +552,7 @@ rawSpec :: Spec
544552rawSpec = do
545553 describe "Servant.API.Raw" $ do
546554 it "runs applications" $ do
547− (flip runSession) (serve rawApi (rawApplication (const (42 :: Integer)))) $ do
555+ flip runSession (serve rawApi (rawApplication (const (42 :: Integer)))) $ do
548556 response <- Network.Wai.Test.request defaultRequest{
549557 pathInfo = ["foo"]
550558 }
@@ -552,7 +560,7 @@ rawSpec = do
552560 simpleBody response `shouldBe` "42"
553561
554562 it "gets the pathInfo modified" $ do
555− (flip runSession) (serve rawApi (rawApplication pathInfo)) $ do
563+ flip runSession (serve rawApi (rawApplication pathInfo)) $ do
556564 response <- Network.Wai.Test.request defaultRequest{
557565 pathInfo = ["foo", "bar"]
558566 }