summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichaelSnoyman <>2016-07-04 13:52:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-07-04 13:52:00 (GMT)
commit451242629f1ed2cba48e3b8059967af910e5eb08 (patch)
tree529df3c743022bbff29c77e5293fc4b158ef2061
parent5d724b24dac430e146fae8ef5c0e85ab503681b7 (diff)
version 2.2.02.2.0
-rw-r--r--ChangeLog.md4
-rw-r--r--Network/HTTP/Client/Conduit.hs1
-rw-r--r--Network/HTTP/Conduit.hs15
-rw-r--r--Network/HTTP/Simple.hs10
-rw-r--r--http-conduit.cabal6
-rw-r--r--test/CookieTest.hs5
-rw-r--r--test/main.hs105
7 files changed, 77 insertions, 69 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
index f106089..fa4c312 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,3 +1,7 @@
+## 2.2.0
+
+* Upgrade to http-client 0.5
+
## 2.1.11
* Switch to non-throwing behavior in `Network.HTTP.Simple` [#193](https://github.com/snoyberg/http-client/issues/193)
diff --git a/Network/HTTP/Client/Conduit.hs b/Network/HTTP/Client/Conduit.hs
index 425db79..44c2ee9 100644
--- a/Network/HTTP/Client/Conduit.hs
+++ b/Network/HTTP/Client/Conduit.hs
@@ -49,7 +49,6 @@ import Network.HTTP.Client hiding (closeManager,
newManager, responseClose,
responseOpen, withManager,
withResponse, BodyReader, brRead, brConsume, httpNoBody)
-import Network.HTTP.Client (HasHttpManager(..))
import qualified Network.HTTP.Client as H
import Network.HTTP.Client.TLS (tlsManagerSettings)
diff --git a/Network/HTTP/Conduit.hs b/Network/HTTP/Conduit.hs
index 632383a..3f39393 100644
--- a/Network/HTTP/Conduit.hs
+++ b/Network/HTTP/Conduit.hs
@@ -169,11 +169,10 @@ module Network.HTTP.Conduit
, rawBody
, decompress
, redirectCount
- , checkStatus
+ , checkResponse
, responseTimeout
, cookieJar
, requestVersion
- , getConnectionWrapper
, HCC.setQueryString
-- *** Request body
, requestBodySource
@@ -201,6 +200,11 @@ module Network.HTTP.Conduit
, managerConnCount
, managerResponseTimeout
, managerTlsConnection
+ -- ** Response timeout
+ , HC.ResponseTimeout
+ , HC.responseTimeoutMicro
+ , HC.responseTimeoutNone
+ , HC.responseTimeoutDefault
-- * Cookies
, Cookie(..)
, CookieJar
@@ -225,6 +229,7 @@ module Network.HTTP.Conduit
, urlEncodedBody
-- * Exceptions
, HttpException (..)
+ , HCC.HttpExceptionContent (..)
) where
import qualified Data.ByteString as S
@@ -234,12 +239,12 @@ import qualified Data.Conduit.Internal as CI
import qualified Data.Conduit.List as CL
import Data.IORef (readIORef, writeIORef, newIORef)
import Data.Int (Int64)
-import Control.Applicative ((<$>))
-import Control.Exception.Lifted (bracket)
+import Control.Applicative as A ((<$>))
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Trans.Resource
import qualified Network.HTTP.Client as Client (httpLbs, responseOpen, responseClose)
+import qualified Network.HTTP.Client as HC
import qualified Network.HTTP.Client.Conduit as HCC
import Network.HTTP.Client.Internal (createCookieJar,
destroyCookieJar)
@@ -303,7 +308,7 @@ simpleHttp :: MonadIO m => String -> m L.ByteString
simpleHttp url = liftIO $ do
man <- newManager tlsManagerSettings
req <- liftIO $ parseUrlThrow url
- responseBody <$> httpLbs (setConnectionClose req) man
+ responseBody A.<$> httpLbs (setConnectionClose req) man
conduitManagerSettings :: ManagerSettings
conduitManagerSettings = tlsManagerSettings
diff --git a/Network/HTTP/Simple.hs b/Network/HTTP/Simple.hs
index 152f9c5..95c723d 100644
--- a/Network/HTTP/Simple.hs
+++ b/Network/HTTP/Simple.hs
@@ -54,7 +54,7 @@ module Network.HTTP.Simple
, setRequestBodyFile
, setRequestBodyURLEncoded
-- ** Special fields
- , setRequestIgnoreStatus
+ , H.setRequestIgnoreStatus
, setRequestBasicAuth
, setRequestManager
, setRequestProxy
@@ -86,7 +86,6 @@ import Data.Typeable (Typeable)
import qualified Data.Conduit as C
import qualified Data.Conduit.Attoparsec as C
import qualified Control.Monad.Catch as Catch
-import Data.Default.Class (def)
import qualified Network.HTTP.Types as H
import Data.Int (Int64)
@@ -299,13 +298,6 @@ setRequestBodyFile = setRequestBody . HI.RequestBodyIO . H.streamFile
setRequestBodyURLEncoded :: [(S.ByteString, S.ByteString)] -> H.Request -> H.Request
setRequestBodyURLEncoded = H.urlEncodedBody
--- | Modify the request so that non-2XX status codes do not generate a runtime
--- exception.
---
--- @since 2.1.10
-setRequestIgnoreStatus :: H.Request -> H.Request
-setRequestIgnoreStatus req = req { H.checkStatus = \_ _ _ -> Nothing }
-
-- | Set basic auth with the given username and password
--
-- @since 2.1.10
diff --git a/http-conduit.cabal b/http-conduit.cabal
index 90e2c74..7b04dd2 100644
--- a/http-conduit.cabal
+++ b/http-conduit.cabal
@@ -1,5 +1,5 @@
name: http-conduit
-version: 2.1.11
+version: 2.2.0
license: BSD3
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
@@ -30,12 +30,11 @@ library
, conduit-extra >= 1.1.5
, http-types >= 0.7
, lifted-base >= 0.1
- , http-client >= 0.4.30 && < 0.5
+ , http-client >= 0.5 && < 0.6
, http-client-tls >= 0.2.4
, monad-control
, mtl
, exceptions >= 0.6
- , data-default-class
exposed-modules: Network.HTTP.Conduit
Network.HTTP.Client.Conduit
Network.HTTP.Simple
@@ -76,6 +75,7 @@ test-suite test
, streaming-commons
, aeson
, temporary
+ , resourcet
source-repository head
type: git
diff --git a/test/CookieTest.hs b/test/CookieTest.hs
index a84b0ba..3222b74 100644
--- a/test/CookieTest.hs
+++ b/test/CookieTest.hs
@@ -8,14 +8,13 @@ import Network.HTTP.Client
import qualified Network.HTTP.Conduit as HC
import Data.ByteString.UTF8
import Data.Monoid
-import Data.Maybe
import Data.Time.Clock
import Data.Time.Calendar
import qualified Data.CaseInsensitive as CI
import Web.Cookie
default_request :: HC.Request
-default_request = fromJust $ HC.parseUrl "http://www.google.com/"
+default_request = HC.parseRequest_ "http://www.google.com/"
default_cookie :: Cookie
default_cookie = Cookie { cookie_name = fromString "name"
@@ -444,7 +443,7 @@ testReceiveSetCookieExistingHttpOnly = assertEqual "Existing http-only cookie ge
testMonoidPreferRecent :: IO ()
testMonoidPreferRecent = assertEqual "Monoid prefers more recent cookies"
- (cct $ createCookieJar [c2]) (cct $ createCookieJar [c1] `mappend` createCookieJar [c2])
+ (cct $ createCookieJar [c2]) (cct $ createCookieJar [c1] `Data.Monoid.mappend` createCookieJar [c2])
where c1 = default_cookie {cookie_creation_time = UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 1)}
c2 = default_cookie {cookie_creation_time = UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 2)}
cct cj = cookie_creation_time $ head $ destroyCookieJar cj
diff --git a/test/main.hs b/test/main.hs
index 7d9e384..f799ddd 100644
--- a/test/main.hs
+++ b/test/main.hs
@@ -12,7 +12,7 @@ import Network.HTTP.Client (streamFile)
import System.IO.Temp (withSystemTempFile)
import qualified Network.Wai as Wai
import Network.Wai.Handler.Warp (runSettings, defaultSettings, setPort, setBeforeMainLoop, Settings, setTimeout)
-import Network.HTTP.Conduit hiding (port)
+import Network.HTTP.Conduit hiding (port, withManager, withManagerSettings)
import qualified Network.HTTP.Conduit as NHC
import Network.HTTP.Client.MultipartFormData
import Control.Concurrent (forkIO, killThread, putMVar, takeMVar, newEmptyMVar, threadDelay)
@@ -25,7 +25,7 @@ import Network.Socket (sClose)
import qualified Network.BSD
import CookieTest (cookieTest)
#if MIN_VERSION_conduit(1,1,0)
-import Data.Conduit.Network (runTCPServer, serverSettings, HostPreference (..), appSink, appSource, ServerSettings)
+import Data.Conduit.Network (runTCPServer, serverSettings, appSink, appSource, ServerSettings)
import Data.Streaming.Network (bindPortTCP, setAfterBind)
#define bindPort bindPortTCP
#else
@@ -53,6 +53,15 @@ import Network.Connection (settingDisableCertificateValidation)
import Data.Default.Class (def)
import qualified Data.Aeson as A
import qualified Network.HTTP.Simple as Simple
+import Data.Monoid (mempty)
+import Control.Monad.Trans.Resource (ResourceT, runResourceT)
+
+-- I'm too lazy to rewrite code below
+withManager :: (Manager -> ResourceT IO a) -> IO a
+withManager = withManagerSettings tlsManagerSettings
+
+withManagerSettings :: ManagerSettings -> (Manager -> ResourceT IO a) -> IO a
+withManagerSettings set f = newManager set >>= (runResourceT . f)
past :: UTCTime
past = UTCTime (ModifiedJulianDay 56200) (secondsToDiffTime 0)
@@ -174,49 +183,49 @@ main = withSocketsDo $ do
it "throws exception on 404" $ withApp app $ \port -> do
elbs <- try $ simpleHttp $ concat ["http://127.0.0.1:", show port, "/404"]
case elbs of
- Left (StatusCodeException _ _ _) -> return ()
+ Left (HttpExceptionRequest _ StatusCodeException {}) -> return ()
_ -> error "Expected an exception"
describe "httpLbs" $ do
it "preserves 'set-cookie' headers" $ withApp app $ \port -> do
- request <- parseUrl $ concat ["http://127.0.0.1:", show port, "/cookies"]
+ request <- parseUrlThrow $ concat ["http://127.0.0.1:", show port, "/cookies"]
withManager $ \manager -> do
response <- httpLbs request manager
let setCookie = mk (fromString "Set-Cookie")
(setCookieHeaders, _) = partition ((== setCookie) . fst) (NHC.responseHeaders response)
liftIO $ assertBool "response contains a 'set-cookie' header" $ length setCookieHeaders > 0
it "redirects set cookies" $ withApp app $ \port -> do
- request <- parseUrl $ concat ["http://127.0.0.1:", show port, "/cookie_redir1"]
+ request <- parseUrlThrow $ concat ["http://127.0.0.1:", show port, "/cookie_redir1"]
withManager $ \manager -> do
response <- httpLbs request manager
liftIO $ (responseBody response) @?= "nom-nom-nom"
it "user-defined cookie jar works" $ withApp app $ \port -> do
- request <- parseUrl $ concat ["http://127.0.0.1:", show port, "/dump_cookies"]
+ request <- parseUrlThrow $ concat ["http://127.0.0.1:", show port, "/dump_cookies"]
withManager $ \manager -> do
response <- httpLbs (request {redirectCount = 1, cookieJar = Just cookie_jar}) manager
liftIO $ (responseBody response) @?= "key=value"
it "user-defined cookie jar is not ignored when redirection is disabled" $ withApp app $ \port -> do
- request <- parseUrl $ concat ["http://127.0.0.1:", show port, "/dump_cookies"]
+ request <- parseUrlThrow $ concat ["http://127.0.0.1:", show port, "/dump_cookies"]
withManager $ \manager -> do
response <- httpLbs (request {redirectCount = 0, cookieJar = Just cookie_jar}) manager
liftIO $ (responseBody response) @?= "key=value"
it "cookie jar is available in response" $ withApp app $ \port -> do
- request <- parseUrl $ concat ["http://127.0.0.1:", show port, "/cookies"]
+ request <- parseUrlThrow $ concat ["http://127.0.0.1:", show port, "/cookies"]
withManager $ \manager -> do
- response <- httpLbs (request {cookieJar = Just def}) manager
+ response <- httpLbs (request {cookieJar = Just Data.Monoid.mempty}) manager
liftIO $ (length $ destroyCookieJar $ responseCookieJar response) @?= 1
it "Cookie header isn't touched when no cookie jar supplied" $ withApp app $ \port -> do
- request <- parseUrl $ concat ["http://127.0.0.1:", show port, "/dump_cookies"]
+ request <- parseUrlThrow $ concat ["http://127.0.0.1:", show port, "/dump_cookies"]
withManager $ \manager -> do
let request_headers = (mk "Cookie", "key2=value2") : filter ((/= mk "Cookie") . fst) (NHC.requestHeaders request)
response <- httpLbs (request {NHC.requestHeaders = request_headers, cookieJar = Nothing}) manager
liftIO $ (responseBody response) @?= "key2=value2"
it "Response cookie jar is nothing when request cookie jar is nothing" $ withApp app $ \port -> do
- request <- parseUrl $ concat ["http://127.0.0.1:", show port, "/cookies"]
+ request <- parseUrlThrow $ concat ["http://127.0.0.1:", show port, "/cookies"]
withManager $ \manager -> do
response <- httpLbs (request {cookieJar = Nothing}) manager
- liftIO $ (responseCookieJar response) @?= def
+ liftIO $ (responseCookieJar response) @?= mempty
it "TLS" $ withAppTls app $ \port -> do
- request <- parseUrl $ "https://127.0.0.1:" ++ show port
+ request <- parseUrlThrow $ "https://127.0.0.1:" ++ show port
let set = mkManagerSettings
def
{ settingDisableCertificateValidation = True
@@ -228,8 +237,8 @@ main = withSocketsDo $ do
it "closes all connections" $ withApp app $ \port1 -> withApp app $ \port2 -> do
--FIXME clearSocketsList
withManager $ \manager -> do
- let Just req1 = parseUrl $ "http://127.0.0.1:" ++ show port1
- let Just req2 = parseUrl $ "http://127.0.0.1:" ++ show port2
+ let Just req1 = parseUrlThrow $ "http://127.0.0.1:" ++ show port1
+ let Just req2 = parseUrlThrow $ "http://127.0.0.1:" ++ show port2
_res1a <- http req1 manager
_res1b <- http req1 manager
_res2 <- http req2 manager
@@ -238,7 +247,7 @@ main = withSocketsDo $ do
describe "http" $ do
it "response body" $ withApp app $ \port -> do
withManager $ \manager -> do
- req <- liftIO $ parseUrl $ "http://127.0.0.1:" ++ show port
+ req <- liftIO $ parseUrlThrow $ "http://127.0.0.1:" ++ show port
res1 <- http req manager
bss <- responseBody res1 $$+- CL.consume
res2 <- httpLbs req manager
@@ -246,21 +255,21 @@ main = withSocketsDo $ do
describe "DOS protection" $ do
it "overlong headers" $ overLongHeaders $ \port -> do
withManager $ \manager -> do
- let Just req1 = parseUrl $ "http://127.0.0.1:" ++ show port
+ let Just req1 = parseUrlThrow $ "http://127.0.0.1:" ++ show port
res1 <- try $ http req1 manager
case res1 of
- Left e -> liftIO $ show (e :: SomeException) @?= show OverlongHeaders
+ Left e -> liftIO $ show (e :: SomeException) @?= show (HttpExceptionRequest req1 OverlongHeaders)
_ -> error "Shouldn't have worked"
it "not overlong headers" $ notOverLongHeaders $ \port -> do
withManager $ \manager -> do
- let Just req1 = parseUrl $ "http://127.0.0.1:" ++ show port
+ let Just req1 = parseUrlThrow $ "http://127.0.0.1:" ++ show port
_ <- httpLbs req1 manager
return ()
describe "redirects" $ do
it "doesn't double escape" $ redir $ \port -> do
withManager $ \manager -> do
let go (encoded, final) = do
- let Just req1 = parseUrl $ concat ["http://127.0.0.1:", show port, "/redir/", encoded]
+ let Just req1 = parseUrlThrow $ concat ["http://127.0.0.1:", show port, "/redir/", encoded]
res <- httpLbs req1 manager
liftIO $ Network.HTTP.Conduit.responseStatus res @?= status200
liftIO $ responseBody res @?= L.fromChunks [TE.encodeUtf8 final]
@@ -272,19 +281,19 @@ main = withSocketsDo $ do
, ("hello%20world%3f%23", "hello world?#")
]
it "TooManyRedirects: redirect request body is preserved" $ withApp app $ \port -> do
- let Just req = parseUrl $ concat ["http://127.0.0.1:", show port, "/infredir/0"]
+ let Just req = parseUrlThrow $ concat ["http://127.0.0.1:", show port, "/infredir/0"]
let go (res, i) = liftIO $ responseBody res @?= (L8.pack $ show i)
E.catch (withManager $ \manager -> do
void $ http req{redirectCount=5} manager) $ \e ->
case e of
- TooManyRedirects redirs ->
+ HttpExceptionRequest _ (TooManyRedirects redirs) ->
mapM_ go (zip redirs [5,4..0 :: Int])
_ -> error $ show e
describe "chunked request body" $ do
it "works" $ echo $ \port -> do
withManager $ \manager -> do
let go bss = do
- let Just req1 = parseUrl $ "POST http://127.0.0.1:" ++ show port
+ let Just req1 = parseUrlThrow $ "POST http://127.0.0.1:" ++ show port
src = sourceList bss
lbs = L.fromChunks bss
res <- httpLbs req1
@@ -299,7 +308,7 @@ main = withSocketsDo $ do
]
describe "no status message" $ do
it "works" $ noStatusMessage $ \port -> do
- req <- parseUrl $ "http://127.0.0.1:" ++ show port
+ req <- parseUrlThrow $ "http://127.0.0.1:" ++ show port
withManager $ \manager -> do
res <- httpLbs req manager
liftIO $ do
@@ -308,49 +317,49 @@ main = withSocketsDo $ do
describe "response body too short" $ do
it "throws an exception" $ wrongLength $ \port -> do
- req <- parseUrl $ "http://127.0.0.1:" ++ show port
+ req <- parseUrlThrow $ "http://127.0.0.1:" ++ show port
withManager $ \manager -> do
eres <- try $ httpLbs req manager
liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres
- `shouldBe` Left (show $ ResponseBodyTooShort 50 18)
+ `shouldBe` Left (show $ HttpExceptionRequest req $ ResponseBodyTooShort 50 18)
describe "chunked response body" $ do
it "no chunk terminator" $ wrongLengthChunk1 $ \port -> do
- req <- parseUrl $ "http://127.0.0.1:" ++ show port
+ req <- parseUrlThrow $ "http://127.0.0.1:" ++ show port
withManager $ \manager -> do
eres <- try $ httpLbs req manager
liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres
- `shouldBe` Left (show IncompleteHeaders)
+ `shouldBe` Left (show (HttpExceptionRequest req IncompleteHeaders))
it "incomplete chunk" $ wrongLengthChunk2 $ \port -> do
- req <- parseUrl $ "http://127.0.0.1:" ++ show port
+ req <- parseUrlThrow $ "http://127.0.0.1:" ++ show port
withManager $ \manager -> do
eres <- try $ httpLbs req manager
liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres
- `shouldBe` Left (show InvalidChunkHeaders)
+ `shouldBe` Left (show (HttpExceptionRequest req InvalidChunkHeaders))
it "invalid chunk" $ invalidChunk $ \port -> do
- req <- parseUrl $ "http://127.0.0.1:" ++ show port
+ req <- parseUrlThrow $ "http://127.0.0.1:" ++ show port
withManager $ \manager -> do
eres <- try $ httpLbs req manager
liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres
- `shouldBe` Left (show InvalidChunkHeaders)
+ `shouldBe` Left (show (HttpExceptionRequest req InvalidChunkHeaders))
it "missing header" $ rawApp
"HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n4\r\nabcd\r\n\r\n\r\n"
$ \port -> do
- req <- parseUrl $ "http://127.0.0.1:" ++ show port
+ req <- parseUrlThrow $ "http://127.0.0.1:" ++ show port
withManager $ \manager -> do
eres <- try $ httpLbs req manager
liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres
- `shouldBe` Left (show InvalidChunkHeaders)
+ `shouldBe` Left (show (HttpExceptionRequest req InvalidChunkHeaders))
it "junk header" $ rawApp
"HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n4\r\nabcd\r\njunk\r\n\r\n"
$ \port -> do
- req <- parseUrl $ "http://127.0.0.1:" ++ show port
+ req <- parseUrlThrow $ "http://127.0.0.1:" ++ show port
withManager $ \manager -> do
eres <- try $ httpLbs req manager
liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres
- `shouldBe` Left (show InvalidChunkHeaders)
+ `shouldBe` Left (show (HttpExceptionRequest req InvalidChunkHeaders))
describe "redirect" $ do
it "ignores large response bodies" $ do
@@ -359,7 +368,7 @@ main = withSocketsDo $ do
["foo"] -> return $ responseLBS status200 [] "Hello World!"
_ -> return $ responseSource status301 [("location", S8.pack $ "http://127.0.0.1:" ++ show port ++ "/foo")] $ forever $ yield $ Chunk $ fromByteString "hello\n"
withApp' app' $ \port -> withManager $ \manager -> do
- req <- liftIO $ parseUrl $ "http://127.0.0.1:" ++ show port
+ req <- liftIO $ parseUrlThrow $ "http://127.0.0.1:" ++ show port
res <- httpLbs req manager
liftIO $ do
Network.HTTP.Conduit.responseStatus res `shouldBe` status200
@@ -392,7 +401,7 @@ main = withSocketsDo $ do
_ <- appSource app' $$ await
yield "HTTP/1.0 200 OK\r\n\r\nThis is it!" $$ appSink app'
withCApp baseHTTP $ \port -> withManager $ \manager -> do
- req <- liftIO $ parseUrl $ "http://127.0.0.1:" ++ show port
+ req <- liftIO $ parseUrlThrow $ "http://127.0.0.1:" ++ show port
res1 <- httpLbs req manager
res2 <- httpLbs req manager
liftIO $ res1 @?= res2
@@ -400,33 +409,33 @@ main = withSocketsDo $ do
describe "hostAddress" $ do
it "overrides host" $ withApp app $ \port -> do
entry <- Network.BSD.getHostByName "127.0.0.1"
- req' <- parseUrl $ "http://example.com:" ++ show port
+ req' <- parseUrlThrow $ "http://example.com:" ++ show port
let req = req' { hostAddress = Just $ Network.BSD.hostAddress entry }
res <- withManager $ httpLbs req
responseBody res @?= "homepage for example.com"
describe "managerResponseTimeout" $ do
it "works" $ withApp app $ \port -> do
- req1 <- parseUrl $ "http://localhost:" ++ show port
- let req2 = req1 { responseTimeout = Just 5000000 }
- withManagerSettings conduitManagerSettings { managerResponseTimeout = Just 1 } $ \man -> do
+ req1 <- parseUrlThrow $ "http://localhost:" ++ show port
+ let req2 = req1 { responseTimeout = responseTimeoutMicro 5000000 }
+ withManagerSettings tlsManagerSettings { managerResponseTimeout = responseTimeoutMicro 1 } $ \man -> do
eres1 <- try $ httpLbs req1 { NHC.path = "/delayed" } man
case eres1 of
- Left (FailedConnectionException _ _) -> return ()
+ Left (HttpExceptionRequest _ ConnectionTimeout{}) -> return ()
_ -> error "Did not time out"
_ <- httpLbs req2 man
return ()
describe "delayed body" $ do
it "works" $ withApp app $ \port -> do
- req <- parseUrl $ "http://localhost:" ++ show port ++ "/delayed"
+ req <- parseUrlThrow $ "http://localhost:" ++ show port ++ "/delayed"
withManager $ \man -> do
_ <- http req man
return ()
it "reuse/connection close tries again" $ do
withAppSettings (setTimeout 1) (const app) $ \port -> do
- req <- parseUrl $ "http://localhost:" ++ show port
+ req <- parseUrlThrow $ "http://localhost:" ++ show port
withManager $ \man -> do
res1 <- httpLbs req man
liftIO $ threadDelay 3000000
@@ -450,7 +459,7 @@ main = withSocketsDo $ do
, ("noval", Nothing)
]
withManager $ \man -> do
- req <- parseUrl $ "http://localhost:" ++ show port
+ req <- parseUrlThrow $ "http://localhost:" ++ show port
_ <- httpLbs (setQueryString qs req) man
return ()
res <- I.readIORef ref
@@ -458,7 +467,7 @@ main = withSocketsDo $ do
describe "Simple" $ do
it "JSON" $ jsonApp $ \port -> do
- req <- parseUrl $ "http://localhost:" ++ show port
+ req <- parseUrlThrow $ "http://localhost:" ++ show port
value <- Simple.httpJSON req
responseBody value `shouldBe` jsonValue
@@ -469,7 +478,7 @@ main = withSocketsDo $ do
mapM_ (S.hPutStr tmph) bss
hClose tmph
- let Just req1 = parseUrl $ "POST http://127.0.0.1:" ++ show port
+ let Just req1 = parseUrlThrow $ "POST http://127.0.0.1:" ++ show port
lbs = L.fromChunks bss
res <- httpLbs req1
{ requestBody = RequestBodyIO (streamFile tmpfp)