http-client 0.3.0.2 → 0.3.1
raw patch · 8 files changed
+85/−32 lines, 8 filesdep ~streaming-commons
Dependency ranges changed: streaming-commons
Files
- Network/HTTP/Client/Body.hs +20/−12
- Network/HTTP/Client/Core.hs +5/−0
- Network/HTTP/Client/Manager.hs +5/−1
- Network/HTTP/Client/Response.hs +4/−7
- Network/HTTP/Client/Types.hs +1/−0
- http-client.cabal +2/−1
- test/Network/HTTP/Client/BodySpec.hs +27/−0
- test/Network/HTTP/ClientSpec.hs +21/−11
Network/HTTP/Client/Body.hs view
@@ -132,10 +132,10 @@ , brComplete = fmap (== -1) $ readIORef icount } -makeChunkedReader :: Bool -- ^ send headers+makeChunkedReader :: Bool -- ^ raw -> Connection -> IO BodyReader-makeChunkedReader sendHeaders conn@Connection {..} = do+makeChunkedReader raw conn@Connection {..} = do icount <- newIORef 0 return $! BodyReader { brRead = go icount@@ -146,21 +146,25 @@ where go icount = do count0 <- readIORef icount- count <-+ (rawCount, count) <- if count0 == 0 then readHeader- else return count0+ else return (empty, count0) if count <= 0 then do writeIORef icount (-1)- return empty+ return $ if count /= (-1) && raw then rawCount else empty else do- (bs, count') <- sendChunk count+ (bs, count') <- readChunk count writeIORef icount count'- return bs+ return $ appendHeader rawCount bs - sendChunk 0 = return (empty, 0)- sendChunk remainder = do+ appendHeader+ | raw = S.append+ | otherwise = flip const++ readChunk 0 = return (empty, 0)+ readChunk remainder = do bs <- connectionRead when (S.null bs) $ throwIO InvalidChunkHeaders case compare remainder $ S.length bs of@@ -168,11 +172,15 @@ let (x, y) = S.splitAt remainder bs assert (not $ S.null y) $ connectionUnread y requireNewline- return (x, 0)+ done x EQ -> do requireNewline- return (bs, 0)+ done bs GT -> return (bs, remainder - S.length bs)+ where+ done x+ | raw = return (x `S.append` "\r\n", 0)+ | otherwise = return (x, 0) requireNewline = do bs <- connectionReadLine conn@@ -182,7 +190,7 @@ bs <- connectionReadLine conn case parseHex bs of Nothing -> throwIO InvalidChunkHeaders- Just hex -> return hex+ Just hex -> return (bs `S.append` "\r\n", hex) parseHex bs0 = case uncons bs0 of
Network/HTTP/Client/Core.hs view
@@ -130,6 +130,11 @@ -- This function automatically performs any necessary redirects, as specified -- by the 'redirectCount' setting. --+-- When implementing a (reverse) proxy using this function or relating+-- functions, it's wise to remove Transfer-Encoding:, Content-Length:,+-- Content-Encoding: and Accept-Encoding: from request and response+-- headers to be relayed.+-- -- Since 0.1.0 responseOpen :: Request -> Manager -> IO (Response BodyReader) responseOpen req0 manager = mWrapIOException manager $ do
Network/HTTP/Client/Manager.hs view
@@ -330,7 +330,7 @@ | S8.null h = throwIO $ InvalidDestinationHost h | otherwise = getManagedConn m (ConnKey connKeyHost connport (secure req)) $- go connaddr connhost connport+ wrapConnectExc $ go connaddr connhost connport where h = host req (useProxy, connhost, connport) = getConnDest req@@ -338,6 +338,10 @@ case (hostAddress req, useProxy) of (Just ha, False) -> (Just ha, HostAddress ha) _ -> (Nothing, HostName $ T.pack connhost)++ wrapConnectExc = handle $ \e ->+ throwIO $ FailedConnectionException2 connhost connport (secure req)+ (toException (e :: IOException)) go = case (secure req, useProxy) of (False, _) -> mRawConnection m
Network/HTTP/Client/Response.hs view
@@ -9,10 +9,9 @@ ) where import Control.Arrow (first)-import Control.Monad (liftM)+import Control.Monad (liftM, (>=>)) import Control.Exception (throwIO)-import Control.Monad.IO.Class (MonadIO, liftIO) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8@@ -97,11 +96,7 @@ let timeout' = case timeout'' of Nothing -> id- Just useconds -> \ma -> do- x <- timeout useconds ma- case x of- Nothing -> liftIO $ throwIO ResponseTimeout- Just y -> return y+ Just t -> timeout t >=> maybe responseTimeout return StatusHeaders s version hs <- timeout' $ parseStatusHeaders conn let mcl = lookup "content-length" hs >>= readDec . S8.unpack @@ -137,3 +132,5 @@ , responseCookieJar = def , responseClose' = ResponseClose (cleanup False) }+ where+ responseTimeout = throwIO ResponseTimeout
Network/HTTP/Client/Types.hs view
@@ -87,6 +87,7 @@ | OverlongHeaders | ResponseTimeout | FailedConnectionException String Int -- ^ host/port+ | FailedConnectionException2 String Int Bool SomeException -- ^ host/port/secure | ExpectedBlankAfter100Continue | InvalidStatusLine S.ByteString | InvalidHeader S.ByteString
http-client.cabal view
@@ -1,5 +1,5 @@ name: http-client-version: 0.3.0.2+version: 0.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@@ -76,3 +76,4 @@ , base64-bytestring , zlib , async+ , streaming-commons >= 0.1.1
test/Network/HTTP/Client/BodySpec.hs view
@@ -38,6 +38,33 @@ S.concat input' `shouldBe` "not consumed" complete2 <- brComplete reader complete2 `shouldBe` True+ it "chunked, raw" $ do+ (conn, _, input) <- dummyConnection+ [ "5\r\nhello\r\n6\r\n world\r\n0\r\nnot consumed"+ ]+ reader <- makeChunkedReader True conn+ complete1 <- brComplete reader+ complete1 `shouldBe` False+ body <- brConsume reader+ S.concat body `shouldBe` "5\r\nhello\r\n6\r\n world\r\n0\r\n"+ input' <- input+ S.concat input' `shouldBe` "not consumed"+ complete2 <- brComplete reader+ complete2 `shouldBe` True++ it "chunked, pieces, raw" $ do+ (conn, _, input) <- dummyConnection $ map S.singleton $ S.unpack+ "5\r\nhello\r\n6\r\n world\r\n0\r\nnot consumed"+ reader <- makeChunkedReader True conn+ complete1 <- brComplete reader+ complete1 `shouldBe` False+ body <- brConsume reader+ S.concat body `shouldBe` "5\r\nhello\r\n6\r\n world\r\n0\r\n"+ input' <- input+ S.concat input' `shouldBe` "not consumed"+ complete2 <- brComplete reader+ complete2 `shouldBe` True+ it "length, single" $ do (conn, _, input) <- dummyConnection [ "hello world done"
test/Network/HTTP/ClientSpec.hs view
@@ -11,25 +11,26 @@ import Network.Socket (accept, sClose) import Network.Socket.ByteString (recv, sendAll) import Test.Hspec+import qualified Data.Streaming.Network as N 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+redirectServer inner = bracket+ (N.bindRandomPortTCP "*4")+ (sClose . snd)+ $ \(port, lsocket) -> withAsync+ (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app)+ (const $ 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"+ app ad = do+ forkIO $ forever $ N.appRead ad+ forever $ do+ N.appWrite ad "HTTP/1.1 301 Redirect\r\nLocation: /\r\ncontent-length: 5\r\n\r\n" threadDelay 10000- sendAll socket "hello\r\n"+ N.appWrite ad "hello\r\n" threadDelay 10000- _ <- forkIO $ forever $ recv socket 4096- return () spec :: Spec spec = describe "Client" $ do@@ -63,4 +64,13 @@ httpLbs req man `shouldThrow` \e -> case e of StatusCodeException{} -> True+ _ -> False+ it "connecting to missing server gives nice error message" $ do+ (port, socket) <- N.bindRandomPortTCP "*4"+ sClose socket+ req <- parseUrl $ "http://127.0.0.1:" ++ show port+ withManager defaultManagerSettings $ \man ->+ httpLbs req man `shouldThrow` \e ->+ case e of+ FailedConnectionException2 "127.0.0.1" port' False _ -> port == port' _ -> False