roughly working again
This commit is contained in:
parent
2434399845
commit
16219f00fe
2 changed files with 3 additions and 8 deletions
|
@ -108,7 +108,7 @@ performRequest reqMethod req manager reqHost = do
|
|||
, checkStatus = \ _status _headers _cookies -> Nothing
|
||||
}
|
||||
|
||||
eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager
|
||||
eResponse <- liftIO $ performHttpRequest manager request
|
||||
case eResponse of
|
||||
Left err ->
|
||||
throwE . ConnectionError $ SomeException err
|
||||
|
@ -145,8 +145,3 @@ performRequestNoBody :: Method -> Req -> Manager -> BaseUrl
|
|||
performRequestNoBody reqMethod req manager reqHost = do
|
||||
(_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req manager reqHost
|
||||
return hdrs
|
||||
|
||||
catchConnectionError :: IO a -> IO (Either ServantError a)
|
||||
catchConnectionError action =
|
||||
catch (Right <$> action) $ \e ->
|
||||
pure . Left . ConnectionError $ SomeException (e :: HttpException)
|
||||
|
|
|
@ -8,4 +8,4 @@ npm install xhr2
|
|||
|
||||
export STACK_YAML=stack-ghcjs.yaml
|
||||
stack setup
|
||||
stack test
|
||||
stack test --fast
|
||||
|
|
Loading…
Reference in a new issue