http-client 0.4.6 → 0.4.6.1
raw patch · 14 files changed
+401/−360 lines, 14 filesdep ~basedep ~base64-bytestringdep ~blaze-builder
Dependency ranges changed: base, base64-bytestring, blaze-builder, bytestring, case-insensitive, deepseq, http-types, network, streaming-commons, text, time
Files
- ChangeLog.md +4/−0
- README.md +2/−0
- http-client.cabal +28/−2
- test-nonet/Network/HTTP/Client/BodySpec.hs +94/−0
- test-nonet/Network/HTTP/Client/HeadersSpec.hs +27/−0
- test-nonet/Network/HTTP/Client/RequestSpec.hs +28/−0
- test-nonet/Network/HTTP/Client/ResponseSpec.hs +87/−0
- test-nonet/Network/HTTP/ClientSpec.hs +128/−0
- test-nonet/Spec.hs +1/−0
- test/Network/HTTP/Client/BodySpec.hs +0/−94
- test/Network/HTTP/Client/HeadersSpec.hs +0/−28
- test/Network/HTTP/Client/RequestSpec.hs +0/−28
- test/Network/HTTP/Client/ResponseSpec.hs +0/−87
- test/Network/HTTP/ClientSpec.hs +2/−121
ChangeLog.md view
@@ -1,3 +1,7 @@+## 0.4.6.1++Separate tests not requiring internet access. [#93](https://github.com/snoyberg/http-client/pull/93)+ ## 0.4.6 Add `onRequestBodyException` to `Request` to allow for recovering from
README.md view
@@ -2,3 +2,5 @@ =========== An HTTP client engine, intended as a base layer for more user-friendly packages.++This codebase has been refactored from [http-conduit](http://www.stackage.org/package/http-conduit).
http-client.cabal view
@@ -1,7 +1,7 @@ name: http-client-version: 0.4.6+version: 0.4.6.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.+description: Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/http-client>. homepage: https://github.com/snoyberg/http-client license: MIT license-file: LICENSE@@ -62,6 +62,32 @@ main-is: Spec.hs type: exitcode-stdio-1.0 hs-source-dirs: test+ default-language: Haskell2010+ other-modules: Network.HTTP.ClientSpec+ build-depends: base+ , http-client+ , hspec+ , monad-control+ , bytestring+ , text+ , http-types+ , blaze-builder+ , time+ , network+ , containers+ , transformers+ , deepseq+ , case-insensitive+ , base64-bytestring+ , zlib+ , async+ , streaming-commons >= 0.1.1+++test-suite spec-nonet+ main-is: Spec.hs+ type: exitcode-stdio-1.0+ hs-source-dirs: test-nonet default-language: Haskell2010 other-modules: Network.HTTP.ClientSpec Network.HTTP.Client.ResponseSpec
+ test-nonet/Network/HTTP/Client/BodySpec.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.HTTP.Client.BodySpec where++import Test.Hspec+import Network.HTTP.Client+import Network.HTTP.Client.Internal+import qualified Data.ByteString as S+import Codec.Compression.GZip (compress)+import qualified Data.ByteString.Lazy as L++main :: IO ()+main = hspec spec++brComplete :: BodyReader -> IO Bool+brComplete brRead = do+ xs <- brRead+ return (xs == "")++spec :: Spec+spec = describe "BodySpec" $ do+ it "chunked, single" $ do+ (conn, _, input) <- dummyConnection+ [ "5\r\nhello\r\n6\r\n world\r\n0\r\nnot consumed"+ ]+ reader <- makeChunkedReader False conn+ body <- brConsume reader+ S.concat body `shouldBe` "hello world"+ input' <- input+ S.concat input' `shouldBe` "not consumed"+ brComplete reader `shouldReturn` True++ it "chunked, pieces" $ do+ (conn, _, input) <- dummyConnection $ map S.singleton $ S.unpack+ "5\r\nhello\r\n6\r\n world\r\n0\r\nnot consumed"+ reader <- makeChunkedReader False conn+ body <- brConsume reader+ S.concat body `shouldBe` "hello world"+ input' <- input+ S.concat input' `shouldBe` "not consumed"+ brComplete reader `shouldReturn` 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+ 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"+ brComplete reader `shouldReturn` 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+ 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"+ brComplete reader `shouldReturn` True++ it "length, single" $ do+ (conn, _, input) <- dummyConnection+ [ "hello world done"+ ]+ reader <- makeLengthReader 11 conn+ body <- brConsume reader+ S.concat body `shouldBe` "hello world"+ input' <- input+ S.concat input' `shouldBe` " done"+ brComplete reader `shouldReturn` True++ it "length, pieces" $ do+ (conn, _, input) <- dummyConnection $ map S.singleton $ S.unpack+ "hello world done"+ reader <- makeLengthReader 11 conn+ body <- brConsume reader+ S.concat body `shouldBe` "hello world"+ input' <- input+ S.concat input' `shouldBe` " done"+ brComplete reader `shouldReturn` True++ it "gzip" $ do+ let orig = L.fromChunks $ replicate 5000 "Hello world!"+ origZ = compress orig+ (conn, _, input) <- dummyConnection $ L.toChunks origZ ++ ["ignored"]+ reader' <- makeLengthReader (fromIntegral $ L.length origZ) conn+ reader <- makeGzipReader reader'+ body <- brConsume reader+ L.fromChunks body `shouldBe` orig+ input' <- input+ S.concat input' `shouldBe` "ignored"+ brComplete reader `shouldReturn` True
+ test-nonet/Network/HTTP/Client/HeadersSpec.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.HTTP.Client.HeadersSpec where++import Network.HTTP.Client.Internal+import Network.HTTP.Types+import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec = describe "HeadersSpec" $ do+ it "simple response" $ do+ let input =+ [ "HTTP/"+ , "1.1 200"+ , " OK\r\nfoo"+ , ": bar\r\n"+ , "baz:bin\r\n\r"+ , "\nignored"+ ]+ (connection, _, _) <- dummyConnection input+ statusHeaders <- parseStatusHeaders connection+ statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1)+ [ ("foo", "bar")+ , ("baz", "bin")+ ]
+ test-nonet/Network/HTTP/Client/RequestSpec.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.HTTP.Client.RequestSpec where++import Control.Applicative ((<$>))+import Control.Monad (join)+import Data.Maybe (isJust)+import Test.Hspec+import Network.HTTP.Client (parseUrl, requestHeaders, applyBasicProxyAuth)+import Control.Monad (forM_)++spec :: Spec+spec = do+ describe "case insensitive scheme" $ do+ forM_ ["http://example.com", "httP://example.com", "HttP://example.com", "HttPs://example.com"] $ \url ->+ it url $ case parseUrl url of+ Nothing -> error "failed"+ Just _ -> return () :: IO ()+ forM_ ["ftp://example.com"] $ \url ->+ it url $ case parseUrl url of+ Nothing -> return () :: IO ()+ Just req -> error $ show req+ describe "applyBasicProxyAuth" $ do+ let request = applyBasicProxyAuth "user" "pass" <$> parseUrl "http://example.org"+ field = join $ lookup "Proxy-Authorization" . requestHeaders <$> request+ it "Should add a proxy-authorization header" $ do+ field `shouldSatisfy` isJust+ it "Should add a proxy-authorization header with the specified username and password." $ do+ field `shouldBe` Just "Basic dXNlcjpwYXNz"
+ test-nonet/Network/HTTP/Client/ResponseSpec.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+module Network.HTTP.Client.ResponseSpec where++import Test.Hspec+import Network.HTTP.Client+import Network.HTTP.Client.Internal+import Network.HTTP.Types+import Codec.Compression.GZip (compress)+import qualified Data.ByteString.Lazy as L+import Data.ByteString.Lazy.Char8 ()+import qualified Data.ByteString as S++main :: IO ()+main = hspec spec++spec :: Spec+spec = describe "ResponseSpec" $ do+ let getResponse' conn = getResponse (const $ return ()) Nothing req conn+ Just req = parseUrl "http://localhost"+ it "basic" $ do+ (conn, _, _) <- dummyConnection+ [ "HTTP/1.1 200 OK\r\n"+ , "Key1: Value1\r\n"+ , "Content-length: 11\r\n\r\n"+ , "Hello"+ , " W"+ , "orld\r\nHTTP/1.1"+ ]+ Response {..} <- getResponse' conn+ responseStatus `shouldBe` status200+ responseVersion `shouldBe` HttpVersion 1 1+ responseHeaders `shouldBe`+ [ ("Key1", "Value1")+ , ("Content-length", "11")+ ]+ pieces <- brConsume responseBody+ pieces `shouldBe` ["Hello", " W", "orld"]+ it "no length" $ do+ (conn, _, _) <- dummyConnection+ [ "HTTP/1.1 200 OK\r\n"+ , "Key1: Value1\r\n\r\n"+ , "Hello"+ , " W"+ , "orld\r\nHTTP/1.1"+ ]+ Response {..} <- getResponse' conn+ responseStatus `shouldBe` status200+ responseVersion `shouldBe` HttpVersion 1 1+ responseHeaders `shouldBe`+ [ ("Key1", "Value1")+ ]+ pieces <- brConsume responseBody+ pieces `shouldBe` ["Hello", " W", "orld\r\nHTTP/1.1"]+ it "chunked" $ do+ (conn, _, _) <- dummyConnection+ [ "HTTP/1.1 200 OK\r\n"+ , "Key1: Value1\r\n"+ , "Transfer-encoding: chunked\r\n\r\n"+ , "5\r\nHello\r"+ , "\n2\r\n W"+ , "\r\n4 ignored\r\norld\r\n0\r\nHTTP/1.1"+ ]+ Response {..} <- getResponse' conn+ responseStatus `shouldBe` status200+ responseVersion `shouldBe` HttpVersion 1 1+ responseHeaders `shouldBe`+ [ ("Key1", "Value1")+ , ("Transfer-encoding", "chunked")+ ]+ pieces <- brConsume responseBody+ pieces `shouldBe` ["Hello", " W", "orld"]+ it "gzip" $ do+ (conn, _, _) <- dummyConnection+ $ "HTTP/1.1 200 OK\r\n"+ : "Key1: Value1\r\n"+ : "Content-Encoding: gzip\r\n\r\n"+ : L.toChunks (compress "Compressed Hello World")+ Response {..} <- getResponse' conn+ responseStatus `shouldBe` status200+ responseVersion `shouldBe` HttpVersion 1 1+ responseHeaders `shouldBe`+ [ ("Key1", "Value1")+ , ("Content-Encoding", "gzip")+ ]+ pieces <- brConsume responseBody+ S.concat pieces `shouldBe` "Compressed Hello World"
+ test-nonet/Network/HTTP/ClientSpec.hs view
@@ -0,0 +1,128 @@+{-# 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.HTTP.Client+import Network.HTTP.Types (status413)+import Network.Socket (sClose)+import Test.Hspec+import qualified Data.Streaming.Network as N+import qualified Data.ByteString as S+import Data.ByteString.Lazy.Char8 () -- orphan instance++main :: IO ()+main = hspec spec++redirectServer :: (Int -> IO a) -> IO a+redirectServer inner = bracket+ (N.bindRandomPortTCP "*4")+ (sClose . snd)+ $ \(port, lsocket) -> withAsync+ (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app)+ (const $ inner port)+ where+ 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+ N.appWrite ad "hello\r\n"+ threadDelay 10000++bad100Server :: Bool -- ^ include extra headers?+ -> (Int -> IO a) -> IO a+bad100Server extraHeaders inner = bracket+ (N.bindRandomPortTCP "*4")+ (sClose . snd)+ $ \(port, lsocket) -> withAsync+ (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app)+ (const $ inner port)+ where+ app ad = do+ forkIO $ forever $ N.appRead ad+ forever $ do+ N.appWrite ad $ S.concat+ [ "HTTP/1.1 100 Continue\r\n"+ , if extraHeaders then "foo:bar\r\nbaz: bin\r\n" else ""+ , "\r\nHTTP/1.1 200 OK\r\ncontent-length: 5\r\n\r\nhello\r\n"+ ]+ threadDelay 10000++earlyClose413 :: (Int -> IO a) -> IO a+earlyClose413 inner = bracket+ (N.bindRandomPortTCP "*4")+ (sClose . snd)+ $ \(port, lsocket) -> withAsync+ (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app)+ (const $ inner port)+ where+ app ad = do+ let readHeaders front = do+ newBS <- N.appRead ad+ let bs = S.append front newBS+ if "\r\n\r\n" `S.isInfixOf` bs+ then return ()+ else readHeaders bs+ readHeaders S.empty+ N.appWrite ad "HTTP/1.1 413 Too Large\r\ncontent-length: 7\r\n\r\ngoodbye"++spec :: Spec+spec = describe "Client" $ do+ describe "fails on empty hostnames #40" $ do+ let test url = it url $ do+ req <- parseUrl url+ man <- newManager defaultManagerSettings+ _ <- httpLbs req man `shouldThrow` \e ->+ case e of+ InvalidDestinationHost "" -> True+ _ -> 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+ 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++ describe "extra headers after 100 #49" $ do+ let test x = it (show x) $ bad100Server x $ \port -> do+ req <- parseUrl $ "http://127.0.0.1:" ++ show port+ withManager defaultManagerSettings $ \man -> replicateM_ 10 $ do+ x <- httpLbs req man+ responseBody x `shouldBe` "hello"+ test False+ test True++ it "early close on a 413" $ earlyClose413 $ \port' -> do+ withManager defaultManagerSettings $ \man -> do+ res <- flip httpLbs man "http://localhost"+ { port = port'+ , checkStatus = \_ _ _ -> Nothing+ , requestBody = RequestBodyStreamChunked+ ($ return (S.replicate 100000 65))+ }+ responseBody res `shouldBe` "goodbye"+ responseStatus res `shouldBe` status413
+ test-nonet/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
− test/Network/HTTP/Client/BodySpec.hs
@@ -1,94 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Network.HTTP.Client.BodySpec where--import Test.Hspec-import Network.HTTP.Client-import Network.HTTP.Client.Internal-import qualified Data.ByteString as S-import Codec.Compression.GZip (compress)-import qualified Data.ByteString.Lazy as L--main :: IO ()-main = hspec spec--brComplete :: BodyReader -> IO Bool-brComplete brRead = do- xs <- brRead- return (xs == "")--spec :: Spec-spec = describe "BodySpec" $ do- it "chunked, single" $ do- (conn, _, input) <- dummyConnection- [ "5\r\nhello\r\n6\r\n world\r\n0\r\nnot consumed"- ]- reader <- makeChunkedReader False conn- body <- brConsume reader- S.concat body `shouldBe` "hello world"- input' <- input- S.concat input' `shouldBe` "not consumed"- brComplete reader `shouldReturn` True-- it "chunked, pieces" $ do- (conn, _, input) <- dummyConnection $ map S.singleton $ S.unpack- "5\r\nhello\r\n6\r\n world\r\n0\r\nnot consumed"- reader <- makeChunkedReader False conn- body <- brConsume reader- S.concat body `shouldBe` "hello world"- input' <- input- S.concat input' `shouldBe` "not consumed"- brComplete reader `shouldReturn` 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- 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"- brComplete reader `shouldReturn` 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- 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"- brComplete reader `shouldReturn` True-- it "length, single" $ do- (conn, _, input) <- dummyConnection- [ "hello world done"- ]- reader <- makeLengthReader 11 conn- body <- brConsume reader- S.concat body `shouldBe` "hello world"- input' <- input- S.concat input' `shouldBe` " done"- brComplete reader `shouldReturn` True-- it "length, pieces" $ do- (conn, _, input) <- dummyConnection $ map S.singleton $ S.unpack- "hello world done"- reader <- makeLengthReader 11 conn- body <- brConsume reader- S.concat body `shouldBe` "hello world"- input' <- input- S.concat input' `shouldBe` " done"- brComplete reader `shouldReturn` True-- it "gzip" $ do- let orig = L.fromChunks $ replicate 5000 "Hello world!"- origZ = compress orig- (conn, _, input) <- dummyConnection $ L.toChunks origZ ++ ["ignored"]- reader' <- makeLengthReader (fromIntegral $ L.length origZ) conn- reader <- makeGzipReader reader'- body <- brConsume reader- L.fromChunks body `shouldBe` orig- input' <- input- S.concat input' `shouldBe` "ignored"- brComplete reader `shouldReturn` True
− test/Network/HTTP/Client/HeadersSpec.hs
@@ -1,28 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Network.HTTP.Client.HeadersSpec where--import Network.HTTP.Client-import Network.HTTP.Client.Internal-import Network.HTTP.Types-import Test.Hspec--main :: IO ()-main = hspec spec--spec :: Spec-spec = describe "HeadersSpec" $ do- it "simple response" $ do- let input =- [ "HTTP/"- , "1.1 200"- , " OK\r\nfoo"- , ": bar\r\n"- , "baz:bin\r\n\r"- , "\nignored"- ]- (connection, getOutput, getInput) <- dummyConnection input- statusHeaders <- parseStatusHeaders connection- statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1)- [ ("foo", "bar")- , ("baz", "bin")- ]
− test/Network/HTTP/Client/RequestSpec.hs
@@ -1,28 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Network.HTTP.Client.RequestSpec where--import Control.Applicative ((<$>))-import Control.Monad (join)-import Data.Maybe (isJust)-import Test.Hspec-import Network.HTTP.Client (parseUrl, requestHeaders, applyBasicProxyAuth)-import Control.Monad (forM_)--spec :: Spec-spec = do- describe "case insensitive scheme" $ do- forM_ ["http://example.com", "httP://example.com", "HttP://example.com", "HttPs://example.com"] $ \url ->- it url $ case parseUrl url of- Nothing -> error "failed"- Just _ -> return () :: IO ()- forM_ ["ftp://example.com"] $ \url ->- it url $ case parseUrl url of- Nothing -> return () :: IO ()- Just req -> error $ show req- describe "applyBasicProxyAuth" $ do- let request = applyBasicProxyAuth "user" "pass" <$> parseUrl "http://example.org"- field = join $ lookup "Proxy-Authorization" . requestHeaders <$> request- it "Should add a proxy-authorization header" $ do- field `shouldSatisfy` isJust- it "Should add a proxy-authorization header with the specified username and password." $ do- field `shouldBe` Just "Basic dXNlcjpwYXNz"
− test/Network/HTTP/Client/ResponseSpec.hs
@@ -1,87 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-module Network.HTTP.Client.ResponseSpec where--import Test.Hspec-import Network.HTTP.Client-import Network.HTTP.Client.Internal-import Network.HTTP.Types-import Codec.Compression.GZip (compress)-import qualified Data.ByteString.Lazy as L-import Data.ByteString.Lazy.Char8 ()-import qualified Data.ByteString as S--main :: IO ()-main = hspec spec--spec :: Spec-spec = describe "ResponseSpec" $ do- let getResponse' conn = getResponse (const $ return ()) Nothing req conn- Just req = parseUrl "http://localhost"- it "basic" $ do- (conn, getOutput, getInput) <- dummyConnection- [ "HTTP/1.1 200 OK\r\n"- , "Key1: Value1\r\n"- , "Content-length: 11\r\n\r\n"- , "Hello"- , " W"- , "orld\r\nHTTP/1.1"- ]- Response {..} <- getResponse' conn- responseStatus `shouldBe` status200- responseVersion `shouldBe` HttpVersion 1 1- responseHeaders `shouldBe`- [ ("Key1", "Value1")- , ("Content-length", "11")- ]- pieces <- brConsume responseBody- pieces `shouldBe` ["Hello", " W", "orld"]- it "no length" $ do- (conn, getOutput, getInput) <- dummyConnection- [ "HTTP/1.1 200 OK\r\n"- , "Key1: Value1\r\n\r\n"- , "Hello"- , " W"- , "orld\r\nHTTP/1.1"- ]- Response {..} <- getResponse' conn- responseStatus `shouldBe` status200- responseVersion `shouldBe` HttpVersion 1 1- responseHeaders `shouldBe`- [ ("Key1", "Value1")- ]- pieces <- brConsume responseBody- pieces `shouldBe` ["Hello", " W", "orld\r\nHTTP/1.1"]- it "chunked" $ do- (conn, getOutput, getInput) <- dummyConnection- [ "HTTP/1.1 200 OK\r\n"- , "Key1: Value1\r\n"- , "Transfer-encoding: chunked\r\n\r\n"- , "5\r\nHello\r"- , "\n2\r\n W"- , "\r\n4 ignored\r\norld\r\n0\r\nHTTP/1.1"- ]- Response {..} <- getResponse' conn- responseStatus `shouldBe` status200- responseVersion `shouldBe` HttpVersion 1 1- responseHeaders `shouldBe`- [ ("Key1", "Value1")- , ("Transfer-encoding", "chunked")- ]- pieces <- brConsume responseBody- pieces `shouldBe` ["Hello", " W", "orld"]- it "gzip" $ do- (conn, getOutput, getInput) <- dummyConnection- $ "HTTP/1.1 200 OK\r\n"- : "Key1: Value1\r\n"- : "Content-Encoding: gzip\r\n\r\n"- : L.toChunks (compress "Compressed Hello World")- Response {..} <- getResponse' conn- responseStatus `shouldBe` status200- responseVersion `shouldBe` HttpVersion 1 1- responseHeaders `shouldBe`- [ ("Key1", "Value1")- , ("Content-Encoding", "gzip")- ]- pieces <- brConsume responseBody- S.concat pieces `shouldBe` "Compressed Hello World"
test/Network/HTTP/ClientSpec.hs view
@@ -1,79 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} module Network.HTTP.ClientSpec where -import Blaze.ByteString.Builder (fromByteString)-import Control.Concurrent (forkIO, threadDelay)-import Control.Concurrent.Async (withAsync)-import Control.Exception (bracket)-import Control.Monad (forever, replicateM_)-import Data.Monoid (mappend)-import Network (PortID (PortNumber), listenOn, withSocketsDo)+import Network (withSocketsDo) import Network.HTTP.Client-import Network.HTTP.Types (status200, status413)-import Network.Socket (accept, sClose)-import Network.Socket.ByteString (recv, sendAll)+import Network.HTTP.Types (status200) import Test.Hspec-import qualified Data.Streaming.Network as N-import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L import Data.ByteString.Lazy.Char8 () -- orphan instance main :: IO () main = hspec spec -redirectServer :: (Int -> IO a) -> IO a-redirectServer inner = bracket- (N.bindRandomPortTCP "*4")- (sClose . snd)- $ \(port, lsocket) -> withAsync- (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app)- (const $ inner port)- where- 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- N.appWrite ad "hello\r\n"- threadDelay 10000--bad100Server :: Bool -- ^ include extra headers?- -> (Int -> IO a) -> IO a-bad100Server extraHeaders inner = bracket- (N.bindRandomPortTCP "*4")- (sClose . snd)- $ \(port, lsocket) -> withAsync- (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app)- (const $ inner port)- where- app ad = do- forkIO $ forever $ N.appRead ad- forever $ do- N.appWrite ad $ S.concat- [ "HTTP/1.1 100 Continue\r\n"- , if extraHeaders then "foo:bar\r\nbaz: bin\r\n" else ""- , "\r\nHTTP/1.1 200 OK\r\ncontent-length: 5\r\n\r\nhello\r\n"- ]- threadDelay 10000--earlyClose413 :: (Int -> IO a) -> IO a-earlyClose413 inner = bracket- (N.bindRandomPortTCP "*4")- (sClose . snd)- $ \(port, lsocket) -> withAsync- (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app)- (const $ inner port)- where- app ad = do- let readHeaders front = do- newBS <- N.appRead ad- let bs = S.append front newBS- if "\r\n\r\n" `S.isInfixOf` bs- then return ()- else readHeaders bs- readHeaders S.empty- N.appWrite ad "HTTP/1.1 413 Too Large\r\ncontent-length: 7\r\n\r\ngoodbye"- spec :: Spec spec = describe "Client" $ do it "works" $ withSocketsDo $ do@@ -81,65 +17,10 @@ man <- newManager defaultManagerSettings res <- httpLbs req man responseStatus res `shouldBe` status200- describe "fails on empty hostnames #40" $ do- let test url = it url $ do- req <- parseUrl url- man <- newManager defaultManagerSettings- _ <- httpLbs req man `shouldThrow` \e ->- case e of- InvalidDestinationHost "" -> True- _ -> 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- 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 - describe "extra headers after 100 #49" $ do- let test x = it (show x) $ bad100Server x $ \port -> do- req <- parseUrl $ "http://127.0.0.1:" ++ show port- withManager defaultManagerSettings $ \man -> replicateM_ 10 $ do- x <- httpLbs req man- responseBody x `shouldBe` "hello"- test False- test True- it "managerModifyRequest" $ do let modify req = return req { port = 80 } settings = defaultManagerSettings { managerModifyRequest = modify } withManager settings $ \man -> do res <- httpLbs "http://httpbin.org:1234" man responseStatus res `shouldBe` status200-- it "early close on a 413" $ earlyClose413 $ \port' -> do- withManager defaultManagerSettings $ \man -> do- res <- flip httpLbs man "http://localhost"- { port = port'- , checkStatus = \_ _ _ -> Nothing- , requestBody = RequestBodyStreamChunked- ($ return (S.replicate 100000 65))- }- responseBody res `shouldBe` "goodbye"- responseStatus res `shouldBe` status413