summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichaelSnoyman <>2012-08-28 11:11:26 (GMT)
committerhdiff <hdiff@luite.com>2012-08-28 11:11:26 (GMT)
commit7e75bf14d516edc1f28684ebedf7c00e1fae331e (patch)
tree686e3e4d216b65d7088e786df8085814f6db1682
parent238014752d9cd13b92aaad79b772604d1938d862 (diff)
version 1.6.0.11.6.0.1
-rw-r--r--Network/HTTP/Conduit.hs3
-rw-r--r--Network/HTTP/Conduit/Browser.hs3
-rw-r--r--Network/HTTP/Conduit/Manager.hs2
-rw-r--r--Network/HTTP/Conduit/Request.hs1
-rw-r--r--Network/HTTP/Conduit/Response.hs15
-rw-r--r--Network/HTTP/Conduit/Types.hs4
-rw-r--r--Network/HTTP/Conduit/Util.hs2
-rw-r--r--http-conduit.cabal8
8 files changed, 30 insertions, 8 deletions
diff --git a/Network/HTTP/Conduit.hs b/Network/HTTP/Conduit.hs
index 539eb5c..46143b6 100644
--- a/Network/HTTP/Conduit.hs
+++ b/Network/HTTP/Conduit.hs
@@ -24,7 +24,7 @@
-- > request <- parseUrl "http://google.com/"
-- > withManager $ \manager -> do
-- > Response _ _ _ src <- http request manager
--- > src C.$$ sinkFile "google.html"
+-- > src C.$$+- sinkFile "google.html"
--
-- The following headers are automatically set by this module, and should not
-- be added to 'requestHeaders':
@@ -89,6 +89,7 @@ module Network.HTTP.Conduit
, decompress
, redirectCount
, checkStatus
+ , responseTimeout
-- * Manager
, Manager
, newManager
diff --git a/Network/HTTP/Conduit/Browser.hs b/Network/HTTP/Conduit/Browser.hs
index ed2eda4..537508d 100644
--- a/Network/HTTP/Conduit/Browser.hs
+++ b/Network/HTTP/Conduit/Browser.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
module Network.HTTP.Conduit.Browser
( BrowserState
, BrowserAction
@@ -33,7 +34,9 @@ import Control.Monad.State
import Control.Exception
import qualified Control.Exception.Lifted as LE
import Data.Conduit
+#if !MIN_VERSION_base(4,6,0)
import Prelude hiding (catch)
+#endif
import qualified Network.HTTP.Types as HT
import Data.Time.Clock (getCurrentTime, UTCTime)
import Data.CaseInsensitive (mk)
diff --git a/Network/HTTP/Conduit/Manager.hs b/Network/HTTP/Conduit/Manager.hs
index b36aad0..464adaa 100644
--- a/Network/HTTP/Conduit/Manager.hs
+++ b/Network/HTTP/Conduit/Manager.hs
@@ -17,7 +17,9 @@ module Network.HTTP.Conduit.Manager
, defaultCheckCerts
) where
+#if !MIN_VERSION_base(4,6,0)
import Prelude hiding (catch)
+#endif
import Data.Monoid (mappend)
import System.IO (hClose, hFlush, IOMode(..))
import qualified Data.IORef as I
diff --git a/Network/HTTP/Conduit/Request.hs b/Network/HTTP/Conduit/Request.hs
index c9ece4f..b8ab9d3 100644
--- a/Network/HTTP/Conduit/Request.hs
+++ b/Network/HTTP/Conduit/Request.hs
@@ -145,6 +145,7 @@ instance Default (Request m) where
if 200 <= sci && sci < 300
then Nothing
else Just $ toException $ StatusCodeException s hs
+ , responseTimeout = Just 5000000
}
-- | Always decompress a compressed stream.
diff --git a/Network/HTTP/Conduit/Response.hs b/Network/HTTP/Conduit/Response.hs
index 533caf5..f3ecc9e 100644
--- a/Network/HTTP/Conduit/Response.hs
+++ b/Network/HTTP/Conduit/Response.hs
@@ -38,6 +38,9 @@ import Network.HTTP.Conduit.Chunk
import Data.Void (Void, absurd)
+import System.Timeout.Lifted (timeout)
+import Control.Monad.Trans.Control (MonadBaseControl)
+
-- | If a request is a redirection (status code 3xx) this function will create
-- a new request from the old request, the server headers returned with the
-- redirection, and the redirection code itself. This function returns 'Nothing'
@@ -98,13 +101,21 @@ checkHeaderLength _ s@Done{} = s
checkHeaderLength _ (HaveOutput _ _ o) = absurd o
checkHeaderLength len (Leftover p i) = Leftover (checkHeaderLength len p) i
-getResponse :: MonadResource m
+getResponse :: (MonadResource m, MonadBaseControl IO m)
=> ConnRelease m
-> Request m
-> Source m S8.ByteString
-> m (Response (ResumableSource m S8.ByteString))
getResponse connRelease req@(Request {..}) src1 = do
- (src2, ((vbs, sc, sm), hs)) <- src1 $$+ checkHeaderLength 4096 sinkHeaders
+ let timeout' =
+ case responseTimeout of
+ Nothing -> id
+ Just useconds -> \ma -> do
+ x <- timeout useconds ma
+ case x of
+ Nothing -> liftIO $ throwIO ResponseTimeout
+ Just y -> return y
+ (src2, ((vbs, sc, sm), hs)) <- timeout' $ src1 $$+ checkHeaderLength 4096 sinkHeaders
let version = if vbs == "1.1" then W.http11 else W.http10
let s = W.Status sc sm
let hs' = map (first CI.mk) hs
diff --git a/Network/HTTP/Conduit/Types.hs b/Network/HTTP/Conduit/Types.hs
index 6bb26ed..96e44a6 100644
--- a/Network/HTTP/Conduit/Types.hs
+++ b/Network/HTTP/Conduit/Types.hs
@@ -94,6 +94,9 @@ data Request m = Request
, checkStatus :: W.Status -> W.ResponseHeaders -> Maybe SomeException
-- ^ Check the status code. Note that this will run after all redirects are
-- performed. Default: return a @StatusCodeException@ on non-2XX responses.
+ , responseTimeout :: Maybe Int
+ -- ^ Number of microseconds to wait for a response. If @Nothing@, will wait
+ -- indefinitely. Default: 5 seconds.
}
-- | When using one of the
@@ -128,6 +131,7 @@ data HttpException = StatusCodeException W.Status W.ResponseHeaders
| HttpParserException String
| HandshakeFailed
| OverlongHeaders
+ | ResponseTimeout
deriving (Show, Typeable)
instance Exception HttpException
diff --git a/Network/HTTP/Conduit/Util.hs b/Network/HTTP/Conduit/Util.hs
index 26193c6..eea42b6 100644
--- a/Network/HTTP/Conduit/Util.hs
+++ b/Network/HTTP/Conduit/Util.hs
@@ -15,7 +15,7 @@ import qualified Data.ByteString.Char8 as S8
import qualified Data.Text as T
import qualified Data.Text.Read
-#if 1
+#if MIN_VERSION_base(4,3,0)
import Data.ByteString (hGetSome)
#else
import GHC.IO.Handle.Types
diff --git a/http-conduit.cabal b/http-conduit.cabal
index b08c614..9e80c13 100644
--- a/http-conduit.cabal
+++ b/http-conduit.cabal
@@ -1,5 +1,5 @@
name: http-conduit
-version: 1.6.0
+version: 1.6.0.1
license: BSD3
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
@@ -19,7 +19,7 @@ flag network-bytestring
library
build-depends: base >= 4 && < 5
- , bytestring >= 0.9.1.4 && < 0.10
+ , bytestring >= 0.9.1.4 && < 0.11
, transformers >= 0.2 && < 0.4
, failure >= 0.1
, resourcet >= 0.3 && < 0.4
@@ -38,8 +38,8 @@ library
, containers >= 0.2
, certificate >= 1.2 && < 1.3
, case-insensitive >= 0.2
- , base64-bytestring >= 0.1 && < 0.2
- , asn1-data >= 0.5.1 && < 0.7
+ , base64-bytestring >= 0.1 && < 1.1
+ , asn1-data >= 0.5.1 && < 0.8
, data-default
, text
, transformers-base >= 0.4 && < 0.5