http-conduit 1.0.0.1 → 1.1.0

raw patch · 9 files changed

+315/−304 lines, 9 filesdep −zlib-enumPVP ok

version bump matches the API change (PVP)

Dependencies removed: zlib-enum

API changes (from Hackage documentation)

Files

• Network/HTTP/Conduit.hs +112/−117
• Network/HTTP/Conduit/ConnInfo.hs +55/−9
• Network/HTTP/Conduit/Manager.hs +79/−53
• Network/HTTP/Conduit/Parser.hs +0/−27
• Network/HTTP/Conduit/Request.hs +15/−5
• Network/HTTP/Conduit/Response.hs +50/−40
• Network/HTTP/Conduit/Util.hs +1/−2
• http-conduit.cabal +3/−14
• test.hs +0/−37

@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-} -- | This module contains everything you need to initiate HTTP connections.  If -- you want a simple interface based on URLs, you can use 'simpleHttp'. If you -- want raw power, 'http' is the underlying workhorse of this package. Some@@ -12,19 +13,19 @@ -- > main = simpleHttp "http://www.haskell.org/" >>= L.putStr -- -- This example uses interleaved IO to write the response body to a file in--- constant memory space. By using 'httpRedirect', it will automatically--- follow 3xx redirects.+-- constant memory space. -- -- > import Data.Conduit.Binary (sinkFile) -- > import Network.HTTP.Conduit -- > import System.IO+-- > import qualified Data.Conduit as C -- > -- > main :: IO () -- > main = do -- >     request <- parseUrl "http://google.com/" -- >     withManager $ \manager -> do--- >         let handler _ _ bsrc = bsrc C.$$ sinkFile "google.html"--- >         run_ $ httpRedirect request handler manager+-- >         Response _ _ bsrc <- http request handler manager+-- >         bsrc C.$$ sinkFile "google.html" -- -- The following headers are automatically set by this module, and should not -- be added to 'requestHeaders':@@ -51,15 +52,11 @@     ( -- * Perform a request       simpleHttp     , httpLbs-    , httpLbsRedirect     , http-    , httpRedirect-    , redirectConsumer       -- * Datatypes     , Proxy (..)     , RequestBody (..)     , Response (..)-    , ResponseConsumer       -- ** Request     , Request     , def@@ -75,6 +72,8 @@     , proxy     , rawBody     , decompress+    , redirectCount+    , checkStatus       -- *** Defaults     , defaultCheckCerts       -- * Manager@@ -85,7 +84,6 @@     , parseUrl     , applyBasicAuth     , addProxy-    , lbsConsumer       -- * Decompression predicates     , alwaysDecompress     , browserDecompress@@ -93,6 +91,10 @@     , urlEncodedBody       -- * Exceptions     , HttpException (..)+#if DEBUG+      -- * Debug+    , printOpenSockets+#endif     ) where  import qualified Data.ByteString as S@@ -104,10 +106,12 @@  import Control.Exception.Lifted (throwIO) import Control.Monad.Base (liftBase)+import Control.Monad.IO.Class (MonadIO (liftIO))  import qualified Data.Conduit as C import Data.Conduit.Blaze (builderToByteString) import Control.Monad.Trans.Resource (ResourceT, runResourceT, ResourceIO)+import Control.Exception.Lifted (try, SomeException)  import Network.HTTP.Conduit.Request import Network.HTTP.Conduit.Response@@ -116,114 +120,44 @@  -- | The most low-level function for initiating an HTTP request. ----- The first argument to this function gives a full specification on the--- request: the host to connect to, whether to use SSL, headers, etc. Please--- see 'Request' for full details.+-- The first argument to this function gives a full specification+-- on the request: the host to connect to, whether to use SSL,+-- headers, etc. Please see 'Request' for full details.  The+-- second argument specifies which 'Manager' should be used. ----- The second argument specifies how the response should be handled. It's a--- function that takes two arguments: the first is the HTTP status code of the--- response, and the second is a list of all response headers. This module--- exports 'lbsConsumer', which generates a 'Response' value.+-- This function then returns a 'Response' with a+-- 'C.BufferedSource'.  The 'Response' contains the status code+-- and headers that were sent back to us, and the+-- 'C.BufferedSource' contains the body of the request.  Note+-- that this 'C.BufferedSource' allows you to have fully+-- interleaved IO actions during your HTTP download, making it+-- possible to download very large responses in constant memory.+-- You may also directly connect the returned 'C.BufferedSource'+-- into a 'C.Sink', perhaps a file or another socket. ----- Note that this allows you to have fully interleaved IO actions during your--- HTTP download, making it possible to download very large responses in--- constant memory.+-- Note: Unlike previous versions, this function will perform redirects, as+-- specified by the 'redirectCount' setting. http-     :: ResourceIO m-     => Request m-     -> ResponseConsumer m a-     -> Manager-     -> ResourceT m a-http req consumer m = withConn req m $ \ci -> do-    bsrc <- C.bufferSource $ connSource ci-    requestBuilder req C.$$ builderToByteString C.=$ connSink ci-    getResponse req consumer bsrc---- | Download the specified 'Request', returning the results as a 'Response'.------ This is a simplified version of 'http' for the common case where you simply--- want the response data as a simple datatype. If you want more power, such as--- interleaved actions on the response body during download, you'll need to use--- 'http' directly. This function is defined as:------ @httpLbs = http lbsConsumer@------ Please see 'lbsConsumer' for more information on how the 'Response' value is--- created.------ Even though a 'Response' contains a lazy bytestring, this function does--- /not/ utilize lazy I/O, and therefore the entire response body will live in--- memory. If you want constant memory usage, you'll need to write your own--- iteratee and use 'http' or 'httpRedirect' directly.-httpLbs :: ResourceIO m => Request m -> Manager -> ResourceT m Response-httpLbs req = http req lbsConsumer---- | Download the specified URL, following any redirects, and return the--- response body.------ This function will 'throwIO' an 'HttpException' for any response with a--- non-2xx status code. It uses 'parseUrl' to parse the input. This function--- essentially wraps 'httpLbsRedirect'.------ Note: Even though this function returns a lazy bytestring, it does /not/--- utilize lazy I/O, and therefore the entire response body will live in--- memory. If you want constant memory usage, you'll need to write your own--- iteratee and use 'http' or 'httpRedirect' directly.-simpleHttp :: ResourceIO m => String -> m L.ByteString-simpleHttp url = runResourceT $ do-    url' <- liftBase $ parseUrl url-    man <- newManager-    Response sc _ b <- httpLbsRedirect url'-        { decompress = browserDecompress-        } man-    if 200 <= sc && sc < 300-        then return b-        else liftBase $ throwIO $ StatusCodeException sc b---- | Same as 'http', but follows all 3xx redirect status codes that contain a--- location header.-httpRedirect     :: ResourceIO m     => Request m-    -> (W.Status -> W.ResponseHeaders -> C.BufferedSource m S.ByteString -> ResourceT m a)     -> Manager-    -> ResourceT m a-httpRedirect req bodyStep manager =-    http req (redirectConsumer 10 req bodyStep manager) manager---- | Download the specified 'Request', returning the results as a 'Response'--- and automatically handling redirects.------ This is a simplified version of 'httpRedirect' for the common case where you--- simply want the response data as a simple datatype. If you want more power,--- such as interleaved actions on the response body during download, you'll--- need to use 'httpRedirect' directly. This function is defined as:------ @httpLbsRedirect = httpRedirect lbsConsumer@------ Please see 'lbsConsumer' for more information on how the 'Response' value is--- created.------ Even though a 'Response' contains a lazy bytestring, this function does--- /not/ utilize lazy I/O, and therefore the entire response body will live in--- memory. If you want constant memory usage, you'll need to write your own--- iteratee and use 'http' or 'httpRedirect' directly.-httpLbsRedirect :: ResourceIO m => Request m -> Manager -> ResourceT m Response-httpLbsRedirect req m = httpRedirect req lbsConsumer m---- | Make a request automatically follow 3xx redirects.------ Used internally by 'httpRedirect' and family.-redirectConsumer :: ResourceIO m-             => Int -- ^ number of redirects to attempt-             -> Request m -- ^ Original request-             -> ResponseConsumer m a-             -> Manager-             -> ResponseConsumer m a-redirectConsumer redirects req bodyStep manager s@(W.Status code _) hs bsrc-    | 300 <= code && code < 400 =-        case lookup "location" hs of-            Just l'' -> do+    -> ResourceT m (Response (C.BufferedSource m S.ByteString))+http req0 manager = do+    res@(Response status hs body) <-+        if redirectCount req0 == 0+            then httpRaw req0 manager+            else go (redirectCount req0) req0+    case checkStatus req0 status hs of+        Nothing -> return res+        Just exc -> do+            C.bsourceClose body+            liftBase $ throwIO exc+  where+    go 0 _ = liftBase $ throwIO TooManyRedirects+    go count req = do+        res@(Response (W.Status code _) hs _) <- httpRaw req manager+        case (300 <= code && code < 400, lookup "location" hs) of+            (True, Just l'') -> do                 -- Prepend scheme, host and port if missing                 let l' =                         case S8.uncons l'' of@@ -245,12 +179,73 @@                         , path = path l                         , queryString = queryString l                         , method =-                            if code == 303+                            -- According to the spec, this should *only* be for+                            -- status code 303. However, almost all clients+                            -- mistakenly implement it for 302 as well. So we+                            -- have to be wrong like everyone else...+                            if code == 302 || code == 303                                 then "GET"                                 else method l                         }-                if redirects == 0-                    then liftBase $ throwIO TooManyRedirects-                    else (http req') (redirectConsumer (redirects - 1) req' bodyStep manager) manager-            Nothing -> bodyStep s hs bsrc-    | otherwise = bodyStep s hs bsrc+                go (count - 1) req'+            _ -> return res++-- | Get a 'Response' without any redirect following.+httpRaw+     :: ResourceIO m+     => Request m+     -> Manager+     -> ResourceT m (Response (C.BufferedSource m S.ByteString))+httpRaw req m = do+    (connRelease, ci, isManaged) <- getConn req m+    bsrc <- C.bufferSource $ connSource ci+    ex <- try $ requestBuilder req C.$$ builderToByteString C.=$ connSink ci+    case (ex :: Either SomeException (), isManaged) of+        -- Connection was reused, and might be been closed. Try again+        (Left _, Reused) -> do+            connRelease DontReuse+            http req m+        -- Not reused, so this is a real exception+        (Left e, Fresh) -> liftBase $ throwIO e+        -- Everything went ok, so the connection is good. If any exceptions get+        -- thrown in the rest of the code, just throw them as normal.+        (Right (), _) -> getResponse connRelease req bsrc++-- | Download the specified 'Request', returning the results as a 'Response'.+--+-- This is a simplified version of 'http' for the common case where you simply+-- want the response data as a simple datatype. If you want more power, such as+-- interleaved actions on the response body during download, you'll need to use+-- 'http' directly. This function is defined as:+--+-- @httpLbs = 'lbsResponse' . 'http'@+--+-- Even though the 'Response' contains a lazy bytestring, this+-- function does /not/ utilize lazy I/O, and therefore the entire+-- response body will live in memory. If you want constant memory+-- usage, you'll need to use @conduit@ packages's+-- 'C.BufferedSource' returned by 'http'.+--+-- Note: Unlike previous versions, this function will perform redirects, as+-- specified by the 'redirectCount' setting.+httpLbs :: ResourceIO m => Request m -> Manager -> ResourceT m (Response L.ByteString)+httpLbs r = lbsResponse . http r++-- | Download the specified URL, following any redirects, and+-- return the response body.+--+-- This function will 'throwIO' an 'HttpException' for any+-- response with a non-2xx status code (besides 3xx redirects up+-- to a limit of 10 redirects). It uses 'parseUrl' to parse the+-- input. This function essentially wraps 'httpLbsRedirect'.+--+-- Note: Even though this function returns a lazy bytestring, it+-- does /not/ utilize lazy I/O, and therefore the entire response+-- body will live in memory. If you want constant memory usage,+-- you'll need to use the @conduit@ package and 'http' or+-- 'httpRedirect' directly.+simpleHttp :: MonadIO m => String -> m L.ByteString+simpleHttp url = liftIO $ runResourceT $ do+    url' <- liftBase $ parseUrl url+    man <- newManager+    fmap responseBody $ httpLbs url' man

@@ -1,6 +1,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE CPP #-} module Network.HTTP.Conduit.ConnInfo     ( ConnInfo     , connClose@@ -11,6 +12,9 @@     , TLSCertificateRejectReason(..)     , TLSCertificateUsage(..)     , getSocket+#if DEBUG+    , printOpenSockets+#endif     ) where  import Control.Exception (SomeException, throwIO, try)@@ -35,6 +39,11 @@  import qualified Data.Conduit as C +#if DEBUG+import qualified Data.IntMap as IntMap+import qualified Data.IORef as I+import System.IO.Unsafe (unsafePerformIO)+#endif  data ConnInfo = ConnInfo     { connRead :: IO ByteString@@ -58,15 +67,47 @@     , C.sourceClose = return ()     } -socketConn :: Socket -> ConnInfo-socketConn sock = ConnInfo-    { connRead  = recv sock 4096-    , connWrite = sendAll sock-    , connClose = sClose sock-    }+#if DEBUG+allOpenSockets :: I.IORef (Int, IntMap.IntMap String)+allOpenSockets = unsafePerformIO $ I.newIORef (0, IntMap.empty) -sslClientConn :: ([X509] -> IO TLSCertificateUsage) -> Handle -> IO ConnInfo-sslClientConn onCerts h = do+addSocket :: String -> IO Int+addSocket desc = I.atomicModifyIORef allOpenSockets $ \(next, m) ->+    ((next + 1, IntMap.insert next desc m), next)++removeSocket :: Int -> IO ()+removeSocket i = I.atomicModifyIORef allOpenSockets $ \(next, m) ->+    ((next, IntMap.delete i m), ())++printOpenSockets :: IO ()+printOpenSockets = do+    (_, m) <- I.readIORef allOpenSockets+    putStrLn "\n\nOpen sockets:"+    if IntMap.null m+        then putStrLn "** No open sockets!"+        else mapM_ putStrLn $ IntMap.elems m+#endif++socketConn :: String -> Socket -> IO ConnInfo+socketConn _desc sock = do+#if DEBUG+    i <- addSocket _desc+#endif+    return ConnInfo+        { connRead  = recv sock 4096+        , connWrite = sendAll sock+        , connClose = do+#if DEBUG+            removeSocket i+#endif+            sClose sock+        }++sslClientConn :: String -> ([X509] -> IO TLSCertificateUsage) -> Handle -> IO ConnInfo+sslClientConn _desc onCerts h = do+#if DEBUG+    i <- addSocket _desc+#endif     let tcp = defaultParams             { pConnectVersion = TLS10             , pAllowedVersions = [ TLS10, TLS11 ]@@ -79,7 +120,12 @@     return ConnInfo         { connRead = recvD istate         , connWrite = sendData istate . L.fromChunks . (:[])-        , connClose = bye istate >> hClose h+        , connClose = do+#if DEBUG+            removeSocket i+#endif+            bye istate+            hClose h         }   where     recvD istate = do

@@ -4,11 +4,11 @@     ( Manager     , ConnKey (..)     , newManager-    , withConn-    , WithConnResponse (..)+    , getConn     , ConnReuse (..)-    , UseConn     , withManager+    , ConnRelease+    , ManagedConn (..)     ) where  import Control.Applicative ((<$>))@@ -26,8 +26,13 @@ import qualified Data.Text as T  import Control.Monad.Base (liftBase)-import Control.Exception.Lifted (mask, try, throwIO, SomeException)-import Control.Monad.Trans.Resource (ResourceT, runResourceT, ResourceIO, withIO)+import Control.Exception.Lifted (mask)+import Control.Monad.Trans.Resource+    ( ResourceT, runResourceT, ResourceIO, withIO+    , register, release+    , newRef, readRef', writeRef+    , safeFromIOBase+    )  import Network (connectTo, PortID (PortNumber)) import Data.Certificate.X509 (X509)@@ -78,31 +83,34 @@     m <- I.atomicModifyIORef i $ \x -> (Map.empty, x)     mapM_ connClose $ Map.elems m -type UseConn m a = ConnInfo -> ResourceT m (WithConnResponse a)--withSocketConn+getSocketConn     :: ResourceIO m     => Manager     -> String     -> Int-    -> UseConn m a-    -> ResourceT m a-withSocketConn man host' port' =-    withManagedConn man (ConnKey (T.pack host') port' False) $-        fmap socketConn $ getSocket host' port'+    -> ResourceT m (ConnRelease m, ConnInfo, ManagedConn)+getSocketConn man host' port' =+    getManagedConn man (ConnKey (T.pack host') port' False) $+        getSocket host' port' >>= socketConn desc+  where+    desc = socketDesc host' port' "unsecured" -withSslConn :: ResourceIO m+socketDesc :: String -> Int -> String -> String+socketDesc h p t = unwords [h, show p, t]++getSslConn :: ResourceIO m             => ([X509] -> IO TLSCertificateUsage)             -> Manager             -> String -- ^ host             -> Int -- ^ port-            -> UseConn m a-            -> ResourceT m a-withSslConn checkCert man host' port' =-    withManagedConn man (ConnKey (T.pack host') port' True) $-        (connectTo host' (PortNumber $ fromIntegral port') >>= sslClientConn checkCert)+            -> ResourceT m (ConnRelease m, ConnInfo, ManagedConn)+getSslConn checkCert man host' port' =+    getManagedConn man (ConnKey (T.pack host') port' True) $+        (connectTo host' (PortNumber $ fromIntegral port') >>= sslClientConn desc checkCert)+  where+    desc = socketDesc host' port' "secured" -withSslProxyConn+getSslProxyConn             :: ResourceIO m             => ([X509] -> IO TLSCertificateUsage)             -> S8.ByteString -- ^ Target host@@ -110,12 +118,12 @@             -> Manager             -> String -- ^ Proxy host             -> Int -- ^ Proxy port-            -> UseConn m a-            -> ResourceT m a-withSslProxyConn checkCert thost tport man phost pport =-    withManagedConn man (ConnKey (T.pack phost) pport True) $-        doConnect >>= sslClientConn checkCert+            -> ResourceT m (ConnRelease m, ConnInfo, ManagedConn)+getSslProxyConn checkCert thost tport man phost pport =+    getManagedConn man (ConnKey (T.pack phost) pport True) $+        doConnect >>= sslClientConn desc checkCert   where+    desc = socketDesc phost pport "secured-proxy"     doConnect = do         h <- connectTo phost (PortNumber $ fromIntegral pport)         L.hPutStr h $ Blaze.toLazyByteString connectRequest@@ -136,44 +144,62 @@         error $ "Proxy failed to CONNECT to '"                 ++ S8.unpack thost ++ ":" ++ show tport ++ "' : " ++ s -withManagedConn+data ManagedConn = Fresh | Reused++-- | This function needs to acquire a @ConnInfo@- either from the @Manager@ or+-- via I\/O, and register it with the @ResourceT@ so it is guaranteed to be+-- either released or returned to the manager.+getManagedConn     :: ResourceIO m     => Manager     -> ConnKey     -> IO ConnInfo-    -> UseConn m a-    -> ResourceT m a-withManagedConn man key open f = mask $ \restore -> do+    -> ResourceT m (ConnRelease m, ConnInfo, ManagedConn)+-- We want to avoid any holes caused by async exceptions, so let's mask.+getManagedConn man key open = mask $ \restore -> do+    -- Try to take the socket out of the manager.     mci <- liftBase $ takeSocket man key     (ci, isManaged) <-         case mci of+            -- There wasn't a matching connection in the manager, so create a+            -- new one.             Nothing -> do                 ci <- restore $ liftBase open-                return (ci, False)-            Just ci -> return (ci, True)-    ea <- try $ restore $ f ci-    case ea of-        Left e -> do-            liftBase $ connClose ci-            if isManaged-                then restore $ withManagedConn man key open f-                else throwIO (e :: SomeException)-        Right (WithConnResponse cr a) -> do-            case cr of-                Reuse -> liftBase $ putSocket man key ci-                DontReuse -> liftBase $ connClose ci-            return a+                return (ci, Fresh)+            -- Return the existing one+            Just ci -> return (ci, Reused) -data WithConnResponse a = WithConnResponse !ConnReuse !a+    -- When we release this connection, we can either reuse it (put it back in+    -- the manager) or not reuse it (close the socket). We set up a mutable+    -- reference to track what we want to do. By default, we say not to reuse+    -- it, that way if an exception is thrown, the connection won't be reused.+    toReuseRef <- newRef DontReuse +    -- Now register our release action.+    releaseKey <- register $ do+        toReuse <- readRef' toReuseRef+        -- Determine what action to take based on the value stored in the+        -- toReuseRef variable.+        case toReuse of+            Reuse -> safeFromIOBase $ putSocket man key ci+            DontReuse -> safeFromIOBase $ connClose ci++    -- When the connection is explicitly released, we update our toReuseRef to+    -- indicate what action should be taken, and then call release.+    let connRelease x = do+            writeRef toReuseRef x+            release releaseKey+    return (connRelease, ci, isManaged)+ data ConnReuse = Reuse | DontReuse -withConn :: ResourceIO m-         => Request m-         -> Manager-         -> UseConn m a-         -> ResourceT m a-withConn req m =+type ConnRelease m = ConnReuse -> ResourceT m ()++getConn :: ResourceIO m+        => Request m+        -> Manager+        -> ResourceT m (ConnRelease m, ConnInfo, ManagedConn)+getConn req m =     go m connhost connport   where     h = host req@@ -183,6 +209,6 @@             Nothing -> (False, S8.unpack h, port req)     go =         case (secure req, useProxy) of-            (False, _) -> withSocketConn-            (True, False) -> withSslConn $ checkCerts req h-            (True, True) -> withSslProxyConn (checkCerts req h) h (port req)+            (False, _) -> getSocketConn+            (True, False) -> getSslConn $ checkCerts req h+            (True, True) -> getSslProxyConn (checkCerts req h) h (port req)

@@ -120,30 +120,3 @@     lower = do         d <- satisfy $ \w -> (w >= 97 && w <= 102)         return $ d - 87--{--sinkParserTill :: Monad m-               => Parser a-               -> Parser end-               -> E.Enumeratee a S.ByteString m b-sinkParserTill p pend =-    E.continue $ step $ parse p-  where-    step parse (E.Chunks xs) = parseLoop parse xs-    step parse E.EOF = case parse S.empty of-        Done extra a -> E.yield a $ if S.null extra-            then E.Chunks []-            else E.Chunks [extra]-        Partial _ -> err [] "sinkParser: divergent parser"-        Fail _ ctx msg -> err ctx msg--    parseLoop parse [] = E.continue (step parse)-    parseLoop parse (x:xs) = case parse x of-        Done extra a -> E.yield a $ if S.null extra-            then E.Chunks xs-            else E.Chunks (extra:xs)-        Partial parse' -> parseLoop parse' xs-        Fail _ ctx msg -> err ctx msg--    err ctx msg = E.throwError (ParseError ctx msg)--}

@@ -42,7 +42,7 @@ import Network.TLS (TLSCertificateUsage (CertificateUsageAccept)) import Network.TLS.Extra (certificateVerifyChain, certificateVerifyDomain) -import Control.Exception (Exception)+import Control.Exception (Exception, SomeException, toException) import Control.Failure (Failure (failure)) import Codec.Binary.UTF8.String (encodeString) import qualified Data.CaseInsensitive as CI@@ -51,7 +51,6 @@ import Network.HTTP.Conduit.Chunk (chunkIt) import Network.HTTP.Conduit.Util (readDec, (<>)) - type ContentType = S.ByteString  -- | All information on how to connect to a host and what should be sent in the@@ -86,7 +85,13 @@     , decompress :: ContentType -> Bool     -- ^ Predicate to specify whether gzipped data should be     -- decompressed on the fly (see 'alwaysDecompress' and-    -- 'browserDecompress').+    -- 'browserDecompress'). Default: browserDecompress.+    , redirectCount :: Int+    -- ^ How many redirects to follow when getting a resource. 0 means follow+    -- no redirects. Default value: 10.+    , 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.     }  -- | When using one of the@@ -175,7 +180,12 @@         , method = "GET"         , proxy = Nothing         , rawBody = False-        , decompress = alwaysDecompress+        , decompress = browserDecompress+        , redirectCount = 10+        , checkStatus = \s@(W.Status sci _) hs ->+            if 200 <= sci && sci < 300+                then Nothing+                else Just $ toException $ StatusCodeException s hs         }  parseUrl2 :: Failure HttpException m@@ -211,7 +221,7 @@                 (readDec rest)             x -> error $ "parseUrl1: this should never happen: " ++ show x -data HttpException = StatusCodeException Int L.ByteString+data HttpException = StatusCodeException W.Status W.ResponseHeaders                    | InvalidUrlException String String                    | TooManyRedirects                    | HttpParserException String

@@ -3,16 +3,14 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} module Network.HTTP.Conduit.Response-    ( lbsConsumer-    , Response (..)-    , ResponseConsumer+    ( Response (..)     , getResponse+    , lbsResponse     ) where  import Control.Arrow (first) import Data.Typeable (Typeable) -import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L @@ -32,47 +30,42 @@ import Network.HTTP.Conduit.Parser import Network.HTTP.Conduit.Chunk ---- | Convert the HTTP response into a 'Response' value.------ Even though a 'Response' contains a lazy bytestring, this function does--- /not/ utilize lazy I/O, and therefore the entire response body will live in--- memory. If you want constant memory usage, you'll need to write your own--- iteratee and use 'http' or 'httpRedirect' directly.-lbsConsumer :: ResourceIO m => ResponseConsumer m Response-lbsConsumer (W.Status sc _) hs bsrc = do-    lbs <- fmap L.fromChunks $ bsrc C.$$ CL.consume-    return $ Response sc hs lbs- -- | A simple representation of the HTTP response created by 'lbsConsumer'.-data Response = Response-    { statusCode :: Int+data Response body = Response+    { statusCode :: W.Status     , responseHeaders :: W.ResponseHeaders-    , responseBody :: L.ByteString+    , responseBody :: body     }-    deriving (Show, Read, Eq, Typeable)+    deriving (Show, Eq, Typeable) -type ResponseConsumer m a-    = W.Status-   -> W.ResponseHeaders-   -> C.BufferedSource m S.ByteString-   -> ResourceT m a+-- | Convert a 'Response' that has a 'C.BufferedSource' body to one with a lazy+-- 'L.ByteString' body.+lbsResponse :: C.Resource m+            => ResourceT m (Response (C.BufferedSource m S8.ByteString))+            -> ResourceT m (Response L.ByteString)+lbsResponse mres = do+    res <- mres+    bss <- responseBody res C.$$ CL.consume+    return res+        { responseBody = L.fromChunks bss+        }  getResponse :: ResourceIO m-            => Request m-            -> ResponseConsumer m a+            => ConnRelease m+            -> Request m             -> C.BufferedSource m S8.ByteString-            -> ResourceT m (WithConnResponse a)-getResponse req@(Request {..}) bodyStep bsrc = do+            -> ResourceT m (Response (C.BufferedSource m S8.ByteString))+getResponse connRelease req@(Request {..}) bsrc = do     ((_, sc, sm), hs) <- bsrc C.$$ sinkHeaders     let s = W.Status sc sm     let hs' = map (first CI.mk) hs     let mcl = lookup "content-length" hs' >>= readDec . S8.unpack+     -- RFC 2616 section 4.4_1 defines responses that must not include a body-    res <- if hasNoBody method sc || mcl == Just 0+    body <- if hasNoBody method sc || mcl == Just 0         then do-            bsrcNull <- C.bufferSource $ CL.sourceList []-            bodyStep s hs' bsrcNull+            -- FIXME clean up socket+            C.bufferSource $ CL.sourceList []         else do             bsrc' <-                 if ("transfer-encoding", "chunked") `elem` hs'@@ -81,14 +74,31 @@                         case mcl of                             Just len -> C.bufferSource $ bsrc C.$= CB.isolate len                             Nothing  -> return bsrc-            bsrc'' <--                if needsGunzip req hs'-                    then C.bufferSource $ bsrc' C.$= CZ.ungzip-                    else return bsrc'-            bodyStep s hs' bsrc''-            -- FIXME this is causing hangs, need to look into it bsrc C.$$ CL.sinkNull-            -- Most likely just need to flush the actual buffer+            if needsGunzip req hs'+                then C.bufferSource $ bsrc' C.$= CZ.ungzip+                else return bsrc'      -- should we put this connection back into the connection manager?     let toPut = Just "close" /= lookup "connection" hs'-    return $ WithConnResponse (if toPut then Reuse else DontReuse) res+    let cleanup = connRelease $ if toPut then Reuse else DontReuse++    return $ Response s hs' $ addCleanup cleanup body++-- | Add some cleanup code to the given 'C.BufferedSource'. General purpose+-- function, could be included in conduit itself.+addCleanup :: C.ResourceIO m+           => ResourceT m ()+           -> C.BufferedSource m a+           -> C.BufferedSource m a+addCleanup cleanup bsrc = C.BufferedSource+    { C.bsourcePull = do+        res <- C.bsourcePull bsrc+        case res of+            C.Closed -> cleanup+            C.Open _ -> return ()+        return res+    , C.bsourceUnpull = C.bsourceUnpull bsrc+    , C.bsourceClose = do+        C.bsourceClose bsrc+        cleanup+    }

@@ -15,8 +15,7 @@ import qualified Data.Text as T import qualified Data.Text.Read -#if 1--- FIXME MIN_VERSION_base(4,3,0)+#if MIN_VERSION_base(4,3,0) import Data.ByteString (hGetSome) #else import GHC.IO.Handle.Types

@@ -1,5 +1,5 @@ name:            http-conduit-version:         1.0.0.1+version:         1.1.0 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -11,11 +11,8 @@ stability:       Stable cabal-version:   >= 1.6 build-type:      Simple-homepage:        http://github.com/snoyberg/http-enumerator+homepage:        http://github.com/snoyberg/http-conduit -flag test-  description: Build the test executable.-  default: False flag network-bytestring   default: False @@ -31,7 +28,6 @@                  , attoparsec            >= 0.8.0.2 && < 0.11                  , utf8-string           >= 0.3.4   && < 0.4                  , blaze-builder         >= 0.2.1   && < 0.4-                 , zlib-enum             >= 0.2     && < 0.3                  , http-types            >= 0.6     && < 0.7                  , cprng-aes             >= 0.2     && < 0.3                  , tls                   >= 0.8.1   && < 0.9@@ -61,13 +57,6 @@                      Network.HTTP.Conduit.Response     ghc-options:     -Wall -executable http-conduit-    main-is: test.hs-    if flag(test)-        Buildable: True-    else-        Buildable: False- source-repository head   type:     git-  location: git://github.com/snoyberg/http-enumerator.git+  location: git://github.com/snoyberg/http-conduit.git

@@ -1,37 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-}-import Network.HTTP.Conduit-import Network-import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L-import System.Environment.UTF8 (getArgs)-import Data.CaseInsensitive (original)-import Data.Conduit-import Control.Monad.IO.Class--main :: IO ()-main = withSocketsDo $ do-    [url] <- getArgs-    _req2 <- parseUrl url-    let req = {-urlEncodedBody-                [ ("foo", "bar")-                , ("baz%%38**.8fn", "bin")-                ]-} _req2-                    { method = "OPTIONS"-                    }-    runResourceT $ do-        man <- newManager-        Response sc hs b <- httpLbsRedirect req man-#if DEBUG-        return ()-#else-        liftIO $ do-            print sc-            mapM_ (\(x, y) -> do-                S.putStr $ original x-                putStr ": "-                S.putStr y-                putStrLn "") hs-            putStrLn ""-            L.putStr b-#endif