http-client 0.2.3 → 0.2.3.1

raw patch · 3 files changed

+45/−13 lines, 3 filesdep +async

Dependencies added: async

Files

• Network/HTTP/Client/Core.hs +3/−11
• http-client.cabal +2/−1
• test/Network/HTTP/ClientSpec.hs +40/−1

@@ -180,29 +180,21 @@      -> IO (Response BodyReader) httpRedirect count0 http' req0 = go count0 req0 []   where-    go (-1) _ ress = throwIO . TooManyRedirects =<< mapM lbsResponse ress+    go count _ ress | count < 0 = throwIO $ TooManyRedirects ress     go count req' ress = do         (res, mreq) <- http' req'         case mreq of             Just req -> do-                {- FIXME                 -- Allow the original connection to return to the                 -- connection pool immediately by flushing the body.                 -- If the response body is too large, don't flush, but                 -- instead just close the connection.                 let maxFlush = 1024-                    readMay bs =-                        case S8.readInt bs of-                            Just (i, bs') | S.null bs' -> Just i-                            _ -> Nothing-                case lookup "content-length" (responseHeaders res) >>= readMay of-                    Just i | i > maxFlush -> return ()-                    _ -> void $ brReadSome (responseBody res) maxFlush-                -}+                lbs <- brReadSome (responseBody res) maxFlush                 responseClose res                  -- And now perform the actual redirect-                go (count - 1) req (res:ress)+                go (count - 1) req (res { responseBody = lbs }:ress)             Nothing -> return res  -- | Close any open resources associated with the given @Response@. In general,

@@ -1,5 +1,5 @@ name:                http-client-version:             0.2.3+version:             0.2.3.1 synopsis:            An HTTP client engine, intended as a base layer for more user-friendly packages. description:         This codebase has been refactored from http-conduit. homepage:            https://github.com/snoyberg/http-client@@ -71,3 +71,4 @@                      , failure                      , base64-bytestring                      , zlib+                     , async

@@ -1,13 +1,36 @@ {-# LANGUAGE OverloadedStrings #-} module Network.HTTP.ClientSpec where +import           Control.Concurrent        (forkIO, threadDelay)+import           Control.Concurrent.Async  (withAsync)+import           Control.Exception         (bracket)+import           Control.Monad             (forever, replicateM_)+import           Network                   (PortID (PortNumber), listenOn) import           Network.HTTP.Client-import           Network.HTTP.Types (status200)+import           Network.HTTP.Types        (status200)+import           Network.Socket            (accept, sClose)+import           Network.Socket.ByteString (recv, sendAll) import           Test.Hspec  main :: IO () main = hspec spec +redirectServer :: (Int -> IO a) -> IO a+redirectServer inner = do+    let port = 23456+    bracket (listenOn $ PortNumber $ fromIntegral port) sClose $ \listener -> do+        withAsync (forker listener) $ \_ -> inner port+  where+    forker listener = forever $ do+        (socket, _) <- accept listener+        _ <- forkIO $ forever $ do+            sendAll socket "HTTP/1.1 301 Redirect\r\nLocation: /\r\ncontent-length: 5\r\n\r\n"+            threadDelay 10000+            sendAll socket "hello\r\n"+            threadDelay 10000+        _ <- forkIO $ forever $ recv socket 4096+        return ()+ spec :: Spec spec = describe "Client" $ do     it "works" $ do@@ -25,3 +48,19 @@                         _ -> False                 return ()         mapM_ test ["http://", "https://", "http://:8000", "https://:8001"]+    it "redirecting #41" $ redirectServer $ \port -> do+        req' <- parseUrl $ "http://127.0.0.1:" ++ show port+        let req = req' { redirectCount = 1 }+        withManager defaultManagerSettings $ \man -> replicateM_ 10 $ do+            httpLbs req man `shouldThrow` \e ->+                case e of+                    TooManyRedirects _ -> True+                    _ -> False+    it "redirectCount=0" $ redirectServer $ \port -> do+        req' <- parseUrl $ "http://127.0.0.1:" ++ show port+        let req = req' { redirectCount = 0 }+        withManager defaultManagerSettings $ \man -> replicateM_ 10 $ do+            httpLbs req man `shouldThrow` \e ->+                case e of+                    StatusCodeException{} -> True+                    _ -> False