eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Add failing test case to demonstrate query param issue

Browse source
This commit is contained in:
Tom Smalley 2022-04-29 15:35:31 +01:00
parent e14f445e2a
commit 299f0b3b3e
2 changed files with 8 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
servant-client/test/Servant/ClientTestUtils.hs
View file

@ -133,6 +133,7 @@ type Api =
:<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person] :<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person]
:<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
:<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
:<|> "param-echo" :> QueryParam "payload" String :> Get '[JSON] (Maybe String)
-- This endpoint makes use of a 'Raw' server because it is not currently -- This endpoint makes use of a 'Raw' server because it is not currently
-- possible to handle arbitrary binary query param values with -- possible to handle arbitrary binary query param values with
-- @servant-server@ -- @servant-server@
@ -172,6 +173,7 @@ getCapture :: String -> ClientM Person
getCaptureAll :: [String] -> ClientM [Person] getCaptureAll :: [String] -> ClientM [Person]
getBody :: Person -> ClientM Person getBody :: Person -> ClientM Person
getQueryParam :: Maybe String -> ClientM Person getQueryParam :: Maybe String -> ClientM Person
getQueryParamEcho :: Maybe String -> ClientM (Maybe String)
getQueryParamBinary :: Maybe UrlEncodedByteString -> HTTP.Method -> ClientM Response getQueryParamBinary :: Maybe UrlEncodedByteString -> HTTP.Method -> ClientM Response
getQueryParams :: [String] -> ClientM [Person] getQueryParams :: [String] -> ClientM [Person]
getQueryFlag :: Bool -> ClientM Bool getQueryFlag :: Bool -> ClientM Bool
@ -199,6 +201,7 @@ getRoot
:<|> getCaptureAll :<|> getCaptureAll
:<|> getBody :<|> getBody
:<|> getQueryParam :<|> getQueryParam
:<|> getQueryParamEcho
:<|> getQueryParamBinary :<|> getQueryParamBinary
:<|> getQueryParams :<|> getQueryParams
:<|> getQueryFlag :<|> getQueryFlag
@ -229,6 +232,7 @@ server = serve api (
Just "alice" -> return alice Just "alice" -> return alice
Just n -> throwError $ ServerError 400 (n ++ " not found") "" [] Just n -> throwError $ ServerError 400 (n ++ " not found") "" []
Nothing -> throwError $ ServerError 400 "missing parameter" "" []) Nothing -> throwError $ ServerError 400 "missing parameter" "" [])
:<|> return
:<|> const (Tagged $ \request respond -> :<|> const (Tagged $ \request respond ->
respond . maybe (Wai.responseLBS HTTP.notFound404 [] "Missing: payload") respond . maybe (Wai.responseLBS HTTP.notFound404 [] "Missing: payload")
(Wai.responseLBS HTTP.ok200 [] . LazyByteString.fromStrict) (Wai.responseLBS HTTP.ok200 [] . LazyByteString.fromStrict)

4
servant-client/test/Servant/SuccessSpec.hs
View file

@ -99,6 +99,10 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
Left (FailureResponse _ r) <- runClient (getQueryParam (Just "bob")) baseUrl Left (FailureResponse _ r) <- runClient (getQueryParam (Just "bob")) baseUrl
responseStatusCode r `shouldBe` HTTP.Status 400 "bob not found" responseStatusCode r `shouldBe` HTTP.Status 400 "bob not found"
it "Servant.API.QueryParam echo special chars" $ \(_, baseUrl) -> do
let payload = Just ":@&=+$,"
left show <$> runClient (getQueryParamEcho payload) baseUrl `shouldReturn` Right payload
it "Servant.API.QueryParam binary data" $ \(_, baseUrl) -> do it "Servant.API.QueryParam binary data" $ \(_, baseUrl) -> do
let payload = BS.pack [0, 1, 2, 4, 8, 16, 32, 64, 128] let payload = BS.pack [0, 1, 2, 4, 8, 16, 32, 64, 128]
apiCall = getQueryParamBinary (Just $ UrlEncodedByteString payload) HTTP.methodGet apiCall = getQueryParamBinary (Just $ UrlEncodedByteString payload) HTTP.methodGet