http-conduit 1.1.1 → 1.1.2.2

raw patch · 12 files changed

+1650/−1647 lines, 12 filesdep ~failuresetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: failure

API changes (from Hackage documentation)

Files

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

@@ -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,254 +1,253 @@-{-# 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
+{-# 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 qualified Data.Conduit as C+-- >+-- > main :: IO ()+-- > main = do+-- >      request <- parseUrl "http://google.com/"+-- >      withManager $ \manager -> do+-- >          Response _ _ bsrc <- http request 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,169 +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
-    , 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
+{-# 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,316 +1,316 @@-{-# 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)
+{-# 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,+-- 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+        rejected               -> return rejected++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,108 @@-{-# 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)++-- | Since 1.1.2.+instance Functor Response where+    fmap f (Response status headers body) = Response status headers (f body)++-- | 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,103 +1,103 @@-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
+name:            http-conduit+version:         1.1.2.2+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+                 , 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

@@ -1,49 +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
+{-# 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