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

move statuscheck earlier on streaming response to give good error

Browse source
This commit is contained in:
Gershom 2017-11-06 11:37:00 -05:00
parent b704d3c067
commit 90292e1f62
2 changed files with 10 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs
View file

@ -267,7 +267,6 @@ instance OVERLAPPABLE_
} }
return . buildFromStream $ ResultStream $ \k -> return . buildFromStream $ ResultStream $ \k ->
runStreamingResponse sresp $ \(status,_headers,_httpversion,reader) -> do runStreamingResponse sresp $ \(status,_headers,_httpversion,reader) -> do
when (H.statusCode status /= 200) $ error "bad status" -- TODO fixme
let unrender = unrenderFrames (Proxy :: Proxy framing) (Proxy :: Proxy a) let unrender = unrenderFrames (Proxy :: Proxy framing) (Proxy :: Proxy a)
loop bs = do loop bs = do
res <- BL.fromStrict <$> reader res <- BL.fromStrict <$> reader

16
servant-client/src/Servant/Client/Internal/HttpClient.hs
View file

@ -111,7 +111,7 @@ performRequest req = do
Right response -> do Right response -> do
let status = Client.responseStatus response let status = Client.responseStatus response
status_code = statusCode status status_code = statusCode status
ourResponse = clientResponseToReponse response ourResponse = clientResponseToResponse response
unless (status_code >= 200 && status_code < 300) $ unless (status_code >= 200 && status_code < 300) $
throwError $ FailureResponse ourResponse throwError $ FailureResponse ourResponse
return ourResponse return ourResponse
@ -121,14 +121,18 @@ performStreamingRequest req = do
m <- asks manager m <- asks manager
burl <- asks baseUrl burl <- asks baseUrl
let request = requestToClientRequest burl req let request = requestToClientRequest burl req
return $ StreamingResponse $ return $ StreamingResponse $
\k -> Client.withResponse request m $ \k -> Client.withResponse request m $
\r -> \r -> do
k (Client.responseStatus r, fromList $ Client.responseHeaders r, Client.responseVersion r, Client.responseBody r) let status = Client.responseStatus r
status_code = statusCode status
unless (status_code >= 200 && status_code < 300) $ do
b <- BSL.fromChunks <$> Client.brConsume (Client.responseBody r)
throw $ FailureResponse $ Response status b (fromList $ Client.responseHeaders r) (Client.responseVersion r)
k (status, fromList $ Client.responseHeaders r, Client.responseVersion r, Client.responseBody r)
clientResponseToReponse :: Client.Response BSL.ByteString -> Response clientResponseToResponse :: Client.Response BSL.ByteString -> Response
clientResponseToReponse r = Response clientResponseToResponse r = Response
{ responseStatusCode = Client.responseStatus r { responseStatusCode = Client.responseStatus r
, responseBody = Client.responseBody r , responseBody = Client.responseBody r
, responseHeaders = fromList $ Client.responseHeaders r , responseHeaders = fromList $ Client.responseHeaders r