Fix Verb with headers checking content type differently

This commit is contained in:
Przemysław Kopański 2019-08-11 21:19:34 +02:00
parent 680d218719
commit c780e349a0
3 changed files with 12 additions and 6 deletions

View file

@ -253,12 +253,10 @@ instance {-# OVERLAPPING #-}
{ requestMethod = method
, requestAccept = fromList $ toList accept
}
case mimeUnrender (Proxy :: Proxy ct) $ responseBody response of
Left err -> throwClientError $ DecodeFailure (pack err) response
Right val -> return $ Headers
{ getResponse = val
, getHeadersHList = buildHeadersTo . toList $ responseHeaders response
}
val <- response `decodedAs` (Proxy :: Proxy ct)
return $ Headers { getResponse = val
, getHeadersHList = buildHeadersTo . toList $ responseHeaders response
}
where method = reflectMethod (Proxy :: Proxy method)
accept = contentTypes (Proxy :: Proxy ct)

View file

@ -168,6 +168,7 @@ type FailApi =
"get" :> Raw
:<|> "capture" :> Capture "name" String :> Raw
:<|> "body" :> Raw
:<|> "headers" :> Raw
failApi :: Proxy FailApi
failApi = Proxy
@ -176,6 +177,7 @@ failServer = serve failApi (
(Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "")
:<|> (\ _capture -> Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/json")] "")
:<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "fooooo")] "")
:<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/x-www-form-urlencoded"), ("X-Example1", "1"), ("X-Example2", "foo")] "")
)
-- * basic auth stuff

View file

@ -67,6 +67,12 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
UnsupportedContentType "application/octet-stream" _ -> return ()
_ -> fail $ "expected UnsupportedContentType, but got " <> show res
it "reports UnsupportedContentType when there are response headers" $ \(_, baseUrl) -> do
Left res <- runClient getRespHeaders baseUrl
case res of
UnsupportedContentType "application/x-www-form-urlencoded" _ -> return ()
_ -> fail $ "expected UnsupportedContentType, but got " <> show res
it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
Left res <- runClient (getBody alice) baseUrl