http-conduit 1.2.0 → 1.2.1
raw patch · 7 files changed
+129/−86 lines, 7 filesdep +socksdep ~attoparsec-conduitdep ~blaze-builder-conduitdep ~conduit
Dependencies added: socks
Dependency ranges changed: attoparsec-conduit, blaze-builder-conduit, conduit, zlib-conduit
Files
- Network/HTTP/Conduit.hs +7/−37
- Network/HTTP/Conduit/Chunk.hs +12/−11
- Network/HTTP/Conduit/ConnInfo.hs +18/−11
- Network/HTTP/Conduit/Manager.hs +20/−9
- Network/HTTP/Conduit/Request.hs +4/−0
- Network/HTTP/Conduit/Response.hs +61/−13
- http-conduit.cabal +7/−5
Network/HTTP/Conduit.hs view
@@ -68,6 +68,7 @@ , requestHeaders , requestBody , proxy+ , socksProxy , rawBody , decompress , redirectCount@@ -88,6 +89,7 @@ , applyBasicAuth , addProxy , lbsResponse+ , getRedirectedRequest -- * Decompression predicates , alwaysDecompress , browserDecompress@@ -103,7 +105,6 @@ 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)@@ -154,46 +155,15 @@ case checkStatus req0 status hs of Nothing -> return res Just exc -> do- body' <- C.prepareSource body- C.sourceClose body'+ C.sourceClose 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+ res <- httpRaw req manager+ case getRedirectedRequest req (responseHeaders res) (W.statusCode (statusCode res)) of+ Just req' -> go (count - 1) req'+ Nothing -> return res -- | Get a 'Response' without any redirect following. httpRaw
Network/HTTP/Conduit/Chunk.hs view
@@ -44,7 +44,7 @@ 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.Partial f' -> return $ C.StateProducing (NeedHeader f') $ front [] A.Fail _ contexts msg -> lift $ C.resourceThrow $ ParseError contexts msg push front (Isolate i) x = do let (a, b) = S.splitAt i x@@ -54,10 +54,9 @@ (front . (a:)) (NeedNewline $ A.parse newline) b- else assert (S.null b) $ return- ( Isolate i'- , C.Producing (front [a])- )+ else assert (S.null b) $ return $ C.StateProducing+ (Isolate i')+ (front [a]) push front (NeedNewline f) x = case f x of A.Done x' () -> do@@ -67,16 +66,18 @@ (front . addHeader) (NeedHeader $ A.parse parseChunkHeader) x'- A.Partial f' -> return (NeedNewline f', C.Producing $ front [])+ A.Partial f' -> return $ C.StateProducing (NeedNewline f') $ 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)+ return $ C.StateFinished 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]- }+chunkIt =+ conduit+ where+ conduit = C.Conduit push close+ push xs = return $ C.Producing conduit [chunkedTransferEncoding xs]+ close = return [chunkedTransferTerminator]
Network/HTTP/Conduit/ConnInfo.hs view
@@ -28,9 +28,11 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L +import Network (PortID(..)) import Network.Socket (Socket, sClose) import Network.Socket.ByteString (recv, sendAll) import qualified Network.Socket as NS+import Network.Socks5 (socksConnectWith, SocksConf) import Network.TLS import Network.TLS.Extra (ciphersuite_all)@@ -54,20 +56,23 @@ } 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 ()- }+connSink ConnInfo { connWrite = write } =+ C.SinkData push close+ where+ push bss = liftBase (write bss) >> return (C.Processing push close)+ close = return () connSource :: C.ResourceIO m => ConnInfo -> C.Source m ByteString-connSource ConnInfo { connRead = read' } = C.Source $ return $ C.PreparedSource- { C.sourcePull = do+connSource ConnInfo { connRead = read' } =+ src+ where+ src = C.Source pull close+ pull = do bs <- liftBase read' if S.null bs then return C.Closed- else return $ C.Open bs- , C.sourceClose = return ()- }+ else return $ C.Open src bs+ close = return () #if DEBUG allOpenSockets :: I.IORef (Int, IntMap.IntMap String)@@ -151,8 +156,10 @@ -- 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+getSocket :: String -> Int -> Maybe SocksConf -> IO NS.Socket+getSocket host' port' (Just socksConf) = do+ socksConnectWith socksConf host' (PortNumber $ fromIntegral port')+getSocket host' port' Nothing = do let hints = NS.defaultHints { NS.addrFlags = [NS.AI_ADDRCONFIG] , NS.addrSocketType = NS.Stream
Network/HTTP/Conduit/Manager.hs view
@@ -18,7 +18,7 @@ import Prelude hiding (catch) import Data.Monoid (mappend)-import System.IO (hClose, hFlush)+import System.IO (hClose, hFlush, IOMode(..)) import qualified Data.IORef as I import qualified Data.Map as Map @@ -42,7 +42,8 @@ import Control.Concurrent (forkIO, threadDelay) import Data.Time (UTCTime, getCurrentTime, addUTCTime) -import Network (connectTo, PortID (PortNumber))+import Network (connectTo, PortID (PortNumber), HostName)+import Network.Socket (socketToHandle) import Data.Certificate.X509 (X509, encodeCertificate) import qualified Network.HTTP.Types as W@@ -52,8 +53,10 @@ import Network.HTTP.Conduit.Util (hGetSome) import Network.HTTP.Conduit.Parser (parserHeadersFromByteString) import Network.HTTP.Conduit.Request+import Network.Socks5 (SocksConf, socksConnectWith) import Data.Default import Data.Maybe (mapMaybe)+import System.IO (Handle) -- | Settings for a @Manager@. Please use the 'def' function and then modify -- individual settings.@@ -238,10 +241,11 @@ => Manager -> String -> Int+ -> Maybe SocksConf -- ^ optional socks proxy -> ResourceT m (ConnRelease m, ConnInfo, ManagedConn)-getSocketConn man host' port' =+getSocketConn man host' port' socksProxy' = getManagedConn man (ConnKey (T.pack host') port' False) $- getSocket host' port' >>= socketConn desc+ getSocket host' port' socksProxy' >>= socketConn desc where desc = socketDesc host' port' "unsecured" @@ -253,10 +257,11 @@ -> Manager -> String -- ^ host -> Int -- ^ port+ -> Maybe SocksConf -- ^ optional socks proxy -> ResourceT m (ConnRelease m, ConnInfo, ManagedConn)-getSslConn checkCert man host' port' =+getSslConn checkCert man host' port' socksProxy' = getManagedConn man (ConnKey (T.pack host') port' True) $- (connectTo host' (PortNumber $ fromIntegral port') >>= sslClientConn desc checkCert)+ (connectionTo host' (PortNumber $ fromIntegral port') socksProxy' >>= sslClientConn desc checkCert) where desc = socketDesc host' port' "secured" @@ -268,14 +273,15 @@ -> Manager -> String -- ^ Proxy host -> Int -- ^ Proxy port+ -> Maybe SocksConf -- ^ optional SOCKS proxy -> ResourceT m (ConnRelease m, ConnInfo, ManagedConn)-getSslProxyConn checkCert thost tport man phost pport =+getSslProxyConn checkCert thost tport man phost pport socksProxy' = 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)+ h <- connectionTo phost (PortNumber $ fromIntegral pport) socksProxy' L.hPutStr h $ Blaze.toLazyByteString connectRequest hFlush h r <- hGetSome h 2048@@ -350,7 +356,7 @@ -> Manager -> ResourceT m (ConnRelease m, ConnInfo, ManagedConn) getConn req m =- go m connhost connport+ go m connhost connport (socksProxy req) where h = host req (useProxy, connhost, connport) =@@ -400,3 +406,8 @@ case Map.lookup host' cache of Nothing -> Map.singleton encoded expire Just m -> Map.insert encoded expire m++connectionTo :: HostName -> PortID -> Maybe SocksConf -> IO Handle+connectionTo host' port' Nothing = connectTo host' port'+connectionTo host' port' (Just socksConf) =+ socksConnectWith socksConf host' port' >>= flip socketToHandle ReadWriteMode
Network/HTTP/Conduit/Request.hs view
@@ -36,6 +36,7 @@ import qualified Data.ByteString.Lazy as L import qualified Network.HTTP.Types as W+import Network.Socks5 (SocksConf) import Control.Exception (Exception, SomeException, toException) import Control.Failure (Failure (failure))@@ -72,6 +73,8 @@ , requestBody :: RequestBody m , proxy :: Maybe Proxy -- ^ Optional HTTP proxy.+ , socksProxy :: Maybe SocksConf+ -- ^ Optional SOCKS proxy. , rawBody :: Bool -- ^ If @True@, a chunked and\/or gzipped body will not be -- decoded. Use with caution.@@ -165,6 +168,7 @@ , requestBody = RequestBodyLBS L.empty , method = "GET" , proxy = Nothing+ , socksProxy = Nothing , rawBody = False , decompress = browserDecompress , redirectCount = 10
Network/HTTP/Conduit/Response.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} module Network.HTTP.Conduit.Response ( Response (..)+ , getRedirectedRequest , getResponse , lbsResponse ) where@@ -43,6 +44,54 @@ instance Functor Response where fmap f (Response status headers body) = Response status headers (f body) +-- | If a request is a redirection (status code 3xx) this function will create+-- a new request from the old request, the server headers returned with the+-- redirection, and the redirection code itself. This function returns 'Nothing'+-- if the code is not a 3xx, there is no 'location' header included, or if the+-- redirected response couldn't be parsed with 'parseUrl'.+--+-- If a user of this library wants to know the url chain that results from a+-- specific request, that user has to re-implement the redirect-following logic+-- themselves. An example of that might look like this:+--+-- > myHttp req man = E.catch (C.runResourceT $ http req' man >> return [req'])+-- > (\ (StatusCodeException status headers) -> do+-- > l <- myHttp (fromJust $ nextRequest status headers) man+-- > return $ req' : l)+-- > where req' = req { redirectCount = 0 }+-- > nextRequest status headers = getRedirectedRequest req' headers $ W.statusCode status+getRedirectedRequest :: Request m -> W.ResponseHeaders -> Int -> Maybe (Request m)+getRedirectedRequest req hs code+ | 300 <= code && code < 400 = do+ l' <- lookup "location" hs+ l <- parseUrl $ 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'+ return 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+ }+ | otherwise = Nothing+ -- | Convert a 'Response' that has a 'C.Source' body to one with a lazy -- 'L.ByteString' body. lbsResponse :: C.Resource m@@ -98,16 +147,15 @@ => ResourceT m () -> C.Source m a -> C.Source m a-addCleanup cleanup (C.Source msrc) = C.Source $ do- src <- msrc- return C.PreparedSource- { C.sourcePull = do- res <- C.sourcePull src- case res of- C.Closed -> cleanup- C.Open _ -> return ()- return res- , C.sourceClose = do- C.sourceClose src- cleanup- }+addCleanup cleanup src = src+ { C.sourcePull = do+ res <- C.sourcePull src+ case res of+ C.Closed -> cleanup >> return C.Closed+ C.Open src' val -> return $ C.Open+ (addCleanup cleanup src')+ val+ , C.sourceClose = do+ C.sourceClose src+ cleanup+ }
http-conduit.cabal view
@@ -1,5 +1,5 @@ name: http-conduit-version: 1.2.0+version: 1.2.1 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -22,10 +22,10 @@ , bytestring >= 0.9.1.4 && < 0.10 , transformers >= 0.2 && < 0.3 , failure >= 0.1- , conduit >= 0.1- , zlib-conduit >= 0.0 && < 0.1- , blaze-builder-conduit >= 0.0 && < 0.1- , attoparsec-conduit >= 0.0 && < 0.1+ , conduit >= 0.2+ , zlib-conduit >= 0.2 && < 0.3+ , blaze-builder-conduit >= 0.2 && < 0.3+ , attoparsec-conduit >= 0.2 && < 0.3 , attoparsec >= 0.8.0.2 && < 0.11 , utf8-string >= 0.3.4 && < 0.4 , blaze-builder >= 0.2.1 && < 0.4@@ -43,6 +43,7 @@ , text , transformers-base >= 0.4 && < 0.5 , lifted-base >= 0.1 && < 0.2+ , socks >= 0.4 && < 0.5 , time if flag(network-bytestring) build-depends: network >= 2.2.1 && < 2.2.3@@ -96,6 +97,7 @@ , network , wai , warp+ , socks , http-types source-repository head