http-conduit 1.1.0.1 → 1.1.1

raw patch · 12 files changed

+1647/−1438 lines, 12 filesdep +HUnitdep +hspecdep +timedep ~asn1-datadep ~attoparsecdep ~attoparsec-conduitsetup-changed

Dependencies added: HUnit, hspec, time, wai, warp

Dependency ranges changed: asn1-data, attoparsec, attoparsec-conduit, base64-bytestring, blaze-builder, blaze-builder-conduit, bytestring, case-insensitive, certificate, conduit, containers, cprng-aes, data-default, failure, http-types, lifted-base, monad-control, network, tls, tls-extra, transformers, transformers-base, utf8-string, zlib-conduit

Files

• LICENSE +25/−25
• Network/HTTP/Conduit.hs +254/−251
• Network/HTTP/Conduit/Chunk.hs +82/−82
• Network/HTTP/Conduit/ConnInfo.hs +169/−155
• Network/HTTP/Conduit/Manager.hs +316/−214
• Network/HTTP/Conduit/Parser.hs +122/−122
• Network/HTTP/Conduit/Request.hs +344/−344
• Network/HTTP/Conduit/Response.hs +104/−104
• Network/HTTP/Conduit/Util.hs +71/−71
• Setup.lhs +8/−8
• http-conduit.cabal +103/−62
• test/main.hs +49/−0

@@ -1,25 +1,25 @@-The following license covers this documentation, and the source code, except-where otherwise indicated.--Copyright 2010, Michael Snoyman. All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:--* Redistributions of source code must retain the above copyright notice, this-  list of conditions and the following disclaimer.--* Redistributions in binary form must reproduce the above copyright notice,-  this list of conditions and the following disclaimer in the documentation-  and/or other materials provided with the distribution.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR-IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO-EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,-INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT-NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,-OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF-LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE-OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF-ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+The following license covers this documentation, and the source code, except
+where otherwise indicated.
+
+Copyright 2010, Michael Snoyman. All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright notice,
+  this list of conditions and the following disclaimer in the documentation
+  and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -1,251 +1,254 @@-{-# 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--- examples:------ > -- Just download an HTML document and print it.--- > import Network.HTTP.Conduit--- > import qualified Data.ByteString.Lazy as L--- >--- > 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.------ > 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--- >         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':------ * Content-Length------ * Host------ * Accept-Encoding (not currently set, but client usage of this variable /will/ cause breakage).------ Any network code on Windows requires some initialization, and the network--- library provides withSocketsDo to perform it. Therefore, proper usage of--- this library will always involve calling that function at some point.  The--- best approach is to simply call them at the beginning of your main function,--- such as:------ > import Network.HTTP.Conduit--- > import qualified Data.ByteString.Lazy as L--- > import Network (withSocketsDo)--- >--- > main = withSocketsDo--- >      $ simpleHttp "http://www.haskell.org/" >>= L.putStr-module Network.HTTP.Conduit-    ( -- * Perform a request-      simpleHttp-    , httpLbs-    , http-      -- * Datatypes-    , Proxy (..)-    , RequestBody (..)-    , Response (..)-      -- ** Request-    , Request-    , def-    , method-    , secure-    , checkCerts-    , host-    , port-    , path-    , queryString-    , requestHeaders-    , requestBody-    , proxy-    , rawBody-    , decompress-    , redirectCount-    , checkStatus-      -- *** Defaults-    , defaultCheckCerts-      -- * Manager-    , Manager-    , newManager-    , withManager-      -- * Utility functions-    , parseUrl-    , applyBasicAuth-    , addProxy-      -- * Decompression predicates-    , alwaysDecompress-    , browserDecompress-      -- * Request bodies-    , urlEncodedBody-      -- * Exceptions-    , HttpException (..)-#if DEBUG-      -- * Debug-    , printOpenSockets-#endif-    ) where--import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString.Char8 as S8--import qualified Network.HTTP.Types as W-import Data.Default (def)--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-import Network.HTTP.Conduit.Manager-import Network.HTTP.Conduit.ConnInfo---- | 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--- second argument specifies which 'Manager' should be used.------ 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: Unlike previous versions, this function will perform redirects, as--- specified by the 'redirectCount' setting.-http-    :: ResourceIO m-    => Request m-    -> Manager-    -> 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-                            Just ('/', _) -> concat-                                [ "http"-                                , if secure req then "s" else ""-                                , "://"-                                , S8.unpack $ host req-                                , ":"-                                , show $ port req-                                , S8.unpack l''-                                ]-                            _ -> S8.unpack l''-                l <- liftBase $ parseUrl l'-                let req' = req-                        { host = host l-                        , port = port l-                        , secure = secure l-                        , path = path l-                        , queryString = queryString l-                        , method =-                            -- 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-                        }-                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+{-# 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
+-- examples:
+--
+-- > -- Just download an HTML document and print it.
+-- > import Network.HTTP.Conduit
+-- > import qualified Data.ByteString.Lazy as L
+-- >
+-- > 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.
+--
+-- > 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
+-- >         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':
+--
+-- * Content-Length
+--
+-- * Host
+--
+-- * Accept-Encoding (not currently set, but client usage of this variable /will/ cause breakage).
+--
+-- Any network code on Windows requires some initialization, and the network
+-- library provides withSocketsDo to perform it. Therefore, proper usage of
+-- this library will always involve calling that function at some point.  The
+-- best approach is to simply call them at the beginning of your main function,
+-- such as:
+--
+-- > import Network.HTTP.Conduit
+-- > import qualified Data.ByteString.Lazy as L
+-- > import Network (withSocketsDo)
+-- >
+-- > main = withSocketsDo
+-- >      $ simpleHttp "http://www.haskell.org/" >>= L.putStr
+module Network.HTTP.Conduit
+    ( -- * Perform a request
+      simpleHttp
+    , httpLbs
+    , http
+      -- * Datatypes
+    , Proxy (..)
+    , RequestBody (..)
+    , Response (..)
+      -- ** Request
+    , Request
+    , def
+    , method
+    , secure
+    , checkCerts
+    , host
+    , port
+    , path
+    , queryString
+    , requestHeaders
+    , requestBody
+    , proxy
+    , rawBody
+    , decompress
+    , redirectCount
+    , checkStatus
+      -- *** Defaults
+    , defaultCheckCerts
+      -- * Manager
+    , Manager
+    , newManager
+    , newManagerCount
+    , newManagerIO
+    , withManager
+      -- * Utility functions
+    , parseUrl
+    , applyBasicAuth
+    , addProxy
+    , lbsResponse
+      -- * Decompression predicates
+    , alwaysDecompress
+    , browserDecompress
+      -- * Request bodies
+    , urlEncodedBody
+      -- * Exceptions
+    , HttpException (..)
+#if DEBUG
+      -- * Debug
+    , printOpenSockets
+#endif
+    ) where
+
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Char8 as S8
+
+import qualified Network.HTTP.Types as W
+import Data.Default (def)
+
+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
+import Network.HTTP.Conduit.Manager
+import Network.HTTP.Conduit.ConnInfo
+
+-- | 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
+-- second argument specifies which 'Manager' should be used.
+--
+-- 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: Unlike previous versions, this function will perform redirects, as
+-- specified by the 'redirectCount' setting.
+http
+    :: ResourceIO m
+    => Request m
+    -> Manager
+    -> 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
+                            Just ('/', _) -> concat
+                                [ "http"
+                                , if secure req then "s" else ""
+                                , "://"
+                                , S8.unpack $ host req
+                                , ":"
+                                , show $ port req
+                                , S8.unpack l''
+                                ]
+                            _ -> S8.unpack l''
+                l <- liftBase $ parseUrl l'
+                let req' = req
+                        { host = host l
+                        , port = port l
+                        , secure = secure l
+                        , path = path l
+                        , queryString = queryString l
+                        , method =
+                            -- 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
+                        }
+                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,82 +1,82 @@-{-# LANGUAGE FlexibleContexts #-}-module Network.HTTP.Conduit.Chunk-    ( chunkedConduit-    , chunkIt-    ) where--import Control.Exception (assert)-import Numeric (showHex)--import Control.Monad.Trans.Class (lift)--import qualified Data.ByteString as S-import qualified Data.ByteString.Char8 as S8--import Blaze.ByteString.Builder.HTTP-import qualified Blaze.ByteString.Builder as Blaze--import qualified Data.Attoparsec.ByteString as A--import qualified Data.Conduit as C-import Data.Conduit.Attoparsec (ParseError (ParseError))--import Network.HTTP.Conduit.Parser---data CState = NeedHeader (S.ByteString -> A.Result Int)-            | Isolate Int-            | NeedNewline (S.ByteString -> A.Result ())-            | Complete--chunkedConduit :: C.ResourceThrow m-               => Bool -- ^ send the headers as well, necessary for a proxy-               -> C.Conduit S.ByteString m S.ByteString-chunkedConduit sendHeaders = C.conduitState-    (NeedHeader $ A.parse parseChunkHeader)-    (push id)-    close-  where-    push front (NeedHeader f) x =-        case f x of-            A.Done x' i-                | i == 0 -> push front Complete x'-                | otherwise -> do-                    let header = S8.pack $ showHex i "\r\n"-                    let addHeader = if sendHeaders then (header:) else id-                    push (front . addHeader) (Isolate i) x'-            A.Partial f' -> return (NeedHeader f', C.Producing $ front [])-            A.Fail _ contexts msg -> lift $ C.resourceThrow $ ParseError contexts msg-    push front (Isolate i) x = do-        let (a, b) = S.splitAt i x-            i' = i - S.length a-        if i' == 0-            then push-                    (front . (a:))-                    (NeedNewline $ A.parse newline)-                    b-            else assert (S.null b) $ return-                ( Isolate i'-                , C.Producing (front [a])-                )-    push front (NeedNewline f) x =-        case f x of-            A.Done x' () -> do-                let header = S8.pack "\r\n"-                let addHeader = if sendHeaders then (header:) else id-                push-                    (front . addHeader)-                    (NeedHeader $ A.parse parseChunkHeader)-                    x'-            A.Partial f' -> return (NeedNewline f', C.Producing $ front [])-            A.Fail _ contexts msg -> lift $ C.resourceThrow $ ParseError contexts msg-    push front Complete leftover = do-        let end = if sendHeaders then [S8.pack "0\r\n"] else []-            lo = if S.null leftover then Nothing else Just leftover-        return (Complete, C.Finished lo $ front end)-    close _ = return []--chunkIt :: C.Resource m => C.Conduit Blaze.Builder m Blaze.Builder-chunkIt = C.Conduit $ return $ C.PreparedConduit-    { C.conduitPush = \xs -> return $ C.Producing [chunkedTransferEncoding xs]-    , C.conduitClose = return [chunkedTransferTerminator]-    }+{-# LANGUAGE FlexibleContexts #-}
+module Network.HTTP.Conduit.Chunk
+    ( chunkedConduit
+    , chunkIt
+    ) where
+
+import Control.Exception (assert)
+import Numeric (showHex)
+
+import Control.Monad.Trans.Class (lift)
+
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Char8 as S8
+
+import Blaze.ByteString.Builder.HTTP
+import qualified Blaze.ByteString.Builder as Blaze
+
+import qualified Data.Attoparsec.ByteString as A
+
+import qualified Data.Conduit as C
+import Data.Conduit.Attoparsec (ParseError (ParseError))
+
+import Network.HTTP.Conduit.Parser
+
+
+data CState = NeedHeader (S.ByteString -> A.Result Int)
+            | Isolate Int
+            | NeedNewline (S.ByteString -> A.Result ())
+            | Complete
+
+chunkedConduit :: C.ResourceThrow m
+               => Bool -- ^ send the headers as well, necessary for a proxy
+               -> C.Conduit S.ByteString m S.ByteString
+chunkedConduit sendHeaders = C.conduitState
+    (NeedHeader $ A.parse parseChunkHeader)
+    (push id)
+    close
+  where
+    push front (NeedHeader f) x =
+        case f x of
+            A.Done x' i
+                | i == 0 -> push front Complete x'
+                | otherwise -> do
+                    let header = S8.pack $ showHex i "\r\n"
+                    let addHeader = if sendHeaders then (header:) else id
+                    push (front . addHeader) (Isolate i) x'
+            A.Partial f' -> return (NeedHeader f', C.Producing $ front [])
+            A.Fail _ contexts msg -> lift $ C.resourceThrow $ ParseError contexts msg
+    push front (Isolate i) x = do
+        let (a, b) = S.splitAt i x
+            i' = i - S.length a
+        if i' == 0
+            then push
+                    (front . (a:))
+                    (NeedNewline $ A.parse newline)
+                    b
+            else assert (S.null b) $ return
+                ( Isolate i'
+                , C.Producing (front [a])
+                )
+    push front (NeedNewline f) x =
+        case f x of
+            A.Done x' () -> do
+                let header = S8.pack "\r\n"
+                let addHeader = if sendHeaders then (header:) else id
+                push
+                    (front . addHeader)
+                    (NeedHeader $ A.parse parseChunkHeader)
+                    x'
+            A.Partial f' -> return (NeedNewline f', C.Producing $ front [])
+            A.Fail _ contexts msg -> lift $ C.resourceThrow $ ParseError contexts msg
+    push front Complete leftover = do
+        let end = if sendHeaders then [S8.pack "0\r\n"] else []
+            lo = if S.null leftover then Nothing else Just leftover
+        return (Complete, C.Finished lo $ front end)
+    close _ = return []
+
+chunkIt :: C.Resource m => C.Conduit Blaze.Builder m Blaze.Builder
+chunkIt = C.Conduit $ return $ C.PreparedConduit
+    { C.conduitPush = \xs -> return $ C.Producing [chunkedTransferEncoding xs]
+    , C.conduitClose = return [chunkedTransferTerminator]
+    }

@@ -1,155 +1,169 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE CPP #-}-module Network.HTTP.Conduit.ConnInfo-    ( ConnInfo-    , connClose-    , connSink-    , connSource-    , sslClientConn-    , socketConn-    , TLSCertificateRejectReason(..)-    , TLSCertificateUsage(..)-    , getSocket-#if DEBUG-    , printOpenSockets-#endif-    ) where--import Control.Exception (SomeException, throwIO, try)-import System.IO (Handle, hClose)--import Control.Monad.Base (MonadBase, liftBase)--import Data.ByteString (ByteString)-import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L--import Network.Socket (Socket, sClose)-import Network.Socket.ByteString (recv, sendAll)-import qualified Network.Socket as NS--import Network.TLS-import Network.TLS.Extra (ciphersuite_all)--import Data.Certificate.X509 (X509)--import Crypto.Random.AESCtr (makeSystem)--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-    , connWrite :: ByteString -> IO ()-    , connClose :: IO ()-    }--connSink :: C.ResourceIO m => ConnInfo -> C.Sink ByteString m ()-connSink ConnInfo { connWrite = write } = C.Sink $ return $ C.SinkData-    { C.sinkPush = \bss -> liftBase (write bss) >> return C.Processing-    , C.sinkClose = return ()-    }--connSource :: C.ResourceIO m => ConnInfo -> C.Source m ByteString-connSource ConnInfo { connRead = read' } = C.Source $ return $ C.PreparedSource-    { C.sourcePull = do-        bs <- liftBase read'-        if S.null bs-            then return C.Closed-            else return $ C.Open bs-    , C.sourceClose = return ()-    }--#if DEBUG-allOpenSockets :: I.IORef (Int, IntMap.IntMap String)-allOpenSockets = unsafePerformIO $ I.newIORef (0, IntMap.empty)--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 ]-            , pCiphers = ciphersuite_all-            , onCertificatesRecv = onCerts-            }-    gen <- makeSystem-    istate <- client tcp gen h-    _ <- handshake istate-    return ConnInfo-        { connRead = recvD istate-        , connWrite = sendData istate . L.fromChunks . (:[])-        , connClose = do-#if DEBUG-            removeSocket i-#endif-            bye istate-            hClose h-        }-  where-    recvD istate = do-        x <- recvData istate-        if L.null x-            then recvD istate-            else return $ S.concat $ L.toChunks x-            -- Although a 'concat' seems like a bad idea, at-            -- least on tls-0.8.4 it's guaranteed to always-            -- return a lazy bytestring with a single chunk.--getSocket :: String -> Int -> IO NS.Socket-getSocket host' port' = do-    let hints = NS.defaultHints {-                          NS.addrFlags = [NS.AI_ADDRCONFIG]-                        , NS.addrSocketType = NS.Stream-                        }-    (addr:_) <- NS.getAddrInfo (Just hints) (Just host') (Just $ show port')-    sock <- NS.socket (NS.addrFamily addr) (NS.addrSocketType addr)-                      (NS.addrProtocol addr)-    ee <- try' $ NS.connect sock (NS.addrAddress addr)-    case ee of-        Left e -> NS.sClose sock >> throwIO e-        Right () -> return sock-  where-    try' :: IO a -> IO (Either SomeException a)-    try' = try+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE CPP #-}
+module Network.HTTP.Conduit.ConnInfo
+    ( ConnInfo
+    , connClose
+    , connSink
+    , connSource
+    , sslClientConn
+    , socketConn
+    , TLSCertificateRejectReason(..)
+    , TLSCertificateUsage(..)
+    , getSocket
+#if DEBUG
+    , printOpenSockets
+    , requireAllSocketsClosed
+    , clearSocketsList
+#endif
+    ) where
+
+import Control.Exception (SomeException, throwIO, try)
+import System.IO (Handle, hClose)
+
+import Control.Monad.Base (MonadBase, liftBase)
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as L
+
+import Network.Socket (Socket, sClose)
+import Network.Socket.ByteString (recv, sendAll)
+import qualified Network.Socket as NS
+
+import Network.TLS
+import Network.TLS.Extra (ciphersuite_all)
+
+import Data.Certificate.X509 (X509)
+
+import Crypto.Random.AESCtr (makeSystem)
+
+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
+    , connWrite :: ByteString -> IO ()
+    , connClose :: IO ()
+    }
+
+connSink :: C.ResourceIO m => ConnInfo -> C.Sink ByteString m ()
+connSink ConnInfo { connWrite = write } = C.Sink $ return $ C.SinkData
+    { C.sinkPush = \bss -> liftBase (write bss) >> return C.Processing
+    , C.sinkClose = return ()
+    }
+
+connSource :: C.ResourceIO m => ConnInfo -> C.Source m ByteString
+connSource ConnInfo { connRead = read' } = C.Source $ return $ C.PreparedSource
+    { C.sourcePull = do
+        bs <- liftBase read'
+        if S.null bs
+            then return C.Closed
+            else return $ C.Open bs
+    , C.sourceClose = return ()
+    }
+
+#if DEBUG
+allOpenSockets :: I.IORef (Int, IntMap.IntMap String)
+allOpenSockets = unsafePerformIO $ I.newIORef (0, IntMap.empty)
+
+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
+
+requireAllSocketsClosed :: IO ()
+requireAllSocketsClosed = do
+    (_, m) <- I.readIORef allOpenSockets
+    if IntMap.null m
+        then return ()
+        else error $ unlines
+            $ "requireAllSocketsClosed: there are open sockets"
+            : IntMap.elems m
+
+clearSocketsList :: IO ()
+clearSocketsList = I.writeIORef allOpenSockets (0, IntMap.empty)
+#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 ]
+            , pCiphers = ciphersuite_all
+            , onCertificatesRecv = onCerts
+            }
+    gen <- makeSystem
+    istate <- client tcp gen h
+    _ <- handshake istate
+    return ConnInfo
+        { connRead = recvD istate
+        , connWrite = sendData istate . L.fromChunks . (:[])
+        , connClose = do
+#if DEBUG
+            removeSocket i
+#endif
+            bye istate
+            hClose h
+        }
+  where
+    recvD istate = do
+        x <- recvData istate
+        if L.null x
+            then recvD istate
+            else return $ S.concat $ L.toChunks x
+            -- Although a 'concat' seems like a bad idea, at
+            -- least on tls-0.8.4 it's guaranteed to always
+            -- return a lazy bytestring with a single chunk.
+
+getSocket :: String -> Int -> IO NS.Socket
+getSocket host' port' = do
+    let hints = NS.defaultHints {
+                          NS.addrFlags = [NS.AI_ADDRCONFIG]
+                        , NS.addrSocketType = NS.Stream
+                        }
+    (addr:_) <- NS.getAddrInfo (Just hints) (Just host') (Just $ show port')
+    sock <- NS.socket (NS.addrFamily addr) (NS.addrSocketType addr)
+                      (NS.addrProtocol addr)
+    ee <- try' $ NS.connect sock (NS.addrAddress addr)
+    case ee of
+        Left e -> NS.sClose sock >> throwIO e
+        Right () -> return sock
+  where
+    try' :: IO a -> IO (Either SomeException a)
+    try' = try

@@ -1,214 +1,316 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-module Network.HTTP.Conduit.Manager-    ( Manager-    , ConnKey (..)-    , newManager-    , getConn-    , ConnReuse (..)-    , withManager-    , ConnRelease-    , ManagedConn (..)-    ) where--import Control.Applicative ((<$>))-import Data.Monoid (mappend)-import System.IO (hClose, hFlush)-import qualified Data.IORef as I-import qualified Data.Map as Map--import qualified Data.ByteString.Char8 as S8-import qualified Data.ByteString.Lazy as L--import qualified Blaze.ByteString.Builder as Blaze--import Data.Text (Text)-import qualified Data.Text as T--import Control.Monad.Base (liftBase)-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)--import Network.HTTP.Conduit.ConnInfo-import Network.HTTP.Conduit.Util (hGetSome)-import Network.HTTP.Conduit.Parser (parserHeadersFromByteString)-import Network.HTTP.Conduit.Request----- | Keeps track of open connections for keep-alive.  May be used--- concurrently by multiple threads.-newtype Manager = Manager-    { mConns :: I.IORef (Map.Map ConnKey ConnInfo)-    }---- | @ConnKey@ consists of a hostname, a port and a @Bool@--- specifying whether to use keepalive.-data ConnKey = ConnKey !Text !Int !Bool-    deriving (Eq, Show, Ord)--takeSocket :: Manager -> ConnKey -> IO (Maybe ConnInfo)-takeSocket man key =-    I.atomicModifyIORef (mConns man) go-  where-    go m = (Map.delete key m, Map.lookup key m)--putSocket :: Manager -> ConnKey -> ConnInfo -> IO ()-putSocket man key ci = do-    msock <- I.atomicModifyIORef (mConns man) go-    maybe (return ()) connClose msock-  where-    go m = (Map.insert key ci m, Map.lookup key m)---- | Create a new 'Manager' with no open connections.-newManager :: ResourceIO m => ResourceT m Manager-newManager = snd <$> withIO-    (Manager <$> I.newIORef Map.empty)-    closeManager--withManager :: ResourceIO m => (Manager -> ResourceT m a) -> m a-withManager f = runResourceT $ newManager >>= f---- | Close all connections in a 'Manager'. Afterwards, the--- 'Manager' can be reused if desired.-closeManager :: Manager -> IO ()-closeManager (Manager i) = do-    m <- I.atomicModifyIORef i $ \x -> (Map.empty, x)-    mapM_ connClose $ Map.elems m--getSocketConn-    :: ResourceIO m-    => Manager-    -> String-    -> Int-    -> 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"--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-            -> 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"--getSslProxyConn-            :: ResourceIO m-            => ([X509] -> IO TLSCertificateUsage)-            -> S8.ByteString -- ^ Target host-            -> Int -- ^ Target port-            -> Manager-            -> String -- ^ Proxy host-            -> Int -- ^ Proxy port-            -> 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-        hFlush h-        r <- hGetSome h 2048-        res <- parserHeadersFromByteString r-        case res of-            Right ((_, 200, _), _) -> return h-            Right ((_, _, msg), _) -> hClose h >> proxyError (S8.unpack msg)-            Left s -> hClose h >> proxyError s--    connectRequest =-        Blaze.fromByteString "CONNECT "-            `mappend` Blaze.fromByteString thost-            `mappend` Blaze.fromByteString (S8.pack (':' : show tport))-            `mappend` Blaze.fromByteString " HTTP/1.1\r\n\r\n"-    proxyError s =-        error $ "Proxy failed to CONNECT to '"-                ++ S8.unpack thost ++ ":" ++ show tport ++ "' : " ++ s--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-    -> 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, Fresh)-            -- Return the existing one-            Just ci -> return (ci, Reused)--    -- 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--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-    (useProxy, connhost, connport) =-        case proxy req of-            Just p -> (True, S8.unpack (proxyHost p), proxyPort p)-            Nothing -> (False, S8.unpack h, port req)-    go =-        case (secure req, useProxy) of-            (False, _) -> getSocketConn-            (True, False) -> getSslConn $ checkCerts req h-            (True, True) -> getSslProxyConn (checkCerts req h) h (port req)+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Network.HTTP.Conduit.Manager
+    ( Manager
+    , ConnKey (..)
+    , newManager
+    , newManagerCount
+    , newManagerIO
+    , getConn
+    , ConnReuse (..)
+    , withManager
+    , ConnRelease
+    , ManagedConn (..)
+    ) where
+
+import Prelude hiding (catch)
+import Control.Applicative ((<$>))
+import Data.Monoid (mappend)
+import System.IO (hClose, hFlush)
+import qualified Data.IORef as I
+import qualified Data.Map as Map
+
+import qualified Data.ByteString.Char8 as S8
+import qualified Data.ByteString.Lazy as L
+
+import qualified Blaze.ByteString.Builder as Blaze
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+import Control.Monad.Base (liftBase)
+import Control.Exception.Lifted (mask)
+import Control.Exception (mask_, SomeException, catch)
+import Control.Monad.Trans.Resource
+    ( ResourceT, runResourceT, ResourceIO, withIO
+    , register, release
+    , newRef, readRef', writeRef
+    , safeFromIOBase
+    )
+import Control.Concurrent (forkIO, threadDelay)
+import Data.Time (UTCTime, getCurrentTime, addUTCTime)
+
+import Network (connectTo, PortID (PortNumber))
+import Data.Certificate.X509 (X509)
+
+import Network.HTTP.Conduit.ConnInfo
+import Network.HTTP.Conduit.Util (hGetSome)
+import Network.HTTP.Conduit.Parser (parserHeadersFromByteString)
+import Network.HTTP.Conduit.Request
+
+-- | Keeps track of open connections for keep-alive.  May be used
+-- concurrently by multiple threads.
+data Manager = Manager
+    { mConns :: !(I.IORef (Maybe (Map.Map ConnKey (NonEmptyList ConnInfo))))
+    -- ^ @Nothing@ indicates that the manager is closed.
+    , mMaxConns :: !Int
+    -- ^ This is a per-@ConnKey@ value.
+    }
+
+data NonEmptyList a =
+    One !a !UTCTime |
+    Cons !a !Int !UTCTime !(NonEmptyList a)
+
+-- | @ConnKey@ consists of a hostname, a port and a @Bool@
+-- specifying whether to use keepalive.
+data ConnKey = ConnKey !Text !Int !Bool
+    deriving (Eq, Show, Ord)
+
+takeSocket :: Manager -> ConnKey -> IO (Maybe ConnInfo)
+takeSocket man key =
+    I.atomicModifyIORef (mConns man) go
+  where
+    go Nothing = (Nothing, Nothing)
+    go (Just m) =
+        case Map.lookup key m of
+            Nothing -> (Just m, Nothing)
+            Just (One a _) -> (Just $ Map.delete key m, Just a)
+            Just (Cons a _ _ rest) -> (Just $ Map.insert key rest m, Just a)
+
+putSocket :: Manager -> ConnKey -> ConnInfo -> IO ()
+putSocket man key ci = do
+    now <- getCurrentTime
+    msock <- I.atomicModifyIORef (mConns man) (go now)
+    maybe (return ()) connClose msock
+  where
+    go _ Nothing = (Nothing, Just ci)
+    go now (Just m) =
+        case Map.lookup key m of
+            Nothing -> (Just $ Map.insert key (One ci now) m, Nothing)
+            Just l ->
+                let (l', mx) = addToList now (mMaxConns man) ci l
+                 in (Just $ Map.insert key l' m, mx)
+
+-- | Add a new element to the list, up to the given maximum number. If we're
+-- already at the maximum, return the new value as leftover.
+addToList :: UTCTime -> Int -> a -> NonEmptyList a -> (NonEmptyList a, Maybe a)
+addToList _ i x l | i <= 1 = (l, Just x)
+addToList now _ x l@One{} = (Cons x 2 now l, Nothing)
+addToList now maxCount x l@(Cons _ currCount _ _)
+    | maxCount > currCount = (Cons x (currCount + 1) now l, Nothing)
+    | otherwise = (l, Just x)
+
+-- | Create a new 'Manager' with no open connections and a maximum of 10 open connections..
+newManager :: ResourceIO m => ResourceT m Manager
+newManager = newManagerCount 10
+
+-- | Create a new 'Manager' with the specified max connection count.
+newManagerCount :: ResourceIO m => Int -> ResourceT m Manager
+newManagerCount count = snd <$> withIO (newManagerIO count) closeManager
+
+-- | Create a 'Manager' which will never be destroyed.
+newManagerIO :: Int -> IO Manager
+newManagerIO count = do
+    mapRef <- I.newIORef (Just Map.empty)
+    _ <- forkIO $ reap mapRef
+    return $ Manager mapRef count
+
+-- | Collect and destroy any stale connections.
+reap :: I.IORef (Maybe (Map.Map ConnKey (NonEmptyList ConnInfo))) -> IO ()
+reap mapRef =
+    mask_ loop
+  where
+    loop = do
+        threadDelay (5 * 1000 * 1000)
+        now <- getCurrentTime
+        let isNotStale time = 30 `addUTCTime` time >= now
+        mtoDestroy <- I.atomicModifyIORef mapRef (findStaleWrap isNotStale)
+        case mtoDestroy of
+            Nothing -> return () -- manager is closed
+            Just toDestroy -> do
+                mapM_ safeConnClose toDestroy
+                loop
+    findStaleWrap _ Nothing = (Nothing, Nothing)
+    findStaleWrap isNotStale (Just m) =
+        let (x, y) = findStale isNotStale m
+         in (Just x, Just y)
+    findStale isNotStale =
+        findStale' id id . Map.toList
+      where
+        findStale' destroy keep [] = (Map.fromList $ keep [], destroy [])
+        findStale' destroy keep ((connkey, nelist):rest) =
+            findStale' destroy' keep' rest
+          where
+            -- Note: By definition, the timestamps must be in descending order,
+            -- so we don't need to traverse the whole list.
+            (notStale, stale) = span (isNotStale . fst) $ neToList nelist
+            destroy' = destroy . (map snd stale++)
+            keep' =
+                case neFromList notStale of
+                    Nothing -> keep
+                    Just x -> keep . ((connkey, x):)
+
+neToList :: NonEmptyList a -> [(UTCTime, a)]
+neToList (One a t) = [(t, a)]
+neToList (Cons a _ t nelist) = (t, a) : neToList nelist
+
+neFromList :: [(UTCTime, a)] -> Maybe (NonEmptyList a)
+neFromList [] = Nothing
+neFromList [(t, a)] = Just (One a t)
+neFromList xs =
+    Just . snd . go $ xs
+  where
+    go [] = error "neFromList.go []"
+    go [(t, a)] = (2, One a t)
+    go ((t, a):rest) =
+        let (i, rest') = go rest
+            i' = i + 1
+         in i' `seq` (i', Cons a i t rest')
+
+withManager :: ResourceIO m => (Manager -> ResourceT m a) -> m a
+withManager f = runResourceT $ newManager >>= f
+
+-- | Close all connections in a 'Manager'. Afterwards, the
+-- 'Manager' can be reused if desired.
+closeManager :: Manager -> IO ()
+closeManager manager = mask_ $ do
+    m <- I.atomicModifyIORef (mConns manager) $ \x -> (Nothing, x)
+    mapM_ (nonEmptyMapM_ safeConnClose) $ maybe [] Map.elems m
+
+safeConnClose :: ConnInfo -> IO ()
+safeConnClose ci = connClose ci `catch` \(_::SomeException) -> return ()
+
+nonEmptyMapM_ :: Monad m => (a -> m ()) -> NonEmptyList a -> m ()
+nonEmptyMapM_ f (One x _) = f x
+nonEmptyMapM_ f (Cons x _ _ l) = f x >> nonEmptyMapM_ f l
+
+getSocketConn
+    :: ResourceIO m
+    => Manager
+    -> String
+    -> Int
+    -> 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"
+
+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
+            -> 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"
+
+getSslProxyConn
+            :: ResourceIO m
+            => ([X509] -> IO TLSCertificateUsage)
+            -> S8.ByteString -- ^ Target host
+            -> Int -- ^ Target port
+            -> Manager
+            -> String -- ^ Proxy host
+            -> Int -- ^ Proxy port
+            -> 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
+        hFlush h
+        r <- hGetSome h 2048
+        res <- parserHeadersFromByteString r
+        case res of
+            Right ((_, 200, _), _) -> return h
+            Right ((_, _, msg), _) -> hClose h >> proxyError (S8.unpack msg)
+            Left s -> hClose h >> proxyError s
+
+    connectRequest =
+        Blaze.fromByteString "CONNECT "
+            `mappend` Blaze.fromByteString thost
+            `mappend` Blaze.fromByteString (S8.pack (':' : show tport))
+            `mappend` Blaze.fromByteString " HTTP/1.1\r\n\r\n"
+    proxyError s =
+        error $ "Proxy failed to CONNECT to '"
+                ++ S8.unpack thost ++ ":" ++ show tport ++ "' : " ++ s
+
+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
+    -> 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, Fresh)
+            -- Return the existing one
+            Just ci -> return (ci, Reused)
+
+    -- 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
+
+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
+    (useProxy, connhost, connport) =
+        case proxy req of
+            Just p -> (True, S8.unpack (proxyHost p), proxyPort p)
+            Nothing -> (False, S8.unpack h, port req)
+    go =
+        case (secure req, useProxy) of
+            (False, _) -> getSocketConn
+            (True, False) -> getSslConn $ checkCerts req h
+            (True, True) -> getSslProxyConn (checkCerts req h) h (port req)

@@ -1,122 +1,122 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts #-}-module Network.HTTP.Conduit.Parser-    ( sinkHeaders-    , newline-    , parserHeadersFromByteString-    , parseChunkHeader-    ) where--import Prelude hiding (take, takeWhile)-import Control.Applicative-import Data.Word (Word8)--import qualified Data.ByteString as S-import qualified Data.ByteString.Char8 as S8--import Data.Attoparsec--import Data.Conduit.Attoparsec (sinkParser)-import Data.Conduit (Sink, ResourceIO)-import Control.Monad (when)---type Header = (S.ByteString, S.ByteString)--parseHeader :: Parser Header-parseHeader = do-    k <- takeWhile1 notNewlineColon-    _ <- word8 58 -- colon-    skipWhile isSpace-    v <- takeWhile notNewline-    newline-    return (k, v)--notNewlineColon, isSpace, notNewline :: Word8 -> Bool--notNewlineColon 10 = False -- LF-notNewlineColon 13 = False -- CR-notNewlineColon 58 = False -- colon-notNewlineColon _  = True--isSpace 32 = True-isSpace _  = False--notNewline 10 = False-notNewline 13 = False-notNewline _  = True--newline :: Parser ()-newline =-    lf <|> (cr >> lf)-  where-    word8' x = word8 x >> return ()-    lf = word8' 10-    cr = word8' 13--parseHeaders :: Parser (Status, [Header])-parseHeaders = do-    s <- parseStatus <?> "HTTP status line"-    h <- manyTill parseHeader newline <?> "Response headers"-    return (s, h)--sinkHeaders :: ResourceIO m => Sink S.ByteString m (Status, [Header])-sinkHeaders = sinkParser parseHeaders---parserHeadersFromByteString :: Monad m => S.ByteString -> m (Either String (Status, [Header]))-parserHeadersFromByteString s = return $ parseOnly parseHeaders s---type Status = (S.ByteString, Int, S.ByteString)--parseStatus :: Parser Status-parseStatus = do-    end <- atEnd-    when end $ fail "EOF reached"-    _ <- manyTill (take 1 >> return ()) (try $ string "HTTP/") <?> "HTTP/"-    ver <- takeWhile1 $ not . isSpace-    _ <- word8 32 -- space-    statCode <- takeWhile1 $ not . isSpace-    statCode' <--        case reads $ S8.unpack statCode of-            [] -> fail $ "Invalid status code: " ++ S8.unpack statCode-            (x, _):_ -> return x-    _ <- word8 32-    statMsg <- takeWhile1 $ notNewline-    newline-    if (statCode == "100")-        then newline >> parseStatus-        else return (ver, statCode', statMsg)--parseChunkHeader :: Parser Int-parseChunkHeader = do-    len <- hexs-    skipWhile isSpace-    newline <|> attribs-    return len--attribs :: Parser ()-attribs = do-    _ <- word8 59 -- colon-    skipWhile notNewline-    newline--hexs :: Parser Int-hexs = do-    ws <- many1 hex-    return $ foldl1 (\a b -> a * 16 + b) $ map fromIntegral ws--hex :: Parser Word8-hex =-    (digit <|> upper <|> lower) <?> "Hexadecimal digit"-  where-    digit = do-        d <- satisfy $ \w -> (w >= 48 && w <= 57)-        return $ d - 48-    upper = do-        d <- satisfy $ \w -> (w >= 65 && w <= 70)-        return $ d - 55-    lower = do-        d <- satisfy $ \w -> (w >= 97 && w <= 102)-        return $ d - 87+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Network.HTTP.Conduit.Parser
+    ( sinkHeaders
+    , newline
+    , parserHeadersFromByteString
+    , parseChunkHeader
+    ) where
+
+import Prelude hiding (take, takeWhile)
+import Control.Applicative
+import Data.Word (Word8)
+
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Char8 as S8
+
+import Data.Attoparsec
+
+import Data.Conduit.Attoparsec (sinkParser)
+import Data.Conduit (Sink, ResourceIO)
+import Control.Monad (when)
+
+
+type Header = (S.ByteString, S.ByteString)
+
+parseHeader :: Parser Header
+parseHeader = do
+    k <- takeWhile1 notNewlineColon
+    _ <- word8 58 -- colon
+    skipWhile isSpace
+    v <- takeWhile notNewline
+    newline
+    return (k, v)
+
+notNewlineColon, isSpace, notNewline :: Word8 -> Bool
+
+notNewlineColon 10 = False -- LF
+notNewlineColon 13 = False -- CR
+notNewlineColon 58 = False -- colon
+notNewlineColon _  = True
+
+isSpace 32 = True
+isSpace _  = False
+
+notNewline 10 = False
+notNewline 13 = False
+notNewline _  = True
+
+newline :: Parser ()
+newline =
+    lf <|> (cr >> lf)
+  where
+    word8' x = word8 x >> return ()
+    lf = word8' 10
+    cr = word8' 13
+
+parseHeaders :: Parser (Status, [Header])
+parseHeaders = do
+    s <- parseStatus <?> "HTTP status line"
+    h <- manyTill parseHeader newline <?> "Response headers"
+    return (s, h)
+
+sinkHeaders :: ResourceIO m => Sink S.ByteString m (Status, [Header])
+sinkHeaders = sinkParser parseHeaders
+
+
+parserHeadersFromByteString :: Monad m => S.ByteString -> m (Either String (Status, [Header]))
+parserHeadersFromByteString s = return $ parseOnly parseHeaders s
+
+
+type Status = (S.ByteString, Int, S.ByteString)
+
+parseStatus :: Parser Status
+parseStatus = do
+    end <- atEnd
+    when end $ fail "EOF reached"
+    _ <- manyTill (take 1 >> return ()) (try $ string "HTTP/") <?> "HTTP/"
+    ver <- takeWhile1 $ not . isSpace
+    _ <- word8 32 -- space
+    statCode <- takeWhile1 $ not . isSpace
+    statCode' <-
+        case reads $ S8.unpack statCode of
+            [] -> fail $ "Invalid status code: " ++ S8.unpack statCode
+            (x, _):_ -> return x
+    _ <- word8 32
+    statMsg <- takeWhile1 $ notNewline
+    newline
+    if (statCode == "100")
+        then newline >> parseStatus
+        else return (ver, statCode', statMsg)
+
+parseChunkHeader :: Parser Int
+parseChunkHeader = do
+    len <- hexs
+    skipWhile isSpace
+    newline <|> attribs
+    return len
+
+attribs :: Parser ()
+attribs = do
+    _ <- word8 59 -- colon
+    skipWhile notNewline
+    newline
+
+hexs :: Parser Int
+hexs = do
+    ws <- many1 hex
+    return $ foldl1 (\a b -> a * 16 + b) $ map fromIntegral ws
+
+hex :: Parser Word8
+hex =
+    (digit <|> upper <|> lower) <?> "Hexadecimal digit"
+  where
+    digit = do
+        d <- satisfy $ \w -> (w >= 48 && w <= 57)
+        return $ d - 48
+    upper = do
+        d <- satisfy $ \w -> (w >= 65 && w <= 70)
+        return $ d - 55
+    lower = do
+        d <- satisfy $ \w -> (w >= 97 && w <= 102)
+        return $ d - 87

@@ -1,344 +1,344 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-module Network.HTTP.Conduit.Request-    ( Request (..)-    , RequestBody (..)-    , ContentType-    , Proxy (..)-    , parseUrl-    , browserDecompress-    , HttpException (..)-    , defaultCheckCerts-    , alwaysDecompress-    , addProxy-    , applyBasicAuth-    , urlEncodedBody-    , needsGunzip-    , requestBuilder-    ) where--import Data.Int (Int64)-import Data.Maybe (fromMaybe)-import Data.Monoid (mempty, mappend)-import Data.Typeable (Typeable)--import Data.Default (Default (def))--import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString)-import Blaze.ByteString.Builder.Char8 (fromChar)-import qualified Blaze.ByteString.Builder as Blaze--import qualified Data.Conduit as C-import qualified Data.Conduit.List as CL--import qualified Data.ByteString as S-import qualified Data.ByteString.Char8 as S8-import qualified Data.ByteString.Lazy as L--import qualified Network.HTTP.Types as W-import Data.Certificate.X509 (X509)--import Network.TLS (TLSCertificateUsage (CertificateUsageAccept))-import Network.TLS.Extra (certificateVerifyChain, certificateVerifyDomain)--import Control.Exception (Exception, SomeException, toException)-import Control.Failure (Failure (failure))-import Codec.Binary.UTF8.String (encodeString)-import qualified Data.CaseInsensitive as CI-import qualified Data.ByteString.Base64 as B64--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--- HTTP request.------ If you simply wish to download from a URL, see 'parseUrl'.------ The constructor for this data type is not exposed. Instead, you should use--- either the 'def' method to retrieve a default instance, or 'parseUrl' to--- construct from a URL, and then use the records below to make modifications.--- This approach allows http-conduit to add configuration options without--- breaking backwards compatibility.-data Request m = Request-    { method :: W.Method-    -- ^ HTTP request method, eg GET, POST.-    , secure :: Bool-    -- ^ Whether to use HTTPS (ie, SSL).-    , checkCerts :: W.Ascii -> [X509] -> IO TLSCertificateUsage-    -- ^ Check if the server certificate is valid. Only relevant for HTTPS.-    , host :: W.Ascii-    , port :: Int-    , path :: W.Ascii-    -- ^ Everything from the host to the query string.-    , queryString :: W.Ascii-    , requestHeaders :: W.RequestHeaders-    , requestBody :: RequestBody m-    , proxy :: Maybe Proxy-    -- ^ Optional HTTP proxy.-    , rawBody :: Bool-    -- ^ If @True@, a chunked and\/or gzipped body will not be-    -- decoded. Use with caution.-    , decompress :: ContentType -> Bool-    -- ^ Predicate to specify whether gzipped data should be-    -- decompressed on the fly (see 'alwaysDecompress' and-    -- '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--- 'RequestBodySource'\/'RequestBodySourceChunked' constructors--- and any function which calls 'redirectIter', you must ensure--- that the 'Source' can be called multiple times.  Usually this--- is not a problem.------ The 'RequestBodySourceChunked' will send a chunked request--- body, note that not all servers support this. Only use--- 'RequestBodySourceChunked' if you know the server you're--- sending to supports chunked request bodies.-data RequestBody m-    = RequestBodyLBS L.ByteString-    | RequestBodyBS S.ByteString-    | RequestBodyBuilder Int64 Blaze.Builder-    | RequestBodySource Int64 (C.Source m Blaze.Builder)-    | RequestBodySourceChunked (C.Source m Blaze.Builder)---- | Define a HTTP proxy, consisting of a hostname and port number.--data Proxy = Proxy-    { proxyHost :: W.Ascii -- ^ The host name of the HTTP proxy.-    , proxyPort :: Int -- ^ The port number of the HTTP proxy.-    }--encodeUrlCharPI :: Char -> String-encodeUrlCharPI '/' = "/"-encodeUrlCharPI c = encodeUrlChar c--encodeUrlChar :: Char -> String-encodeUrlChar c-    -- List of unreserved characters per RFC 3986-    -- Gleaned from http://en.wikipedia.org/wiki/Percent-encoding-    | 'A' <= c && c <= 'Z' = [c]-    | 'a' <= c && c <= 'z' = [c]-    | '0' <= c && c <= '9' = [c]-encodeUrlChar c@'-' = [c]-encodeUrlChar c@'_' = [c]-encodeUrlChar c@'.' = [c]-encodeUrlChar c@'~' = [c]-encodeUrlChar y =-    let (a, c) = fromEnum y `divMod` 16-        b = a `mod` 16-        showHex' x-            | x < 10 = toEnum $ x + (fromEnum '0')-            | x < 16 = toEnum $ x - 10 + (fromEnum 'A')-            | otherwise = error $ "Invalid argument to showHex: " ++ show x-     in ['%', showHex' b, showHex' c]---- | Convert a URL into a 'Request'.------ This defaults some of the values in 'Request', such as setting 'method' to--- GET and 'requestHeaders' to @[]@.------ Since this function uses 'Failure', the return monad can be anything that is--- an instance of 'Failure', such as 'IO' or 'Maybe'.-parseUrl :: Failure HttpException m => String -> m (Request m')-parseUrl s@('h':'t':'t':'p':':':'/':'/':rest) = parseUrl1 s False rest-parseUrl s@('h':'t':'t':'p':'s':':':'/':'/':rest) = parseUrl1 s True rest-parseUrl x = failure $ InvalidUrlException x "Invalid scheme"--parseUrl1 :: Failure HttpException m-          => String -> Bool -> String -> m (Request m')-parseUrl1 full sec s =-    parseUrl2 full sec s'-  where-    s' = encodeString s--defaultCheckCerts :: W.Ascii -> [X509] -> IO TLSCertificateUsage-defaultCheckCerts host' certs =-    case certificateVerifyDomain (S8.unpack host') certs of-        CertificateUsageAccept -> certificateVerifyChain certs-        _                          -> return CertificateUsageAccept--instance Default (Request m) where-    def = Request-        { host = "localhost"-        , port = 80-        , secure = False-        , checkCerts = defaultCheckCerts-        , requestHeaders = []-        , path = "/"-        , queryString = S8.empty-        , requestBody = RequestBodyLBS L.empty-        , method = "GET"-        , proxy = Nothing-        , rawBody = False-        , 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-          => String -> Bool -> String -> m (Request m')-parseUrl2 full sec s = do-    port' <- mport-    return def-        { host = S8.pack hostname-        , port = port'-        , secure = sec-        , path = S8.pack-                    $ if null path''-                            then "/"-                            else concatMap encodeUrlCharPI path''-        , queryString = S8.pack qstring-        }-  where-    (beforeSlash, afterSlash) = break (== '/') s-    (hostname, portStr) = break (== ':') beforeSlash-    (path', qstring') = break (== '?') afterSlash-    path'' = path'-    qstring'' = case qstring' of-                '?':x -> x-                _ -> qstring'-    qstring = takeWhile (/= '#') qstring''-    mport =-        case (portStr, sec) of-            ("", False) -> return 80-            ("", True) -> return 443-            (':':rest, _) -> maybe-                (failure $ InvalidUrlException full "Invalid port")-                return-                (readDec rest)-            x -> error $ "parseUrl1: this should never happen: " ++ show x--data HttpException = StatusCodeException W.Status W.ResponseHeaders-                   | InvalidUrlException String String-                   | TooManyRedirects-                   | HttpParserException String-    deriving (Show, Typeable)-instance Exception HttpException---- | Always decompress a compressed stream.-alwaysDecompress :: ContentType -> Bool-alwaysDecompress = const True---- | Decompress a compressed stream unless the content-type is 'application/x-tar'.-browserDecompress :: ContentType -> Bool-browserDecompress = (/= "application/x-tar")---- | Add a Basic Auth header (with the specified user name and password) to the--- given Request. Ignore error handling:------    applyBasicAuth "user" "pass" $ fromJust $ parseUrl url--applyBasicAuth :: S.ByteString -> S.ByteString -> Request m -> Request m-applyBasicAuth user passwd req =-    req { requestHeaders = authHeader : requestHeaders req }-  where-    authHeader = (CI.mk "Authorization", basic)-    basic = S8.append "Basic " (B64.encode $ S8.concat [ user, ":", passwd ])----- | Add a proxy to the the Request so that the Request when executed will use--- the provided proxy.-addProxy :: S.ByteString -> Int -> Request m -> Request m-addProxy hst prt req =-    req { proxy = Just $ Proxy hst prt }---- FIXME add a helper for generating POST bodies---- | Add url-encoded paramters to the 'Request'.------ This sets a new 'requestBody', adds a content-type request header and--- changes the 'method' to POST.-urlEncodedBody :: Monad m => [(S.ByteString, S.ByteString)] -> Request m' -> Request m-urlEncodedBody headers req = req-    { requestBody = RequestBodyLBS body-    , method = "POST"-    , requestHeaders =-        (ct, "application/x-www-form-urlencoded")-      : filter (\(x, _) -> x /= ct) (requestHeaders req)-    }-  where-    ct = "Content-Type"-    body = L.fromChunks . return $ W.renderSimpleQuery False headers--needsGunzip :: Request m-            -> [W.Header] -- ^ response headers-            -> Bool-needsGunzip req hs' =-        not (rawBody req)-     && ("content-encoding", "gzip") `elem` hs'-     && decompress req (fromMaybe "" $ lookup "content-type" hs')--requestBuilder-    :: C.Resource m-    => Request m-    -> C.Source m Builder-requestBuilder req =-    CL.sourceList [builder] `mappend` bodySource-  where-    sourceSingle = CL.sourceList . return--    (contentLength, bodySource) =-        case requestBody req of-            RequestBodyLBS lbs -> (Just $ L.length lbs, sourceSingle $ fromLazyByteString lbs)-            RequestBodyBS bs -> (Just $ fromIntegral $ S.length bs, sourceSingle $ fromByteString bs)-            RequestBodyBuilder i b -> (Just $ i, sourceSingle b)-            RequestBodySource i source -> (Just i, source)-            RequestBodySourceChunked source -> (Nothing, source C.$= chunkIt)--    hh-        | port req == 80 && not (secure req) = host req-        | port req == 443 && secure req = host req-        | otherwise = host req <> S8.pack (':' : show (port req))--    contentLengthHeader (Just contentLength') =-            if method req `elem` ["GET", "HEAD"] && contentLength' == 0-                then id-                else (:) ("Content-Length", S8.pack $ show contentLength')-    contentLengthHeader Nothing = (:) ("Transfer-Encoding", "chunked")--    headerPairs :: W.RequestHeaders-    headerPairs-        = ("Host", hh)-        : ("Accept-Encoding", "gzip")-        : (contentLengthHeader contentLength)-          (requestHeaders req)--    builder :: Builder-    builder =-            fromByteString (method req)-            <> fromByteString " "-            <> (case proxy req of-                    Just{} ->-                        fromByteString (if secure req then "https://" else "http://")-                        <> fromByteString hh-                    Nothing -> mempty)-            <> (case S8.uncons $ path req of-                    Just ('/', _) -> fromByteString $ path req-                    _ -> fromByteString "/" <> fromByteString (path req))-            <> (if S8.null (queryString req)-                        then mempty-                        else fromChar '?' <> fromByteString (queryString req))-            <> fromByteString " HTTP/1.1\r\n"-            <> foldr-                (\a b -> headerPairToBuilder a <> b)-                (fromByteString "\r\n")-                headerPairs--    headerPairToBuilder (k, v) =-           fromByteString (CI.original k)-        <> fromByteString ": "-        <> fromByteString v-        <> fromByteString "\r\n"+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Network.HTTP.Conduit.Request
+    ( Request (..)
+    , RequestBody (..)
+    , ContentType
+    , Proxy (..)
+    , parseUrl
+    , browserDecompress
+    , HttpException (..)
+    , defaultCheckCerts
+    , alwaysDecompress
+    , addProxy
+    , applyBasicAuth
+    , urlEncodedBody
+    , needsGunzip
+    , requestBuilder
+    ) where
+
+import Data.Int (Int64)
+import Data.Maybe (fromMaybe)
+import Data.Monoid (mempty, mappend)
+import Data.Typeable (Typeable)
+
+import Data.Default (Default (def))
+
+import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString)
+import Blaze.ByteString.Builder.Char8 (fromChar)
+import qualified Blaze.ByteString.Builder as Blaze
+
+import qualified Data.Conduit as C
+import qualified Data.Conduit.List as CL
+
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Char8 as S8
+import qualified Data.ByteString.Lazy as L
+
+import qualified Network.HTTP.Types as W
+import Data.Certificate.X509 (X509)
+
+import Network.TLS (TLSCertificateUsage (CertificateUsageAccept))
+import Network.TLS.Extra (certificateVerifyChain, certificateVerifyDomain)
+
+import Control.Exception (Exception, SomeException, toException)
+import Control.Failure (Failure (failure))
+import Codec.Binary.UTF8.String (encodeString)
+import qualified Data.CaseInsensitive as CI
+import qualified Data.ByteString.Base64 as B64
+
+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
+-- HTTP request.
+--
+-- If you simply wish to download from a URL, see 'parseUrl'.
+--
+-- The constructor for this data type is not exposed. Instead, you should use
+-- either the 'def' method to retrieve a default instance, or 'parseUrl' to
+-- construct from a URL, and then use the records below to make modifications.
+-- This approach allows http-conduit to add configuration options without
+-- breaking backwards compatibility.
+data Request m = Request
+    { method :: W.Method
+    -- ^ HTTP request method, eg GET, POST.
+    , secure :: Bool
+    -- ^ Whether to use HTTPS (ie, SSL).
+    , checkCerts :: W.Ascii -> [X509] -> IO TLSCertificateUsage
+    -- ^ Check if the server certificate is valid. Only relevant for HTTPS.
+    , host :: W.Ascii
+    , port :: Int
+    , path :: W.Ascii
+    -- ^ Everything from the host to the query string.
+    , queryString :: W.Ascii
+    , requestHeaders :: W.RequestHeaders
+    , requestBody :: RequestBody m
+    , proxy :: Maybe Proxy
+    -- ^ Optional HTTP proxy.
+    , rawBody :: Bool
+    -- ^ If @True@, a chunked and\/or gzipped body will not be
+    -- decoded. Use with caution.
+    , decompress :: ContentType -> Bool
+    -- ^ Predicate to specify whether gzipped data should be
+    -- decompressed on the fly (see 'alwaysDecompress' and
+    -- '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
+-- 'RequestBodySource'\/'RequestBodySourceChunked' constructors
+-- and any function which calls 'redirectIter', you must ensure
+-- that the 'Source' can be called multiple times.  Usually this
+-- is not a problem.
+--
+-- The 'RequestBodySourceChunked' will send a chunked request
+-- body, note that not all servers support this. Only use
+-- 'RequestBodySourceChunked' if you know the server you're
+-- sending to supports chunked request bodies.
+data RequestBody m
+    = RequestBodyLBS L.ByteString
+    | RequestBodyBS S.ByteString
+    | RequestBodyBuilder Int64 Blaze.Builder
+    | RequestBodySource Int64 (C.Source m Blaze.Builder)
+    | RequestBodySourceChunked (C.Source m Blaze.Builder)
+
+-- | Define a HTTP proxy, consisting of a hostname and port number.
+
+data Proxy = Proxy
+    { proxyHost :: W.Ascii -- ^ The host name of the HTTP proxy.
+    , proxyPort :: Int -- ^ The port number of the HTTP proxy.
+    }
+
+encodeUrlCharPI :: Char -> String
+encodeUrlCharPI '/' = "/"
+encodeUrlCharPI c = encodeUrlChar c
+
+encodeUrlChar :: Char -> String
+encodeUrlChar c
+    -- List of unreserved characters per RFC 3986
+    -- Gleaned from http://en.wikipedia.org/wiki/Percent-encoding
+    | 'A' <= c && c <= 'Z' = [c]
+    | 'a' <= c && c <= 'z' = [c]
+    | '0' <= c && c <= '9' = [c]
+encodeUrlChar c@'-' = [c]
+encodeUrlChar c@'_' = [c]
+encodeUrlChar c@'.' = [c]
+encodeUrlChar c@'~' = [c]
+encodeUrlChar y =
+    let (a, c) = fromEnum y `divMod` 16
+        b = a `mod` 16
+        showHex' x
+            | x < 10 = toEnum $ x + (fromEnum '0')
+            | x < 16 = toEnum $ x - 10 + (fromEnum 'A')
+            | otherwise = error $ "Invalid argument to showHex: " ++ show x
+     in ['%', showHex' b, showHex' c]
+
+-- | Convert a URL into a 'Request'.
+--
+-- This defaults some of the values in 'Request', such as setting 'method' to
+-- GET and 'requestHeaders' to @[]@.
+--
+-- Since this function uses 'Failure', the return monad can be anything that is
+-- an instance of 'Failure', such as 'IO' or 'Maybe'.
+parseUrl :: Failure HttpException m => String -> m (Request m')
+parseUrl s@('h':'t':'t':'p':':':'/':'/':rest) = parseUrl1 s False rest
+parseUrl s@('h':'t':'t':'p':'s':':':'/':'/':rest) = parseUrl1 s True rest
+parseUrl x = failure $ InvalidUrlException x "Invalid scheme"
+
+parseUrl1 :: Failure HttpException m
+          => String -> Bool -> String -> m (Request m')
+parseUrl1 full sec s =
+    parseUrl2 full sec s'
+  where
+    s' = encodeString s
+
+defaultCheckCerts :: W.Ascii -> [X509] -> IO TLSCertificateUsage
+defaultCheckCerts host' certs =
+    case certificateVerifyDomain (S8.unpack host') certs of
+        CertificateUsageAccept -> certificateVerifyChain certs
+        _                          -> return CertificateUsageAccept
+
+instance Default (Request m) where
+    def = Request
+        { host = "localhost"
+        , port = 80
+        , secure = False
+        , checkCerts = defaultCheckCerts
+        , requestHeaders = []
+        , path = "/"
+        , queryString = S8.empty
+        , requestBody = RequestBodyLBS L.empty
+        , method = "GET"
+        , proxy = Nothing
+        , rawBody = False
+        , 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
+          => String -> Bool -> String -> m (Request m')
+parseUrl2 full sec s = do
+    port' <- mport
+    return def
+        { host = S8.pack hostname
+        , port = port'
+        , secure = sec
+        , path = S8.pack
+                    $ if null path''
+                            then "/"
+                            else concatMap encodeUrlCharPI path''
+        , queryString = S8.pack qstring
+        }
+  where
+    (beforeSlash, afterSlash) = break (== '/') s
+    (hostname, portStr) = break (== ':') beforeSlash
+    (path', qstring') = break (== '?') afterSlash
+    path'' = path'
+    qstring'' = case qstring' of
+                '?':x -> x
+                _ -> qstring'
+    qstring = takeWhile (/= '#') qstring''
+    mport =
+        case (portStr, sec) of
+            ("", False) -> return 80
+            ("", True) -> return 443
+            (':':rest, _) -> maybe
+                (failure $ InvalidUrlException full "Invalid port")
+                return
+                (readDec rest)
+            x -> error $ "parseUrl1: this should never happen: " ++ show x
+
+data HttpException = StatusCodeException W.Status W.ResponseHeaders
+                   | InvalidUrlException String String
+                   | TooManyRedirects
+                   | HttpParserException String
+    deriving (Show, Typeable)
+instance Exception HttpException
+
+-- | Always decompress a compressed stream.
+alwaysDecompress :: ContentType -> Bool
+alwaysDecompress = const True
+
+-- | Decompress a compressed stream unless the content-type is 'application/x-tar'.
+browserDecompress :: ContentType -> Bool
+browserDecompress = (/= "application/x-tar")
+
+-- | Add a Basic Auth header (with the specified user name and password) to the
+-- given Request. Ignore error handling:
+--
+--    applyBasicAuth "user" "pass" $ fromJust $ parseUrl url
+
+applyBasicAuth :: S.ByteString -> S.ByteString -> Request m -> Request m
+applyBasicAuth user passwd req =
+    req { requestHeaders = authHeader : requestHeaders req }
+  where
+    authHeader = (CI.mk "Authorization", basic)
+    basic = S8.append "Basic " (B64.encode $ S8.concat [ user, ":", passwd ])
+
+
+-- | Add a proxy to the the Request so that the Request when executed will use
+-- the provided proxy.
+addProxy :: S.ByteString -> Int -> Request m -> Request m
+addProxy hst prt req =
+    req { proxy = Just $ Proxy hst prt }
+
+-- FIXME add a helper for generating POST bodies
+
+-- | Add url-encoded paramters to the 'Request'.
+--
+-- This sets a new 'requestBody', adds a content-type request header and
+-- changes the 'method' to POST.
+urlEncodedBody :: Monad m => [(S.ByteString, S.ByteString)] -> Request m' -> Request m
+urlEncodedBody headers req = req
+    { requestBody = RequestBodyLBS body
+    , method = "POST"
+    , requestHeaders =
+        (ct, "application/x-www-form-urlencoded")
+      : filter (\(x, _) -> x /= ct) (requestHeaders req)
+    }
+  where
+    ct = "Content-Type"
+    body = L.fromChunks . return $ W.renderSimpleQuery False headers
+
+needsGunzip :: Request m
+            -> [W.Header] -- ^ response headers
+            -> Bool
+needsGunzip req hs' =
+        not (rawBody req)
+     && ("content-encoding", "gzip") `elem` hs'
+     && decompress req (fromMaybe "" $ lookup "content-type" hs')
+
+requestBuilder
+    :: C.Resource m
+    => Request m
+    -> C.Source m Builder
+requestBuilder req =
+    CL.sourceList [builder] `mappend` bodySource
+  where
+    sourceSingle = CL.sourceList . return
+
+    (contentLength, bodySource) =
+        case requestBody req of
+            RequestBodyLBS lbs -> (Just $ L.length lbs, sourceSingle $ fromLazyByteString lbs)
+            RequestBodyBS bs -> (Just $ fromIntegral $ S.length bs, sourceSingle $ fromByteString bs)
+            RequestBodyBuilder i b -> (Just $ i, sourceSingle b)
+            RequestBodySource i source -> (Just i, source)
+            RequestBodySourceChunked source -> (Nothing, source C.$= chunkIt)
+
+    hh
+        | port req == 80 && not (secure req) = host req
+        | port req == 443 && secure req = host req
+        | otherwise = host req <> S8.pack (':' : show (port req))
+
+    contentLengthHeader (Just contentLength') =
+            if method req `elem` ["GET", "HEAD"] && contentLength' == 0
+                then id
+                else (:) ("Content-Length", S8.pack $ show contentLength')
+    contentLengthHeader Nothing = (:) ("Transfer-Encoding", "chunked")
+
+    headerPairs :: W.RequestHeaders
+    headerPairs
+        = ("Host", hh)
+        : ("Accept-Encoding", "gzip")
+        : (contentLengthHeader contentLength)
+          (requestHeaders req)
+
+    builder :: Builder
+    builder =
+            fromByteString (method req)
+            <> fromByteString " "
+            <> (case proxy req of
+                    Just{} ->
+                        fromByteString (if secure req then "https://" else "http://")
+                        <> fromByteString hh
+                    Nothing -> mempty)
+            <> (case S8.uncons $ path req of
+                    Just ('/', _) -> fromByteString $ path req
+                    _ -> fromByteString "/" <> fromByteString (path req))
+            <> (if S8.null (queryString req)
+                        then mempty
+                        else fromChar '?' <> fromByteString (queryString req))
+            <> fromByteString " HTTP/1.1\r\n"
+            <> foldr
+                (\a b -> headerPairToBuilder a <> b)
+                (fromByteString "\r\n")
+                headerPairs
+
+    headerPairToBuilder (k, v) =
+           fromByteString (CI.original k)
+        <> fromByteString ": "
+        <> fromByteString v
+        <> fromByteString "\r\n"

@@ -1,104 +1,104 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-module Network.HTTP.Conduit.Response-    ( Response (..)-    , getResponse-    , lbsResponse-    ) where--import Control.Arrow (first)-import Data.Typeable (Typeable)--import qualified Data.ByteString.Char8 as S8-import qualified Data.ByteString.Lazy as L--import qualified Data.CaseInsensitive as CI--import Control.Monad.Trans.Resource (ResourceT, ResourceIO)-import qualified Data.Conduit as C-import qualified Data.Conduit.Zlib as CZ-import qualified Data.Conduit.Binary as CB-import qualified Data.Conduit.List as CL--import qualified Network.HTTP.Types as W--import Network.HTTP.Conduit.Manager-import Network.HTTP.Conduit.Request-import Network.HTTP.Conduit.Util-import Network.HTTP.Conduit.Parser-import Network.HTTP.Conduit.Chunk---- | A simple representation of the HTTP response created by 'lbsConsumer'.-data Response body = Response-    { statusCode :: W.Status-    , responseHeaders :: W.ResponseHeaders-    , responseBody :: body-    }-    deriving (Show, Eq, Typeable)---- | 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-            => ConnRelease m-            -> Request m-            -> C.BufferedSource m S8.ByteString-            -> 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-    body <- if hasNoBody method sc || mcl == Just 0-        then do-            -- FIXME clean up socket-            C.bufferSource $ CL.sourceList []-        else do-            bsrc' <--                if ("transfer-encoding", "chunked") `elem` hs'-                    then C.bufferSource $ bsrc C.$= chunkedConduit rawBody-                    else-                        case mcl of-                            Just len -> C.bufferSource $ bsrc C.$= CB.isolate len-                            Nothing  -> return bsrc-            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'-    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-    }+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Network.HTTP.Conduit.Response
+    ( Response (..)
+    , getResponse
+    , lbsResponse
+    ) where
+
+import Control.Arrow (first)
+import Data.Typeable (Typeable)
+
+import qualified Data.ByteString.Char8 as S8
+import qualified Data.ByteString.Lazy as L
+
+import qualified Data.CaseInsensitive as CI
+
+import Control.Monad.Trans.Resource (ResourceT, ResourceIO)
+import qualified Data.Conduit as C
+import qualified Data.Conduit.Zlib as CZ
+import qualified Data.Conduit.Binary as CB
+import qualified Data.Conduit.List as CL
+
+import qualified Network.HTTP.Types as W
+
+import Network.HTTP.Conduit.Manager
+import Network.HTTP.Conduit.Request
+import Network.HTTP.Conduit.Util
+import Network.HTTP.Conduit.Parser
+import Network.HTTP.Conduit.Chunk
+
+-- | A simple representation of the HTTP response created by 'lbsConsumer'.
+data Response body = Response
+    { statusCode :: W.Status
+    , responseHeaders :: W.ResponseHeaders
+    , responseBody :: body
+    }
+    deriving (Show, Eq, Typeable)
+
+-- | 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
+            => ConnRelease m
+            -> Request m
+            -> C.BufferedSource m S8.ByteString
+            -> 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
+    body <- if hasNoBody method sc || mcl == Just 0
+        then do
+            -- FIXME clean up socket
+            C.bufferSource $ CL.sourceList []
+        else do
+            bsrc' <-
+                if ("transfer-encoding", "chunked") `elem` hs'
+                    then C.bufferSource $ bsrc C.$= chunkedConduit rawBody
+                    else
+                        case mcl of
+                            Just len -> C.bufferSource $ bsrc C.$= CB.isolate len
+                            Nothing  -> return bsrc
+            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'
+    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
+    }

@@ -1,71 +1,71 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts #-}-module Network.HTTP.Conduit.Util-    ( hGetSome-    , (<>)-    , readDec-    , hasNoBody-    ) where--import Data.Monoid (Monoid, mappend)--import qualified Data.ByteString.Char8 as S8--import qualified Data.Text as T-import qualified Data.Text.Read--#if MIN_VERSION_base(4,3,0)-import Data.ByteString (hGetSome)-#else-import GHC.IO.Handle.Types-import System.IO                (hWaitForInput, hIsEOF)-import System.IO.Error          (mkIOError, illegalOperationErrorType)---- | Like 'hGet', except that a shorter 'ByteString' may be returned--- if there are not enough bytes immediately available to satisfy the--- whole request.  'hGetSome' only blocks if there is no data--- available, and EOF has not yet been reached.-hGetSome :: Handle -> Int -> IO S.ByteString-hGetSome hh i-    | i >  0    = let-                   loop = do-                     s <- S.hGetNonBlocking hh i-                     if not (S.null s)-                        then return s-                        else do eof <- hIsEOF hh-                                if eof then return s-                                       else hWaitForInput hh (-1) >> loop-                                         -- for this to work correctly, the-                                         -- Handle should be in binary mode-                                         -- (see GHC ticket #3808)-                  in loop-    | i == 0    = return S.empty-    | otherwise = illegalBufferSize hh "hGetSome" i--illegalBufferSize :: Handle -> String -> Int -> IO a-illegalBufferSize handle fn sz =-    ioError (mkIOError illegalOperationErrorType msg (Just handle) Nothing)-    --TODO: System.IO uses InvalidArgument here, but it's not exported :-(-    where-      msg = fn ++ ": illegal ByteString size " ++ showsPrec 9 sz []-#endif--infixr 5 <>-(<>) :: Monoid m => m -> m -> m-(<>) = mappend--readDec :: Integral i => String -> Maybe i-readDec s =-    case Data.Text.Read.decimal $ T.pack s of-        Right (i, t)-            | T.null t -> Just i-        _ -> Nothing--hasNoBody :: S8.ByteString -- ^ request method-          -> Int -- ^ status code-          -> Bool-hasNoBody "HEAD" _ = True-hasNoBody _ 204 = True-hasNoBody _ 304 = True-hasNoBody _ i = 100 <= i && i < 200+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Network.HTTP.Conduit.Util
+    ( hGetSome
+    , (<>)
+    , readDec
+    , hasNoBody
+    ) where
+
+import Data.Monoid (Monoid, mappend)
+
+import qualified Data.ByteString.Char8 as S8
+
+import qualified Data.Text as T
+import qualified Data.Text.Read
+
+#if MIN_VERSION_base(4,3,0)
+import Data.ByteString (hGetSome)
+#else
+import GHC.IO.Handle.Types
+import System.IO                (hWaitForInput, hIsEOF)
+import System.IO.Error          (mkIOError, illegalOperationErrorType)
+
+-- | Like 'hGet', except that a shorter 'ByteString' may be returned
+-- if there are not enough bytes immediately available to satisfy the
+-- whole request.  'hGetSome' only blocks if there is no data
+-- available, and EOF has not yet been reached.
+hGetSome :: Handle -> Int -> IO S.ByteString
+hGetSome hh i
+    | i >  0    = let
+                   loop = do
+                     s <- S.hGetNonBlocking hh i
+                     if not (S.null s)
+                        then return s
+                        else do eof <- hIsEOF hh
+                                if eof then return s
+                                       else hWaitForInput hh (-1) >> loop
+                                         -- for this to work correctly, the
+                                         -- Handle should be in binary mode
+                                         -- (see GHC ticket #3808)
+                  in loop
+    | i == 0    = return S.empty
+    | otherwise = illegalBufferSize hh "hGetSome" i
+
+illegalBufferSize :: Handle -> String -> Int -> IO a
+illegalBufferSize handle fn sz =
+    ioError (mkIOError illegalOperationErrorType msg (Just handle) Nothing)
+    --TODO: System.IO uses InvalidArgument here, but it's not exported :-(
+    where
+      msg = fn ++ ": illegal ByteString size " ++ showsPrec 9 sz []
+#endif
+
+infixr 5 <>
+(<>) :: Monoid m => m -> m -> m
+(<>) = mappend
+
+readDec :: Integral i => String -> Maybe i
+readDec s =
+    case Data.Text.Read.decimal $ T.pack s of
+        Right (i, t)
+            | T.null t -> Just i
+        _ -> Nothing
+
+hasNoBody :: S8.ByteString -- ^ request method
+          -> Int -- ^ status code
+          -> Bool
+hasNoBody "HEAD" _ = True
+hasNoBody _ 204 = True
+hasNoBody _ 304 = True
+hasNoBody _ i = 100 <= i && i < 200

@@ -1,8 +1,8 @@-#!/usr/bin/env runhaskell--> module Main where-> import Distribution.Simple-> import System.Cmd (system)--> main :: IO ()-> main = defaultMain+#!/usr/bin/env runhaskell
+
+> module Main where
+> import Distribution.Simple
+> import System.Cmd (system)
+
+> main :: IO ()
+> main = defaultMain

@@ -1,62 +1,103 @@-name:            http-conduit-version:         1.1.0.1-license:         BSD3-license-file:    LICENSE-author:          Michael Snoyman <michael@snoyman.com>-maintainer:      Michael Snoyman <michael@snoyman.com>-synopsis:        HTTP client package with conduit interface and HTTPS support.-description:-    This package uses attoparsec for parsing the actual contents of the HTTP connection. It also provides higher-level functions which allow you to avoid direct usage of conduits. See <http://www.yesodweb.com/book/http-conduit> for more information.-category:        Web, Conduit-stability:       Stable-cabal-version:   >= 1.6-build-type:      Simple-homepage:        http://www.yesodweb.com/book/http-conduit--flag network-bytestring-  default: False--library-    build-depends: base                  >= 4       && < 5-                 , bytestring            >= 0.9.1.4 && < 0.10-                 , transformers          >= 0.2     && < 0.3-                 , failure               >= 0.1     && < 0.2-                 , conduit               >= 0.0     && < 0.1-                 , zlib-conduit          >= 0.0     && < 0.1-                 , blaze-builder-conduit >= 0.0     && < 0.1-                 , attoparsec-conduit    >= 0.0     && < 0.1-                 , attoparsec            >= 0.8.0.2 && < 0.11-                 , utf8-string           >= 0.3.4   && < 0.4-                 , blaze-builder         >= 0.2.1   && < 0.4-                 , http-types            >= 0.6     && < 0.7-                 , cprng-aes             >= 0.2     && < 0.3-                 , tls                   >= 0.8.1   && < 0.9-                 , tls-extra             >= 0.4     && < 0.5-                 , monad-control         >= 0.3     && < 0.4-                 , containers            >= 0.2-                 , certificate           >= 0.7     && < 1.1-                 , case-insensitive      >= 0.2-                 , base64-bytestring     >= 0.1     && < 0.2-                 , asn1-data             >= 0.5.1   && < 0.7-                 , data-default          >= 0.3     && < 0.4-                 , text-                 , transformers-base     >= 0.4     && < 0.5-                 , lifted-base           >= 0.1     && < 0.2-    if flag(network-bytestring)-        build-depends: network               >= 2.2.1   && < 2.2.3-                     , network-bytestring    >= 0.1.3   && < 0.1.4-    else-        build-depends: network               >= 2.3     && < 2.4-    exposed-modules: Network.HTTP.Conduit-    other-modules:   Network.HTTP.Conduit.Parser-                     Network.HTTP.Conduit.ConnInfo-                     Network.HTTP.Conduit.Request-                     Network.HTTP.Conduit.Util-                     Network.HTTP.Conduit.Manager-                     Network.HTTP.Conduit.Chunk-                     Network.HTTP.Conduit.Response-    ghc-options:     -Wall--source-repository head-  type:     git-  location: git://github.com/snoyberg/http-conduit.git+name:            http-conduit
+version:         1.1.1
+license:         BSD3
+license-file:    LICENSE
+author:          Michael Snoyman <michael@snoyman.com>
+maintainer:      Michael Snoyman <michael@snoyman.com>
+synopsis:        HTTP client package with conduit interface and HTTPS support.
+description:
+    This package uses attoparsec for parsing the actual contents of the HTTP connection. It also provides higher-level functions which allow you to avoid direct usage of conduits. See <http://www.yesodweb.com/book/http-conduit> for more information.
+category:        Web, Conduit
+stability:       Stable
+cabal-version:   >= 1.8
+build-type:      Simple
+homepage:        http://www.yesodweb.com/book/http-conduit
+extra-source-files: test/main.hs
+
+flag network-bytestring
+  default: False
+
+library
+    build-depends: base                  >= 4       && < 5
+                 , bytestring            >= 0.9.1.4 && < 0.10
+                 , transformers          >= 0.2     && < 0.3
+                 , failure               >= 0.1     && < 0.2
+                 , conduit               >= 0.0     && < 0.1
+                 , zlib-conduit          >= 0.0     && < 0.1
+                 , blaze-builder-conduit >= 0.0     && < 0.1
+                 , attoparsec-conduit    >= 0.0     && < 0.1
+                 , attoparsec            >= 0.8.0.2 && < 0.11
+                 , utf8-string           >= 0.3.4   && < 0.4
+                 , blaze-builder         >= 0.2.1   && < 0.4
+                 , http-types            >= 0.6     && < 0.7
+                 , cprng-aes             >= 0.2     && < 0.3
+                 , tls                   >= 0.8.1   && < 0.9
+                 , tls-extra             >= 0.4     && < 0.5
+                 , monad-control         >= 0.3     && < 0.4
+                 , containers            >= 0.2
+                 , certificate           >= 0.7     && < 1.1
+                 , case-insensitive      >= 0.2
+                 , base64-bytestring     >= 0.1     && < 0.2
+                 , asn1-data             >= 0.5.1   && < 0.7
+                 , data-default          >= 0.3     && < 0.4
+                 , text
+                 , transformers-base     >= 0.4     && < 0.5
+                 , lifted-base           >= 0.1     && < 0.2
+                 , time
+    if flag(network-bytestring)
+        build-depends: network               >= 2.2.1   && < 2.2.3
+                     , network-bytestring    >= 0.1.3   && < 0.1.4
+    else
+        build-depends: network               >= 2.3     && < 2.4
+    exposed-modules: Network.HTTP.Conduit
+    other-modules:   Network.HTTP.Conduit.Parser
+                     Network.HTTP.Conduit.ConnInfo
+                     Network.HTTP.Conduit.Request
+                     Network.HTTP.Conduit.Util
+                     Network.HTTP.Conduit.Manager
+                     Network.HTTP.Conduit.Chunk
+                     Network.HTTP.Conduit.Response
+    ghc-options:     -Wall
+
+test-suite test
+    main-is: test/main.hs
+    type: exitcode-stdio-1.0
+
+    ghc-options:   -Wall
+    cpp-options:   -DDEBUG
+    build-depends: base >= 4 && < 5
+                 , HUnit
+                 , hspec
+                 , bytestring
+                 , transformers
+                 , failure
+                 , conduit
+                 , zlib-conduit
+                 , blaze-builder-conduit
+                 , attoparsec-conduit
+                 , attoparsec
+                 , utf8-string
+                 , blaze-builder
+                 , http-types
+                 , cprng-aes
+                 , tls
+                 , tls-extra
+                 , monad-control
+                 , containers
+                 , certificate
+                 , case-insensitive
+                 , base64-bytestring
+                 , asn1-data
+                 , data-default
+                 , text
+                 , transformers-base
+                 , lifted-base
+                 , time
+                 , network
+                 , wai
+                 , warp
+                 , http-types
+
+source-repository head
+  type:     git
+  location: git://github.com/snoyberg/http-conduit.git

@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+import Test.Hspec.Monadic
+import Test.Hspec.HUnit ()
+import Test.HUnit
+import Network.Wai
+import Network.Wai.Handler.Warp (run)
+import Network.HTTP.Conduit
+import Control.Concurrent (forkIO, killThread)
+import Network.HTTP.Types
+import Control.Exception (try, SomeException)
+import Network.HTTP.Conduit.ConnInfo
+
+app :: Application
+app req =
+    case pathInfo req of
+        [] -> return $ responseLBS status200 [] "homepage"
+        _ -> return $ responseLBS status404 [] "not found"
+
+main :: IO ()
+main = hspecX $ do
+    describe "simpleHttp" $ do
+        it "gets homepage" $ do
+            tid <- forkIO $ run 3000 app
+            lbs <- simpleHttp "http://localhost:3000/"
+            killThread tid
+            lbs @?= "homepage"
+        it "throws exception on 404" $ do
+            tid <- forkIO $ run 3001 app
+            elbs <- try $ simpleHttp "http://localhost:3001/404"
+            killThread tid
+            case elbs of
+                Left (_ :: SomeException) -> return ()
+                Right _ -> error "Expected an exception"
+    describe "manager" $ do
+        it "closes all connections" $ do
+            clearSocketsList
+            tid1 <- forkIO $ run 3002 app
+            tid2 <- forkIO $ run 3003 app
+            withManager $ \manager -> do
+                let Just req1 = parseUrl "http://localhost:3002/"
+                let Just req2 = parseUrl "http://localhost:3003/"
+                _res1a <- http req1 manager
+                _res1b <- http req1 manager
+                _res2 <- http req2 manager
+                return ()
+            requireAllSocketsClosed
+            killThread tid2
+            killThread tid1