http-enumerator 0.6.7 → 0.7.3.3
raw patch · 4 files changed
Files
- Network/HTTP/Enumerator.hs +191/−72
- Network/HTTP/Enumerator/HttpParser.hs +4/−1
- Network/TLS/Client/Enumerator.hs +12/−4
- http-enumerator.cabal +16/−15
Network/HTTP/Enumerator.hs view
@@ -60,9 +60,25 @@ , redirectIter -- * Datatypes , Proxy (..)- , Request (..) , RequestBody (..) , Response (..)+ -- ** Request+ , Request+ , def+ , method+ , secure+ , checkCerts+ , host+ , port+ , path+ , queryString+ , requestHeaders+ , requestBody+ , proxy+ , rawBody+ , decompress+ -- *** Defaults+ , defaultCheckCerts -- * Manager , Manager , newManager@@ -93,11 +109,15 @@ import Data.Enumerator ( Iteratee (..), Stream (..), catchError, throwError , yield, Step (..), Enumeratee, ($$), joinI, Enumerator, run_- , returnI, (>==>), enumEOF+ , returnI, (>==>), (>>==), continue, checkDone, enumEOF+ , (=$) ) import qualified Data.Enumerator.List as EL import Network.HTTP.Enumerator.HttpParser-import Control.Exception (Exception, bracket, throwIO, SomeException, try)+import Control.Exception+ ( Exception, bracket, throwIO, SomeException, try+ , fromException+ ) import Control.Arrow (first) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Class (lift)@@ -106,12 +126,17 @@ import Codec.Binary.UTF8.String (encodeString) import qualified Blaze.ByteString.Builder as Blaze import Blaze.ByteString.Builder.Enumerator (builderToByteString)+import Blaze.ByteString.Builder.HTTP (chunkedTransferEncoding, chunkedTransferTerminator) import Data.Monoid (Monoid (..)) import qualified Network.HTTP.Types as W import qualified Data.CaseInsensitive as CI import Data.Int (Int64) import qualified Codec.Zlib.Enum as Z+#if MIN_VERSION_monad_control(0,3,0)+import Control.Monad.Trans.Control (MonadBaseControl, liftBaseOp)+#else import Control.Monad.IO.Control (MonadControlIO, liftIOOp)+#endif import Data.Map (Map) import qualified Data.Map as Map import qualified Data.IORef as I@@ -122,6 +147,8 @@ import System.IO (hClose, hFlush) import Blaze.ByteString.Builder (toByteString) import Data.Maybe (fromMaybe)+import Data.Default (Default (def))+import Numeric (showHex) #if !MIN_VERSION_base(4,3,0) import GHC.IO.Handle.Types import System.IO (hWaitForInput, hIsEOF)@@ -185,6 +212,13 @@ withManagedConn man (host', port', False) $ fmap TLS.socketConn $ getSocket host' port' +checkReset :: SomeException -> Bool+checkReset e = isReset || isIOReset+ where isReset = case fromException e of+ Just TLS.ConnectionReset -> True+ _ -> False+ isIOReset = show e == "recv: resource vanished (Connection reset by peer)"+ withManagedConn :: MonadIO m => Manager@@ -208,9 +242,12 @@ then putInsecureSocket man key ci else TLS.connClose ci return a)- (\se -> if isManaged- then withManagedConn man key open req step- else throwError se)+ (\se -> liftIO (TLS.connClose ci) >>+ liftIO (putStrLn $ "Error during enum: " ++ show se) >>+ if checkReset se && isManaged+ then withManagedConn man key open req step+ else throwError se+ ) withSslConn :: MonadIO m => ([X509] -> IO TLS.TLSCertificateUsage)@@ -283,10 +320,16 @@ -- 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-enumerator 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 :: [X509] -> IO TLS.TLSCertificateUsage -- ^ Check if the server certificate is valid. Only relevant for HTTPS.+ , checkCerts :: W.Ascii -> [X509] -> IO TLS.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.@@ -301,17 +344,23 @@ -- | When using the 'RequestBodyEnum' constructor and any function which calls -- 'redirectIter', you must ensure that the 'Enumerator' can be called multiple -- times.+--+-- The 'RequestBodyEnumChunked' will send a chunked request body, note+-- that not all servers support this. Only use 'RequestBodyEnumChunked'+-- 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 | RequestBodyEnum Int64 (Enumerator Blaze.Builder m ())+ | RequestBodyEnumChunked (Enumerator Blaze.Builder m ()) -- | 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 \"user\" \"pass\" $ fromJust $ parseUrl url applyBasicAuth :: S.ByteString -> S.ByteString -> Request m -> Request m applyBasicAuth user passwd req =@@ -370,8 +419,8 @@ -> (W.Status -> W.ResponseHeaders -> Iteratee S.ByteString m a) -> Manager -> Iteratee S.ByteString m a-http Request {..} bodyStep m = do- withConn m connhost connport requestEnum $$ go+http req@(Request {..}) bodyStep m =+ withConn m connhost connport requestEnum $$ getResponse req bodyStep where (useProxy, connhost, connport) = case proxy of@@ -380,22 +429,26 @@ withConn = case (secure, useProxy) of (False, _) -> withSocketConn- (True, False) -> withSslConn checkCerts- (True, True) -> withSslProxyConn checkCerts host port+ (True, False) -> withSslConn $ checkCerts host+ (True, True) -> withSslProxyConn (checkCerts host) host port (contentLength, bodyEnum) = case requestBody of- RequestBodyLBS lbs -> (L.length lbs, enumSingle $ Blaze.fromLazyByteString lbs)- RequestBodyBS bs -> (fromIntegral $ S.length bs, enumSingle $ Blaze.fromByteString bs)- RequestBodyBuilder i b -> (i, enumSingle b)- RequestBodyEnum i enum -> (i, enum)+ RequestBodyLBS lbs -> (Just $ L.length lbs, enumSingle $ Blaze.fromLazyByteString lbs)+ RequestBodyBS bs -> (Just $ fromIntegral $ S.length bs, enumSingle $ Blaze.fromByteString bs)+ RequestBodyBuilder i b -> (Just $ i, enumSingle b)+ RequestBodyEnum i enum -> (Just i, enum)+ RequestBodyEnumChunked enum -> (Nothing, \step -> enum $$ joinI $ chunkIt step) hh | port == 80 && not secure = host | port == 443 && secure = host | otherwise = host `mappend` S8.pack (':' : show port)+ contentLengthHeader (Just contentLength') =+ if method `elem` ["GET", "HEAD"] && contentLength' == 0+ then id+ else (:) ("Content-Length", S8.pack $ show contentLength')+ contentLengthHeader Nothing = (:) ("Transfer-Encoding", "chunked") headers' = ("Host", hh)- : (if method `elem` ["GET", "HEAD"] && contentLength == 0- then id- else (:) ("Content-Length", S8.pack $ show contentLength))+ : (contentLengthHeader contentLength) (("Accept-Encoding", "gzip") : requestHeaders) requestHeaders' = Blaze.fromByteString method@@ -421,36 +474,54 @@ `mappend` Blaze.fromByteString "\r\n") `mappend` Blaze.fromByteString "\r\n" requestEnum = enumSingle requestHeaders' >==> bodyEnum- go = do- ((_, sc, sm), hs) <- iterHeaders- let s = W.Status sc sm- let hs' = map (first CI.mk) hs- let mcl = lookup "content-length" hs'- let body' x =- if not rawBody && ("transfer-encoding", "chunked") `elem` hs'- then joinI $ chunkedEnumeratee $$ x- else case mcl >>= readMay . S8.unpack of- Just len -> joinI $ takeLBS len $$ x- Nothing -> x- let decompresser x =- if not rawBody- && ("content-encoding", "gzip") `elem` hs'- && decompress (fromMaybe "" $ lookup "content-type" hs')- then joinI $ Z.ungzip x- else returnI x- -- RFC 2616 section 4.4_1 defines responses that must not include a body- res <-- if method == "HEAD" || sc == 204 -- No Content- || sc == 304 -- Not Modified- || (sc < 200 && sc >= 100)- then enumEOF $$ bodyStep s hs'- else body' $ decompresser $$ do- x <- bodyStep s hs'- flushStream- return x- let toPut = Just "close" /= lookup "connection" hs'- return (toPut, res) +getResponse :: MonadIO m+ => Request m+ -> (W.Status -> [W.Header] -> Iteratee S8.ByteString m a)+ -> Iteratee S8.ByteString m (Bool, a)+getResponse Request {..} bodyStep = do+ ((_, sc, sm), hs) <- iterHeaders+ let s = W.Status sc sm+ let hs' = map (first CI.mk) hs+ let mcl = lookup "content-length" hs'+ let body' =+ case (rawBody, ("transfer-encoding", "chunked") `elem` hs') of+ (False, True) -> (chunkedEnumeratee =$)+ (True , True) -> (chunkedTerminator =$)+ (_ , False) -> case mcl >>= readMay . S8.unpack of+ Just len -> (takeLBS len =$)+ Nothing -> id+ let decompresser =+ if needsGunzip hs'+ then (Z.ungzip =$)+ else id+ -- RFC 2616 section 4.4_1 defines responses that must not include a body+ res <-+ if hasNoBody method sc+ then enumEOF $$ bodyStep s hs'+ else body' $ decompresser $ do+ x <- bodyStep s hs'+ flushStream+ return x++ -- should we put this connection back into the connection manager?+ let toPut = Just "close" /= lookup "connection" hs'+ return (toPut, res)+ where+ hasNoBody :: S8.ByteString -- ^ request method+ -> Int -- ^ status code+ -> Bool+ hasNoBody "HEAD" _ = True+ hasNoBody _ 204 = True+ hasNoBody _ 304 = True+ hasNoBody _ i = 100 <= i && i < 200++ needsGunzip :: [W.Header] -> Bool+ needsGunzip hs' =+ not rawBody+ && ("content-encoding", "gzip") `elem` hs'+ && decompress (fromMaybe "" $ lookup "content-type" hs')+ flushStream :: Monad m => Iteratee a m () flushStream = do x <- EL.head@@ -469,6 +540,37 @@ chunkedEnumeratee k' chunkedEnumeratee step = return step +chunkedTerminator :: MonadIO m => Enumeratee S.ByteString S.ByteString m a+chunkedTerminator (Continue k) = do+ len <- catchParser "Chunk header" iterChunkHeader+ k' <- sendCont k $ S8.pack $ showHex len "\r\n"+ if len == 0+ then return k'+ else do+ step <- takeLBS len k'+ catchParser "End of chunk newline" iterNewline+ case step of+ Continue k'' -> do+ k''' <- sendCont k'' "\r\n"+ chunkedTerminator k'''+ _ -> return step+chunkedTerminator step = return step++sendCont :: Monad m+ => (Stream S8.ByteString -> Iteratee S8.ByteString m a)+ -> S8.ByteString+ -> Iteratee S8.ByteString m (Step S8.ByteString m a)+sendCont k bs = lift $ runIteratee $ k $ Chunks [bs]++chunkIt :: Monad m => Enumeratee Blaze.Builder Blaze.Builder m a+chunkIt = checkDone $ continue . step+ where+ step k EOF = k (Chunks [chunkedTransferTerminator]) >>== return+ step k (Chunks []) = continue $ step k+ step k (Chunks xs) = k (Chunks [chunkedTransferEncoding $ mconcat xs])+ >>== chunkIt++ takeLBS :: MonadIO m => Int -> Enumeratee S.ByteString S.ByteString m a takeLBS 0 step = return step takeLBS len (Continue k) = do@@ -507,7 +609,6 @@ encodeUrlChar c@'_' = [c] encodeUrlChar c@'.' = [c] encodeUrlChar c@'~' = [c]-encodeUrlChar ' ' = "+" encodeUrlChar y = let (a, c) = fromEnum y `divMod` 16 b = a `mod` 16@@ -546,37 +647,50 @@ where s' = encodeString s +defaultCheckCerts :: W.Ascii -> [X509] -> IO TLS.TLSCertificateUsage+defaultCheckCerts host' certs =+ case certificateVerifyDomain (S8.unpack host') certs of+ TLS.CertificateUsageAccept -> certificateVerifyChain certs+ rejected -> return rejected++instance Default (Request m) where+ def = Request+ { host = "localhost"+ , port = 80+ , secure = False+ , checkCerts = defaultCheckCerts+ , requestHeaders = []+ , path = "/"+ , queryString = []+ , requestBody = RequestBodyLBS L.empty+ , method = "GET"+ , proxy = Nothing+ , rawBody = False+ , decompress = alwaysDecompress+ }+ parseUrl2 :: Failure HttpException m => String -> Bool -> Bool -> String -> m (Request m') parseUrl2 full sec parsePath s = do port' <- mport- return Request+ return def { host = S8.pack hostname , port = port' , secure = sec- , checkCerts = \x ->- case certificateVerifyDomain hostname x of- TLS.CertificateUsageAccept -> certificateVerifyChain x- _ -> return TLS.CertificateUsageAccept- , requestHeaders = [] , path = S8.pack- $ if null path''+ $ (if null path' then "/"- else concatMap (encodeUrlCharPI parsePath) path''+ else concatMap (encodeUrlCharPI parsePath) path')+ +++ (if parsePath then "" else qstring') , queryString = if parsePath then W.parseQuery $ S8.pack qstring else []- , requestBody = RequestBodyLBS L.empty- , method = "GET"- , proxy = Nothing- , rawBody = False- , decompress = alwaysDecompress } where (beforeSlash, afterSlash) = break (== '/') s (hostname, portStr) = break (== ':') beforeSlash (path', qstring') = break (== '?') afterSlash- path'' = if parsePath then path' else afterSlash qstring'' = case qstring' of '?':x -> x _ -> qstring'@@ -625,7 +739,7 @@ -- | Download the specified URL, following any redirects, and return the -- response body. ----- This function will 'failure' an 'HttpException' for any response with a+-- This function will 'throwIO' an 'HttpException' for any response with a -- non-2xx status code. It uses 'parseUrl' to parse the input. This function -- essentially wraps 'httpLbsRedirect'. --@@ -633,14 +747,14 @@ -- utilize lazy I/O, and therefore the entire response body will live in -- memory. If you want constant memory usage, you'll need to write your own -- iteratee and use 'http' or 'httpRedirect' directly.-simpleHttp :: (MonadIO m, Failure HttpException m) => String -> m L.ByteString+simpleHttp :: MonadIO m => String -> m L.ByteString simpleHttp url = do- url' <- parseUrl url+ url' <- liftIO $ parseUrl url Response sc _ b <- liftIO $ withManager $ httpLbsRedirect $ url' { decompress = browserDecompress } if 200 <= sc && sc < 300 then return b- else failure $ StatusCodeException sc b+ else liftIO $ throwIO $ StatusCodeException sc b data HttpException = StatusCodeException Int L.ByteString | InvalidUrlException String String@@ -652,7 +766,7 @@ -- | Same as 'http', but follows all 3xx redirect status codes that contain a -- location header. httpRedirect- :: (MonadIO m, Failure HttpException m)+ :: MonadIO m => Request m -> (W.Status -> W.ResponseHeaders -> Iteratee S.ByteString m a) -> Manager@@ -663,7 +777,7 @@ -- | Make a request automatically follow 3xx redirects. -- -- Used internally by 'httpRedirect' and family.-redirectIter :: (MonadIO m, Failure HttpException m)+redirectIter :: MonadIO m => Int -- ^ number of redirects to attempt -> Request m -- ^ Original request -> (W.Status -> W.ResponseHeaders -> Iteratee S.ByteString m a)@@ -686,7 +800,7 @@ , S8.unpack l'' ] _ -> S8.unpack l''- l <- lift $ parseUrl l'+ l <- liftIO $ parseUrl l' let req' = req { host = host l , port = port l@@ -699,7 +813,7 @@ else method l } if redirects == 0- then lift $ failure TooManyRedirects+ then liftIO $ throwIO TooManyRedirects else (http req') (redirectIter (redirects - 1) req' bodyStep manager) manager Nothing -> bodyStep s hs | otherwise = bodyStep s hs@@ -721,7 +835,7 @@ -- /not/ utilize lazy I/O, and therefore the entire response body will live in -- memory. If you want constant memory usage, you'll need to write your own -- iteratee and use 'http' or 'httpRedirect' directly.-httpLbsRedirect :: (MonadIO m, Failure HttpException m) => Request m -> Manager -> m Response+httpLbsRedirect :: MonadIO m => Request m -> Manager -> m Response httpLbsRedirect req = run_ . httpRedirect req lbsIter readMay :: Read a => String -> Maybe a@@ -784,5 +898,10 @@ mapM_ TLS.connClose $ Map.elems m -- | Create a new 'Manager', call the supplied function and then close it.+#if MIN_VERSION_monad_control(0,3,0)+withManager :: MonadBaseControl IO m => (Manager -> m a) -> m a+withManager = liftBaseOp $ bracket newManager closeManager+#else withManager :: MonadControlIO m => (Manager -> m a) -> m a withManager = liftIOOp $ bracket newManager closeManager+#endif
Network/HTTP/Enumerator/HttpParser.hs view
@@ -14,6 +14,7 @@ import qualified Data.ByteString.Char8 as S8 import Control.Applicative import Data.Word (Word8)+import Control.Monad (when) type Header = (S.ByteString, S.ByteString) @@ -66,7 +67,9 @@ parseStatus :: Parser Status parseStatus = do- _ <- string "HTTP/"+ 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
Network/TLS/Client/Enumerator.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable #-} module Network.TLS.Client.Enumerator ( ConnInfo , connClose@@ -8,11 +9,14 @@ , socketConn , TLSCertificateRejectReason(..) , TLSCertificateUsage(..)+ , ConnectionReset (..) ) where import Data.ByteString (ByteString) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L+import Data.Typeable (Typeable)+import Control.Exception (Exception) import System.IO (Handle, hClose) import Network.Socket (Socket, sClose) import Network.Socket.ByteString (recv, sendAll)@@ -21,7 +25,7 @@ import Control.Monad.Trans.Class (lift) import Data.Enumerator ( Iteratee (..), Enumerator, Step (..), Stream (..), continue, returnI- , tryIO+ , tryIO, throwError ) import Data.Certificate.X509 (X509) import Network.TLS.Extra (ciphersuite_all)@@ -33,6 +37,10 @@ , connClose :: IO () } +data ConnectionReset = ConnectionReset+ deriving (Show,Typeable)+instance Exception ConnectionReset+ connIter :: MonadIO m => ConnInfo -> Iteratee ByteString m () connIter ConnInfo { connWrite = write } = continue go@@ -72,7 +80,7 @@ } gen <- makeSystem istate <- client tcp gen h- _ <- handshake istate+ handshake istate return ConnInfo { connRead = recvD istate , connWrite = sendData istate . L.fromChunks@@ -81,6 +89,6 @@ where recvD istate = do x <- recvData istate- if L.null x+ if S.null x then recvD istate- else return $ L.toChunks x+ else return [x]
http-enumerator.cabal view
@@ -1,14 +1,14 @@ name: http-enumerator-version: 0.6.7+version: 0.7.3.3 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com> maintainer: Michael Snoyman <michael@snoyman.com>-synopsis: HTTP client package with enumerator interface and HTTPS support.+synopsis: HTTP client package with enumerator interface and HTTPS support. (deprecated) description:- This package uses attoparsec for parsing the actual contents of the HTTP connection. The only gotcha is the withHttpEnumerator function, otherwise should do exactly what you expect.+ This package has been deprecated in favor of http-conduit (<http://hackage.haskell.org/package/http-conduit>), which provides a more powerful and simpler interface. The API is very similar, and migrating should not be problematic. Send concerns about this move to the maintainer (address listed above). category: Web, Enumerator-stability: Experimental+stability: Stable cabal-version: >= 1.6 build-type: Simple homepage: http://github.com/snoyberg/http-enumerator@@ -22,25 +22,26 @@ library build-depends: base >= 4 && < 5 , bytestring >= 0.9.1.4 && < 0.10- , transformers >= 0.2 && < 0.3- , failure >= 0.1 && < 0.2+ , transformers >= 0.2 && < 0.4+ , failure >= 0.1 && < 0.3 , enumerator >= 0.4.9 && < 0.5- , attoparsec >= 0.8.0.2 && < 0.10- , attoparsec-enumerator >= 0.2.0.4 && < 0.3+ , attoparsec >= 0.8.0.2 && < 0.11+ , attoparsec-enumerator >= 0.2.0.4 && < 0.4 , utf8-string >= 0.3.4 && < 0.4 , blaze-builder >= 0.2.1 && < 0.4 , zlib-enum >= 0.2 && < 0.3 , http-types >= 0.6 && < 0.7 , blaze-builder-enumerator >= 0.2 && < 0.3 , cprng-aes >= 0.2 && < 0.3- , tls >= 0.7 && < 0.8- , tls-extra >= 0.3 && < 0.4- , monad-control >= 0.2 && < 0.3- , containers >= 0.2 && < 0.5- , certificate >= 0.7 && < 0.10- , case-insensitive >= 0.2 && < 0.4+ , tls >= 0.9 && < 0.10+ , tls-extra >= 0.4.3 && < 0.5+ , monad-control >= 0.2 && < 0.4+ , containers >= 0.2+ , certificate >= 1.1 && < 1.2+ , case-insensitive >= 0.2 , base64-bytestring >= 0.1 && < 0.2- , asn1-data >= 0.5.1 && < 0.6+ , asn1-data >= 0.5.1 && < 0.7+ , data-default >= 0.3 && < 0.5 if flag(network-bytestring) build-depends: network >= 2.2.1 && < 2.2.3 , network-bytestring >= 0.1.3 && < 0.1.4