servant-client-ghcjs: Fix performRequest function

Fix performRequest function to be compatible with the latest
servant-client-core RunClient typeclass

Author: mikatammi

changelog.d/1529

@@ -0,0 +1,10 @@
+synopsis: Fix performRequest in servant-client-ghcjs
+prs: #1529
+
+description: {
+
+performRequest function in servant-client-ghcjs was not compatible with the
+latest RunClient typeclass. Added the acceptStatus parameter and fixed the
+functionality to match what servant-client provides.
+
+}

servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs

@@ -120,7 +120,7 @@ instance Exception StreamingNotSupportedException where
   displayException _ = "streamingRequest: streaming is not supported!"
 
 instance RunClient ClientM where
-  runRequest = performRequest
+  runRequestAcceptStatus = performRequest
   throwClientError = throwError
 
 runClientMOrigin :: ClientM a -> ClientEnv -> IO (Either ClientError a)
@@ -152,15 +152,18 @@ runClientM m = do
 
     runClientMOrigin m (ClientEnv (BaseUrl protocol hostname port ""))
 
-performRequest :: Request -> ClientM Response
-performRequest req = do
+performRequest :: Maybe [Status] -> Request -> ClientM Response
+performRequest acceptStatus req = do
   xhr <- liftIO initXhr
   burl <- asks baseUrl
   liftIO $ performXhr xhr burl req
   resp <- toResponse xhr
 
-  let status = statusCode (responseStatusCode resp)
-  unless (status >= 200 && status < 300) $ do
+  let status = responseStatusCode resp
+      goodStatus = case acceptStatus of
+        Nothing -> statusIsSuccessful status
+        Just good -> status `elem` good
+  unless goodStatus $ do
     let f b = (burl, BL.toStrict $ toLazyByteString b)
     throwError $ FailureResponse (bimap (const ()) f req) resp