servant-client-ghcjs: Fixed not throwing FailureResponse

2017-10-08 19:47:44 +02:00 · 2017-10-08 19:47:44 +02:00 · 911be50df2
commit 911be50df2
parent 74bde0a73d
1 changed files with 7 additions and 1 deletions
--- a/servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs
+++ b/servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs
@ -89,7 +89,13 @@ performRequest req = do
  xhr <- liftIO initXhr
  burl <- asks baseUrl
  liftIO $ performXhr xhr burl req
-  toResponse xhr
+  resp <- toResponse xhr
+
+  let status = statusCode (responseStatusCode resp)
+  unless (status >= 200 && status < 300) $
+        throwError $ FailureResponse resp
+
+  pure resp

 -- * initialization