Fix Verb with headers checking content type differently
This commit is contained in:
parent
680d218719
commit
c780e349a0
3 changed files with 12 additions and 6 deletions
|
@ -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)
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue