http-enumerator 0.2.1.5 → 0.3.0

raw patch · 4 files changed

+109/−102 lines, 4 filesdep +waidep ~blaze-builderPVP ok

version bump matches the API change (PVP)

Dependencies added: wai

Dependency ranges changed: blaze-builder

API changes (from Hackage documentation)

Files

• Network/HTTP/Enumerator.hs +91/−89
• Network/TLS/Client/Enumerator.hs +12/−9
• http-enumerator.cabal +3/−2
• test.hs +3/−2

@@ -88,15 +88,14 @@ import qualified Data.ByteString.Char8 as S8 import Data.Enumerator     ( Iteratee (..), Stream (..), catchError, throwError, consume-    , yield, Step (..), Enumeratee, ($$), joinI, Enumerator, run-    , continue, enumList, returnI, enumEOF+    , yield, Step (..), Enumeratee, ($$), joinI, Enumerator, run_+    , continue, enumList, returnI     ) import qualified Data.Enumerator as E import Network.HTTP.Enumerator.HttpParser import Network.HTTP.Enumerator.Zlib (ungzip)-import Control.Exception (throwIO, Exception)+import Control.Exception (Exception) import Control.Arrow (first)-import Data.Char (toLower) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Class (lift) import Control.Failure@@ -110,6 +109,7 @@ import qualified Blaze.ByteString.Builder as Blaze import qualified Blaze.ByteString.Builder.Internal.Write as Blaze import Data.Monoid (Monoid (..))+import qualified Network.Wai as W  -- | The OpenSSL library requires some initialization of variables to be used, -- and therefore you must call 'withOpenSSL' before using any of its functions.@@ -136,12 +136,15 @@     NS.connect sock (NS.addrAddress addr)     return sock -withSocketConn :: MonadIO m => String -> Int -> WithConn m a b -> m b-withSocketConn host' port' f = do+withSocketConn :: MonadIO m+               => String+               -> Int+               -> Enumerator S.ByteString m ()+               -> Enumerator S.ByteString m a+withSocketConn host' port' req step0 = do     sock <- liftIO $ getSocket host' port'-    a <- f-            (writeToIter $ B.sendAll sock)-            (readToEnum $ B.recv sock defaultChunkSize)+    lift $ run_ $ req $$ writeToIter $ B.sendAll sock+    a <- readToEnum (B.recv sock defaultChunkSize) step0     liftIO $ NS.sClose sock     return a @@ -166,28 +169,27 @@             readToEnum read' step readToEnum _ step = returnI step -type WithConn m a b = Iteratee S.ByteString m ()-                   -> Enumerator S.ByteString m a-                   -> m b--withSslConn :: MonadIO m => String -> Int -> WithConn m a b -> m b-withSslConn host' port' f = do+withSslConn :: MonadIO m+            => String -- ^ host+            -> Int -- ^ port+            -> Enumerator S.ByteString m () -- ^ request+            -> Enumerator S.ByteString m a -- ^ response+withSslConn host' port' req step0 = do  #if OPENSSL     ctx <- liftIO $ SSL.context     sock <- liftIO $ getSocket host' port'     ssl <- liftIO $ SSL.connection ctx sock     liftIO $ SSL.connect ssl-    a <- f-            (writeToIter $ SSL.write ssl)-            (readToEnum $ SSL.read ssl defaultChunkSize)+    lift $ run_ $ req $$ writeToIter $ SSL.write ssl+    a <- readToEnum (SSL.read ssl defaultChunkSize) step0     liftIO $ SSL.shutdown ssl SSL.Unidirectional-    liftIO $ hClose sock+    liftIO $ NS.sClose sock     return a #else     handle <- liftIO $ connectTo host' (PortNumber $ fromIntegral port')     liftIO $ hSetBuffering handle NoBuffering-    a <- TLS.clientEnumSimple handle f+    a <- TLS.clientEnumSimple handle req step0     liftIO $ hClose handle     return a #endif@@ -202,7 +204,7 @@     , host :: S.ByteString     , port :: Int     , path :: S.ByteString -- ^ Everything from the host to the query string.-    , queryString :: Headers -- ^ Automatically escaped for your convenience.+    , queryString :: [(S.ByteString, S.ByteString)] -- ^ Automatically escaped for your convenience.     , requestHeaders :: Headers     , requestBody :: L.ByteString     }@@ -216,7 +218,7 @@     }     deriving (Show, Read, Eq, Typeable, Data) -type Headers = [(S.ByteString, S.ByteString)]+type Headers = [(W.ResponseHeader, S.ByteString)]  -- | The most low-level function for initiating an HTTP request. --@@ -233,64 +235,61 @@ -- HTTP download, making it possible to download very large responses in -- constant memory. http :: MonadIO m-     => (Int -> Headers -> Iteratee S.ByteString m a)-     -> Request-     -> m a-http bodyIter Request {..} = do+     => Request+     -> (W.Status -> W.ResponseHeaders -> Iteratee S.ByteString m a)+     -> Iteratee S.ByteString m a+http Request {..} bodyStep = do     let h' = S8.unpack host     let withConn = if secure then withSslConn else withSocketConn-    res <- withConn h' port go-    case res of-        Left e -> liftIO $ throwIO e-        Right x -> return x+    withConn h' port req $$ go   where+    req = enumList 8 $ L.toChunks request     hh         | port == 80 && not secure = host         | port == 443 && secure = host         | otherwise = host `S.append` S8.pack (':' : show port)-    go iter enum = do-        let headers' = ("Host", hh)-                     : ("Content-Length", S8.pack $ show-                                                  $ L.length requestBody)-                     : ("Accept-Encoding", "gzip")-                     : requestHeaders-        let request = Blaze.toLazyByteString $ mconcat-                [ Blaze.fromByteString method-                , Blaze.fromByteString " "-                , Blaze.fromByteString $-                    case S8.uncons path of-                        Just ('/', _) -> path-                        _ -> S8.cons '/' path-                , renderQS queryString-                , Blaze.fromByteString " HTTP/1.1\r\n"-                , mconcat $ flip map headers' $ \(k, v) -> mconcat-                    [ Blaze.fromByteString k-                    , Blaze.fromByteString ": "-                    , Blaze.fromByteString v-                    , Blaze.fromByteString "\r\n"-                    ]+    headers' = ("Host", hh)+                 : ("Content-Length", S8.pack $ show+                                              $ L.length requestBody)+                 : ("Accept-Encoding", "gzip")+                 : requestHeaders+    request = Blaze.toLazyByteString $ mconcat+            [ Blaze.fromByteString method+            , Blaze.fromByteString " "+            , Blaze.fromByteString $+                case S8.uncons path of+                    Just ('/', _) -> path+                    _ -> S8.cons '/' path+            , renderQS queryString+            , Blaze.fromByteString " HTTP/1.1\r\n"+            , mconcat $ flip map headers' $ \(k, v) -> mconcat+                [ Blaze.fromByteString $ W.ciOriginal k+                , Blaze.fromByteString ": "+                , Blaze.fromByteString v                 , Blaze.fromByteString "\r\n"-                , mconcat $ map Blaze.fromByteString-                          $ L.toChunks requestBody                 ]-        Right () <- run $ enumList 1 (L.toChunks request) $$ iter-        run $ enum $$ do-            ((_, sc, _), hs) <- catchParser "HTTP headers" iterHeaders-            let hs' = map (first $ S8.map toLower) hs-            let mcl = lookup "content-length" hs'-            let body' x =-                    if ("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 decompress x =-                    if ("content-encoding", "gzip") `elem` hs'-                        then joinI $ ungzip $$ x-                        else x-            if method == "HEAD"-                then enumEOF $$ bodyIter sc hs-                else body' $ decompress $ bodyIter sc hs+            , Blaze.fromByteString "\r\n"+            , mconcat $ map Blaze.fromByteString+                      $ L.toChunks requestBody+            ]+    go = do+        ((_, sc, sm), hs) <- catchParser "HTTP headers" iterHeaders+        let s = W.Status sc sm+        let hs' = map (first W.mkCIByteString) hs+        let mcl = lookup "content-length" hs'+        let body' x =+                if ("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 decompress x =+                if ("content-encoding", "gzip") `elem` hs'+                    then joinI $ ungzip x+                    else returnI x+        if method == "HEAD"+            then bodyStep s hs'+            else body' $ decompress $$ bodyStep s hs'  chunkedEnumeratee :: MonadIO m => Enumeratee S.ByteString S.ByteString m a chunkedEnumeratee k@(Continue _) = do@@ -468,8 +467,11 @@ -- /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.-lbsIter :: Monad m => Int -> Headers -> Iteratee S.ByteString m Response-lbsIter sc hs = fmap (Response sc hs . L.fromChunks) consume+lbsIter :: Monad m => W.Status -> W.ResponseHeaders+        -> Iteratee S.ByteString m Response+lbsIter (W.Status sc _) hs = do+    lbs <- fmap L.fromChunks consume+    return $ Response sc hs lbs  -- | Download the specified 'Request', returning the results as a 'Response'. --@@ -483,7 +485,7 @@ -- Please see 'lbsIter' for more information on how the 'Response' value is -- created. httpLbs :: MonadIO m => Request -> m Response-httpLbs = http lbsIter+httpLbs req = run_ $ http req $ lbsIter  -- | Download the specified URL, following any redirects, and return the -- response body.@@ -510,16 +512,16 @@ -- location header. httpRedirect     :: (MonadIO m, Failure HttpException m)-    => (Int -> Headers -> Iteratee S.ByteString m a)-    -> Request-    -> m a-httpRedirect iter req =-    http (iter' (10 :: Int)) req+    => Request+    -> (W.Status -> W.ResponseHeaders -> Iteratee S.ByteString m a)+    -> Iteratee S.ByteString m a+httpRedirect req bodyStep =+    http req $ iter' (10 :: Int)   where-    iter' redirects code hs+    iter' redirects s@(W.Status code _) hs         | 300 <= code && code < 400 =-            case lookup "location" $ map (first $ S8.map toLower) hs of-                Just l'' -> lift $ do+            case lookup "location" hs of+                Just l'' -> do                     -- Prepend scheme, host and port if missing                     let l' =                             case S8.uncons l'' of@@ -533,7 +535,7 @@                                     , S8.unpack l''                                     ]                                 _ -> S8.unpack l''-                    l <- parseUrl l'+                    l <- lift $ parseUrl l'                     let req' = req                             { host = host l                             , port = port l@@ -542,10 +544,10 @@                             , queryString = queryString l                             }                     if redirects == 0-                        then failure TooManyRedirects-                        else http (iter' $ redirects - 1) req'-                Nothing -> iter code hs-        | otherwise = iter code hs+                        then lift $ failure TooManyRedirects+                        else (http req') $ (iter' $ redirects - 1)+                Nothing -> bodyStep s hs+        | otherwise = bodyStep s hs  -- | Download the specified 'Request', returning the results as a 'Response' -- and automatically handling redirects.@@ -560,7 +562,7 @@ -- Please see 'lbsIter' for more information on how the 'Response' value is -- created. httpLbsRedirect :: (MonadIO m, Failure HttpException m) => Request -> m Response-httpLbsRedirect = httpRedirect lbsIter+httpLbsRedirect req = run_ $ httpRedirect req $ lbsIter  readMay :: Read a => String -> Maybe a readMay s = case reads s of@@ -571,7 +573,7 @@ -- -- This sets a new 'requestBody', adds a content-type request header and -- changes the 'method' to POST.-urlEncodedBody :: Headers -> Request -> Request+urlEncodedBody :: [(S.ByteString, S.ByteString)] -> Request -> Request urlEncodedBody headers req = req     { requestBody = body     , method = "POST"

@@ -6,7 +6,9 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified Data.Enumerator as E+import Data.Enumerator (($$)) import qualified Control.Monad.IO.Class as Trans+import Control.Monad.Trans.Class (lift)  import Network.TLS.Client import Network.TLS.SRandom@@ -28,9 +30,9 @@ clientEnumSimple     :: Trans.MonadIO m     => Handle-    -> (E.Iteratee B.ByteString m () -> E.Enumerator B.ByteString m a -> m b)-    -> m b-clientEnumSimple h f = do+    -> E.Enumerator B.ByteString m () -- ^ request+    -> E.Enumerator B.ByteString m a -- ^ response+clientEnumSimple h req step = do     let clientstate = TLSClientParams             { cpConnectVersion = TLS10             , cpAllowedVersions = [ TLS10, TLS11 ]@@ -43,7 +45,7 @@             }     esrand <- Trans.liftIO makeSRandomGen     let srand = either (error . show) id esrand-    clientEnum clientstate srand h f+    clientEnum clientstate srand h req step   where     ciphers =         [ cipher_AES128_SHA1@@ -54,14 +56,15 @@  clientEnum :: Trans.MonadIO m            => TLSClientParams -> SRandomGen -> Handle-           -> (E.Iteratee B.ByteString m () -> E.Enumerator B.ByteString m a -> m b)-           -> m b-clientEnum tcp srg h f = do+           -> E.Enumerator B.ByteString m ()+           -> E.Enumerator B.ByteString m a+clientEnum tcp srg h req step0 = do     istate <- Trans.liftIO $ newIState tcp srg     tlsHelper istate $ connect h-    b <- f (iter istate) (enum istate)+    lift $ E.run_ $ req $$ iter istate+    res <- enum istate step0     tlsHelper istate $ close h-    return b+    return res   where     iter :: Trans.MonadIO m => IState -> E.Iteratee B.ByteString m ()     iter istate =

@@ -1,5 +1,5 @@ name:            http-enumerator-version:         0.2.1.5+version:         0.3.0 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -30,8 +30,9 @@                  , attoparsec            >= 0.8.0.2 && < 0.9                  , attoparsec-enumerator >= 0.2     && < 0.3                  , utf8-string           >= 0.3.4   && < 0.4-                 , blaze-builder         >= 0.2.1.0 && < 0.3+                 , blaze-builder         >= 0.2.1   && < 0.3                  , zlib-bindings         >= 0.0.0   && < 0.1+                 , wai                   >= 0.3     && < 0.4     if flag(network-bytestring)         build-depends: network               >= 2.2.1   && < 2.2.3                      , network-bytestring    >= 0.1.3   && < 0.1.4

@@ -5,6 +5,7 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import System.Environment.UTF8 (getArgs)+import Network.Wai (ciOriginal)  main :: IO () main = withSocketsDo $ withHttpEnumerator $ do@@ -14,13 +15,13 @@                 [ ("foo", "bar")                 , ("baz%%38**.8fn", "bin")                 ] _req2-    Response sc hs b <- httpLbsRedirect req+    Response sc hs b <- httpLbsRedirect _req2 #if DEBUG     return () #else     print sc     mapM_ (\(x, y) -> do-        S.putStr x+        S.putStr $ ciOriginal x         putStr ": "         S.putStr y         putStrLn "") hs