ec0cd8a · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

Merge pull request #1262 from haskell-servant/rawQueryString

ec0cd8aOleg Grenrus7 years ago

changelog.d/pr1249new file+14

compare with master

unifiedsplit

@@ -0,0 +1,14 @@

1+synopsis: use queryString to parse QueryParam, QueryParams and QueryFlag

2+packages: servant-server

3+prs: #1249

4+description: {

6+Some APIs need query parameters rewriting, e.g. in order to support

7+ for multiple casing (camel, snake, etc) or something to that effect.

9+This could be easily achieved by using WAI Middleware and modyfing

10+request's `Query`. But QueryParam, QueryParams and QueryFlag use

11+`rawQueryString`. By using `queryString` rather then `rawQueryString`

12+we can enable such rewritings.

13+

14+}

servant-server/src/Servant/Server/Internal.hs+5−5

@@ -64,7 +64,7 @@ import Network.Socket

64 (SockAddr)

65import Network.Wai

66 (Application, Request, httpVersion, isSecure, lazyRequestBody,

67− rawQueryString, remoteHost, requestBody, requestHeaders,

67+ queryString, remoteHost, requestBody, requestHeaders,

68 requestMethod, responseLBS, responseStream, vault)

69import Prelude ()

70import Prelude.Compat

@@ -452,7 +452,7 @@ instance

452 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

453

454 route Proxy context subserver =

455− let querytext req = parseQueryText $ rawQueryString req

455+ let querytext = queryToQueryText . queryString

456 paramname = cs $ symbolVal (Proxy :: Proxy sym)

457

458 parseParam :: Request -> DelayedIO (RequestArgument mods a)

@@ -519,8 +519,8 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer api context)

519 params :: [T.Text]

520 params = mapMaybe snd

521 . filter (looksLikeParam . fst)

522− . parseQueryText

522+ . queryToQueryText

523− . rawQueryString

523+ . queryString

524 $ req

525

526 looksLikeParam name = name == paramname || name == (paramname <> "[]")

@@ -546,7 +546,7 @@ instance (KnownSymbol sym, HasServer api context)

546 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

547

548 route Proxy context subserver =

549− let querytext r = parseQueryText $ rawQueryString r

549+ let querytext = queryToQueryText . queryString

550 param r = case lookup paramname (querytext r) of

551 Just Nothing -> True -- param is there, with no value

552 Just (Just v) -> examine v -- param with a value

servant-server/test/Servant/ServerSpec.hs+112−104

@@ -25,6 +25,8 @@ import qualified Data.ByteString as BS

25import qualified Data.ByteString.Base64 as Base64

26import Data.Char

27 (toUpper)

28+import Data.Maybe

29+ (fromMaybe)

28import Data.Proxy

30import Data.Proxy

29 (Proxy (Proxy))

31 (Proxy (Proxy))

30import Data.String

32import Data.String

@@ -35,26 +37,26 @@ import qualified Data.Text as T

35import GHC.Generics

37import GHC.Generics

36 (Generic)

38 (Generic)

37import Network.HTTP.Types

39import Network.HTTP.Types

38− (Status (..), hAccept, hContentType, imATeapot418,

40+ (QueryItem, Status (..), hAccept, hContentType, imATeapot418,

39 methodDelete, methodGet, methodHead, methodPatch, methodPost,

41 methodDelete, methodGet, methodHead, methodPatch, methodPost,

40 methodPut, ok200, parseQuery)

42 methodPut, ok200, parseQuery)

41import Network.Wai

43import Network.Wai

42− (Application, Request, pathInfo, queryString, rawQueryString,

44+ (Application, Middleware, Request, pathInfo, queryString,

43− requestHeaders, responseLBS)

45+ rawQueryString, requestHeaders, responseLBS)

44import Network.Wai.Test

46import Network.Wai.Test

45 (defaultRequest, request, runSession, simpleBody,

47 (defaultRequest, request, runSession, simpleBody,

46 simpleHeaders, simpleStatus)

48 simpleHeaders, simpleStatus)

47import Servant.API

49import Servant.API

48 ((:<|>) (..), (:>), AuthProtect, BasicAuth,

50 ((:<|>) (..), (:>), AuthProtect, BasicAuth,

49− BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll, Lenient, Strict, Delete,

51+ BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll,

50− EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..),

52+ Delete, EmptyAPI, Get, Header, Headers, HttpVersion,

53+ IsSecure (..), JSON, Lenient, NoContent (..), NoContentVerb,

51− JSON, NoContent (..), NoFraming, OctetStream, Patch,

54+ NoFraming, OctetStream, Patch, PlainText, Post, Put,

52− PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,

55+ QueryFlag, QueryParam, QueryParams, Raw, RemoteHost, ReqBody,

53− RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Verb,

56+ SourceIO, StdMethod (..), Stream, Strict, Verb, addHeader)

54− NoContentVerb, addHeader)

55import Servant.Server

57import Servant.Server

56 (Context ((:.), EmptyContext), Handler, Server, Tagged (..),

58 (Context ((:.), EmptyContext), Handler, Server, Tagged (..),

57− emptyServer, err400, err401, err403, err404, serve, serveWithContext)

59+ emptyServer, err401, err403, err404, serve, serveWithContext)

58import Servant.Test.ComprehensiveAPI

60import Servant.Test.ComprehensiveAPI

59import qualified Servant.Types.SourceT as S

61import qualified Servant.Types.SourceT as S

60import Test.Hspec

62import Test.Hspec

@@ -218,7 +220,7 @@ captureServer = getLegs :<|> getEars :<|> getEyes

218 _ -> throwError err404

220 _ -> throwError err404

219

221

220 getEars :: Either String Integer -> Handler Animal

222 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

222 getEars (Right 2) = return jerry

224 getEars (Right 2) = return jerry

223 getEars (Right _) = throwError err404

225 getEars (Right _) = throwError err404

224

226

@@ -339,117 +341,123 @@ qpServer = queryParamServer :<|> qpNames :<|> qpCapitalize :<|> qpAge :<|> qpAge

339 queryParamServer (Just name_) = return alice{name = name_}

341 queryParamServer (Just name_) = return alice{name = name_}

340 queryParamServer Nothing = return alice

342 queryParamServer Nothing = return alice

341

343

344+

345+

342queryParamSpec :: Spec

346queryParamSpec :: Spec

343queryParamSpec = do

347queryParamSpec = do

348+ let mkRequest params pinfo = Network.Wai.Test.request defaultRequest

349+ { rawQueryString = params

350+ , queryString = parseQuery params

351+ , pathInfo = pinfo

352+ }

353+

344 describe "Servant.API.QueryParam" $ do

354 describe "Servant.API.QueryParam" $ do

345 it "allows retrieving simple GET parameters" $

355 it "allows retrieving simple GET parameters" $

346− (flip runSession) (serve queryParamApi qpServer) $ do

356+ flip runSession (serve queryParamApi qpServer) $ do

347− let params1 = "?name=bob"

357+ response1 <- mkRequest "?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{

358+ liftIO $ decode' (simpleBody response1) `shouldBe` Just alice

354− name = "bob"

359+ { name = "bob"

355− }

360+ }

356

361

357 it "allows retrieving lists in GET parameters" $

362 it "allows retrieving lists in GET parameters" $

358− (flip runSession) (serve queryParamApi qpServer) $ do

363+ flip runSession (serve queryParamApi qpServer) $ do

359− let params2 = "?names[]=bob&names[]=john"

364+ response2 <- mkRequest "?names[]=bob&names[]=john" ["a"]

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{

365+ liftIO $ decode' (simpleBody response2) `shouldBe` Just alice

367− name = "john"

366+ { name = "john"

368− }

367+ }

369

368

370 it "parses a query parameter" $

369 it "parses a query parameter" $

371− (flip runSession) (serve queryParamApi qpServer) $ do

370+ flip runSession (serve queryParamApi qpServer) $ do

372− let params = "?age=55"

371+ response <- mkRequest "?age=55" ["param"]

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{

372+ liftIO $ decode' (simpleBody response) `shouldBe` Just alice

380− age = 55

373+ { age = 55

381− }

374+ }

382

375

383 it "generates an error on query parameter parse failure" $

376 it "generates an error on query parameter parse failure" $

384− (flip runSession) (serve queryParamApi qpServer) $ do

377+ flip runSession (serve queryParamApi qpServer) $ do

385− let params = "?age=foo"

378+ response <- mkRequest "?age=foo" ["param"]

386− response <- Network.Wai.Test.request defaultRequest{

387− rawQueryString = params,

388− queryString = parseQuery params,

389− pathInfo = ["param"]

390− }

391 liftIO $ statusCode (simpleStatus response) `shouldBe` 400

379 liftIO $ statusCode (simpleStatus response) `shouldBe` 400

392 return ()

380 return ()

393

381

394 it "parses multiple query parameters" $

382 it "parses multiple query parameters" $

395− (flip runSession) (serve queryParamApi qpServer) $ do

383+ flip runSession (serve queryParamApi qpServer) $ do

396− let params = "?ages=10&ages=22"

384+ response <- mkRequest "?ages=10&ages=22" ["multiparam"]

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{

385+ liftIO $ decode' (simpleBody response) `shouldBe` Just alice

404− age = 32

386+ { age = 32

405− }

387+ }

406

388

407 it "generates an error on parse failures of multiple parameters" $

389 it "generates an error on parse failures of multiple parameters" $

408− (flip runSession) (serve queryParamApi qpServer) $ do

390+ flip runSession (serve queryParamApi qpServer) $ do

409− let params = "?ages=2&ages=foo"

391+ response <- mkRequest "?ages=2&ages=foo" ["multiparam"]

410− response <- Network.Wai.Test.request defaultRequest{

411− rawQueryString = params,

412− queryString = parseQuery params,

413− pathInfo = ["multiparam"]

414− }

415 liftIO $ statusCode (simpleStatus response) `shouldBe` 400

392 liftIO $ statusCode (simpleStatus response) `shouldBe` 400

416 return ()

393 return ()

417

394

418−

419 it "allows retrieving value-less GET parameters" $

395 it "allows retrieving value-less GET parameters" $

420− (flip runSession) (serve queryParamApi qpServer) $ do

396+ flip runSession (serve queryParamApi qpServer) $ do

421− let params3 = "?capitalize"

397+ response3 <- mkRequest "?capitalize" ["b"]

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{

398+ liftIO $ decode' (simpleBody response3) `shouldBe` Just alice

429− name = "ALICE"

399+ { name = "ALICE"

430− }

400+ }

431−

401+

432− let params3' = "?capitalize="

402+ response3' <- mkRequest "?capitalize=" ["b"]

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{

403+ liftIO $ decode' (simpleBody response3') `shouldBe` Just alice

440− name = "ALICE"

404+ { name = "ALICE"

441− }

405+ }

442−

406+

443− let params3'' = "?unknown="

407+ response3'' <- mkRequest "?unknown=" ["b"]

444− response3'' <- Network.Wai.Test.request defaultRequest{

408+ liftIO $ decode' (simpleBody response3'') `shouldBe` Just alice

445− rawQueryString = params3'',

409+ { name = "Alice"

446− queryString = parseQuery params3'',

410+ }

447− pathInfo = ["b"]

411+

448− }

412+ describe "Uses queryString instead of rawQueryString" $ do

449− liftIO $

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"]

450− decode' (simpleBody response3'') `shouldBe` Just alice{

458+ liftIO $ decode' (simpleBody response3'') `shouldBe` Just alice

451− name = "Alice"

459+ { name = "Alice"

452− }

460+ }

453

461

454-- }}}

462-- }}}

455------------------------------------------------------------------------------

463------------------------------------------------------------------------------

@@ -544,7 +552,7 @@ rawSpec :: Spec

544rawSpec = do

552rawSpec = do

545 describe "Servant.API.Raw" $ do

553 describe "Servant.API.Raw" $ do

546 it "runs applications" $ do

554 it "runs applications" $ do

547− (flip runSession) (serve rawApi (rawApplication (const (42 :: Integer)))) $ do

555+ flip runSession (serve rawApi (rawApplication (const (42 :: Integer)))) $ do

548 response <- Network.Wai.Test.request defaultRequest{

556 response <- Network.Wai.Test.request defaultRequest{

549 pathInfo = ["foo"]

557 pathInfo = ["foo"]

550 }

558 }

@@ -552,7 +560,7 @@ rawSpec = do

552 simpleBody response `shouldBe` "42"

560 simpleBody response `shouldBe` "42"

553

561

554 it "gets the pathInfo modified" $ do

562 it "gets the pathInfo modified" $ do

555− (flip runSession) (serve rawApi (rawApplication pathInfo)) $ do

563+ flip runSession (serve rawApi (rawApplication pathInfo)) $ do

556 response <- Network.Wai.Test.request defaultRequest{

564 response <- Network.Wai.Test.request defaultRequest{

557 pathInfo = ["foo", "bar"]

565 pathInfo = ["foo", "bar"]

558 }

566 }