add query rewriting tests and changelog item
add prs: #1249 add ps1249 changelog item
This commit is contained in:
parent
28c4533659
commit
40582c40e4
14
changelog.d/pr1249
Normal file
14
changelog.d/pr1249
Normal file
|
@ -0,0 +1,14 @@
|
||||||
|
synopsis: use queryString to parse QueryParam, QueryParams and QueryFlag
|
||||||
|
packages: servant-server
|
||||||
|
prs: #1249
|
||||||
|
description: {
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
|
}
|
|
@ -25,6 +25,8 @@ import qualified Data.ByteString as BS
|
||||||
import qualified Data.ByteString.Base64 as Base64
|
import qualified Data.ByteString.Base64 as Base64
|
||||||
import Data.Char
|
import Data.Char
|
||||||
(toUpper)
|
(toUpper)
|
||||||
|
import Data.Maybe
|
||||||
|
(fromMaybe)
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
(Proxy (Proxy))
|
(Proxy (Proxy))
|
||||||
import Data.String
|
import Data.String
|
||||||
|
@ -35,26 +37,26 @@ import qualified Data.Text as T
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
(Generic)
|
(Generic)
|
||||||
import Network.HTTP.Types
|
import Network.HTTP.Types
|
||||||
(Status (..), hAccept, hContentType, imATeapot418,
|
(QueryItem, Status (..), hAccept, hContentType, imATeapot418,
|
||||||
methodDelete, methodGet, methodHead, methodPatch, methodPost,
|
methodDelete, methodGet, methodHead, methodPatch, methodPost,
|
||||||
methodPut, ok200, parseQuery)
|
methodPut, ok200, parseQuery)
|
||||||
import Network.Wai
|
import Network.Wai
|
||||||
(Application, Request, pathInfo, queryString, rawQueryString,
|
(Application, Middleware, Request, pathInfo, queryString,
|
||||||
requestHeaders, responseLBS)
|
rawQueryString, requestHeaders, responseLBS)
|
||||||
import Network.Wai.Test
|
import Network.Wai.Test
|
||||||
(defaultRequest, request, runSession, simpleBody,
|
(defaultRequest, request, runSession, simpleBody,
|
||||||
simpleHeaders, simpleStatus)
|
simpleHeaders, simpleStatus)
|
||||||
import Servant.API
|
import Servant.API
|
||||||
((:<|>) (..), (:>), AuthProtect, BasicAuth,
|
((:<|>) (..), (:>), AuthProtect, BasicAuth,
|
||||||
BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll, Lenient, Strict, Delete,
|
BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll,
|
||||||
EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..),
|
Delete, EmptyAPI, Get, Header, Headers, HttpVersion,
|
||||||
JSON, NoContent (..), NoFraming, OctetStream, Patch,
|
IsSecure (..), JSON, Lenient, NoContent (..), NoContentVerb,
|
||||||
PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
|
NoFraming, OctetStream, Patch, PlainText, Post, Put,
|
||||||
RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Verb,
|
QueryFlag, QueryParam, QueryParams, Raw, RemoteHost, ReqBody,
|
||||||
NoContentVerb, addHeader)
|
SourceIO, StdMethod (..), Stream, Strict, Verb, addHeader)
|
||||||
import Servant.Server
|
import Servant.Server
|
||||||
(Context ((:.), EmptyContext), Handler, Server, Tagged (..),
|
(Context ((:.), EmptyContext), Handler, Server, Tagged (..),
|
||||||
emptyServer, err400, err401, err403, err404, serve, serveWithContext)
|
emptyServer, err401, err403, err404, serve, serveWithContext)
|
||||||
import Servant.Test.ComprehensiveAPI
|
import Servant.Test.ComprehensiveAPI
|
||||||
import qualified Servant.Types.SourceT as S
|
import qualified Servant.Types.SourceT as S
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
|
@ -218,7 +220,7 @@ captureServer = getLegs :<|> getEars :<|> getEyes
|
||||||
_ -> throwError err404
|
_ -> throwError err404
|
||||||
|
|
||||||
getEars :: Either String Integer -> Handler Animal
|
getEars :: Either String Integer -> Handler Animal
|
||||||
getEars (Left e) = return chimera -- ignore integer parse error, return weird animal
|
getEars (Left _) = return chimera -- ignore integer parse error, return weird animal
|
||||||
getEars (Right 2) = return jerry
|
getEars (Right 2) = return jerry
|
||||||
getEars (Right _) = throwError err404
|
getEars (Right _) = throwError err404
|
||||||
|
|
||||||
|
@ -339,117 +341,123 @@ qpServer = queryParamServer :<|> qpNames :<|> qpCapitalize :<|> qpAge :<|> qpAge
|
||||||
queryParamServer (Just name_) = return alice{name = name_}
|
queryParamServer (Just name_) = return alice{name = name_}
|
||||||
queryParamServer Nothing = return alice
|
queryParamServer Nothing = return alice
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
queryParamSpec :: Spec
|
queryParamSpec :: Spec
|
||||||
queryParamSpec = do
|
queryParamSpec = do
|
||||||
|
let mkRequest params pinfo = Network.Wai.Test.request defaultRequest
|
||||||
|
{ rawQueryString = params
|
||||||
|
, queryString = parseQuery params
|
||||||
|
, pathInfo = pinfo
|
||||||
|
}
|
||||||
|
|
||||||
describe "Servant.API.QueryParam" $ do
|
describe "Servant.API.QueryParam" $ do
|
||||||
it "allows retrieving simple GET parameters" $
|
it "allows retrieving simple GET parameters" $
|
||||||
(flip runSession) (serve queryParamApi qpServer) $ do
|
flip runSession (serve queryParamApi qpServer) $ do
|
||||||
let params1 = "?name=bob"
|
response1 <- mkRequest "?name=bob" []
|
||||||
response1 <- Network.Wai.Test.request defaultRequest{
|
liftIO $ decode' (simpleBody response1) `shouldBe` Just alice
|
||||||
rawQueryString = params1,
|
{ name = "bob"
|
||||||
queryString = parseQuery params1
|
|
||||||
}
|
|
||||||
liftIO $ do
|
|
||||||
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"
|
|
||||||
}
|
|
||||||
|
|
||||||
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
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
it "allows retrieving lists in GET parameters" $
|
||||||
|
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
|
||||||
|
response <- mkRequest "?age=55" ["param"]
|
||||||
|
liftIO $ decode' (simpleBody response) `shouldBe` Just alice
|
||||||
|
{ age = 55
|
||||||
|
}
|
||||||
|
|
||||||
it "generates an error on query parameter parse failure" $
|
it "generates an error on query parameter parse failure" $
|
||||||
(flip runSession) (serve queryParamApi qpServer) $ do
|
flip runSession (serve queryParamApi qpServer) $ do
|
||||||
let params = "?age=foo"
|
response <- mkRequest "?age=foo" ["param"]
|
||||||
response <- Network.Wai.Test.request defaultRequest{
|
|
||||||
rawQueryString = params,
|
|
||||||
queryString = parseQuery params,
|
|
||||||
pathInfo = ["param"]
|
|
||||||
}
|
|
||||||
liftIO $ statusCode (simpleStatus response) `shouldBe` 400
|
liftIO $ statusCode (simpleStatus response) `shouldBe` 400
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
it "parses multiple query parameters" $
|
it "parses multiple query parameters" $
|
||||||
(flip runSession) (serve queryParamApi qpServer) $ do
|
flip runSession (serve queryParamApi qpServer) $ do
|
||||||
let params = "?ages=10&ages=22"
|
response <- mkRequest "?ages=10&ages=22" ["multiparam"]
|
||||||
response <- Network.Wai.Test.request defaultRequest{
|
liftIO $ decode' (simpleBody response) `shouldBe` Just alice
|
||||||
rawQueryString = params,
|
{ age = 32
|
||||||
queryString = parseQuery params,
|
}
|
||||||
pathInfo = ["multiparam"]
|
|
||||||
}
|
|
||||||
liftIO $
|
|
||||||
decode' (simpleBody response) `shouldBe` Just alice{
|
|
||||||
age = 32
|
|
||||||
}
|
|
||||||
|
|
||||||
it "generates an error on parse failures of multiple parameters" $
|
it "generates an error on parse failures of multiple parameters" $
|
||||||
(flip runSession) (serve queryParamApi qpServer) $ do
|
flip runSession (serve queryParamApi qpServer) $ do
|
||||||
let params = "?ages=2&ages=foo"
|
response <- mkRequest "?ages=2&ages=foo" ["multiparam"]
|
||||||
response <- Network.Wai.Test.request defaultRequest{
|
|
||||||
rawQueryString = params,
|
|
||||||
queryString = parseQuery params,
|
|
||||||
pathInfo = ["multiparam"]
|
|
||||||
}
|
|
||||||
liftIO $ statusCode (simpleStatus response) `shouldBe` 400
|
liftIO $ statusCode (simpleStatus response) `shouldBe` 400
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
|
||||||
it "allows retrieving value-less GET parameters" $
|
it "allows retrieving value-less GET parameters" $
|
||||||
(flip runSession) (serve queryParamApi qpServer) $ do
|
flip runSession (serve queryParamApi qpServer) $ do
|
||||||
let params3 = "?capitalize"
|
response3 <- mkRequest "?capitalize" ["b"]
|
||||||
response3 <- Network.Wai.Test.request defaultRequest{
|
liftIO $ decode' (simpleBody response3) `shouldBe` Just alice
|
||||||
rawQueryString = params3,
|
{ name = "ALICE"
|
||||||
queryString = parseQuery params3,
|
}
|
||||||
pathInfo = ["b"]
|
|
||||||
}
|
|
||||||
liftIO $
|
|
||||||
decode' (simpleBody response3) `shouldBe` Just alice{
|
|
||||||
name = "ALICE"
|
|
||||||
}
|
|
||||||
|
|
||||||
let params3' = "?capitalize="
|
response3' <- mkRequest "?capitalize=" ["b"]
|
||||||
response3' <- Network.Wai.Test.request defaultRequest{
|
liftIO $ decode' (simpleBody response3') `shouldBe` Just alice
|
||||||
rawQueryString = params3',
|
{ name = "ALICE"
|
||||||
queryString = parseQuery params3',
|
}
|
||||||
pathInfo = ["b"]
|
|
||||||
}
|
|
||||||
liftIO $
|
|
||||||
decode' (simpleBody response3') `shouldBe` Just alice{
|
|
||||||
name = "ALICE"
|
|
||||||
}
|
|
||||||
|
|
||||||
let params3'' = "?unknown="
|
response3'' <- mkRequest "?unknown=" ["b"]
|
||||||
response3'' <- Network.Wai.Test.request defaultRequest{
|
liftIO $ decode' (simpleBody response3'') `shouldBe` Just alice
|
||||||
rawQueryString = params3'',
|
{ name = "Alice"
|
||||||
queryString = parseQuery params3'',
|
}
|
||||||
pathInfo = ["b"]
|
|
||||||
}
|
describe "Uses queryString instead of rawQueryString" $ do
|
||||||
liftIO $
|
-- test query parameters rewriter
|
||||||
decode' (simpleBody response3'') `shouldBe` Just alice{
|
let queryRewriter :: Middleware
|
||||||
name = "Alice"
|
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"
|
||||||
|
}
|
||||||
|
|
||||||
-- }}}
|
-- }}}
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
|
@ -544,7 +552,7 @@ rawSpec :: Spec
|
||||||
rawSpec = do
|
rawSpec = do
|
||||||
describe "Servant.API.Raw" $ do
|
describe "Servant.API.Raw" $ do
|
||||||
it "runs applications" $ 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{
|
response <- Network.Wai.Test.request defaultRequest{
|
||||||
pathInfo = ["foo"]
|
pathInfo = ["foo"]
|
||||||
}
|
}
|
||||||
|
@ -552,7 +560,7 @@ rawSpec = do
|
||||||
simpleBody response `shouldBe` "42"
|
simpleBody response `shouldBe` "42"
|
||||||
|
|
||||||
it "gets the pathInfo modified" $ do
|
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{
|
response <- Network.Wai.Test.request defaultRequest{
|
||||||
pathInfo = ["foo", "bar"]
|
pathInfo = ["foo", "bar"]
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue
Block a user