Add tests for 'requestBuilder'.

http-client/Network/HTTP/Client/Headers.hs

@@ -27,22 +27,22 @@ charPeriod = 46
 
 parseStatusHeaders :: Connection -> Maybe Int -> Maybe (IO ()) -> IO StatusHeaders
 parseStatusHeaders conn timeout' cont
-    | Just k <- cont = getStatusContinue k
-    | otherwise      = getStatusNoContinue
+    | Just k <- cont = getStatusExpectContinue k
+    | otherwise      = getStatus
   where
     withTimeout = case timeout' of
         Nothing -> id
         Just  t -> timeout t >=> maybe (throwIO ResponseTimeout) return
 
-    getStatusNoContinue = withTimeout next
+    getStatus = withTimeout next
       where
         next = nextStatusHeaders >>= maybe next return
 
-    getStatusContinue sendBody = do
+    getStatusExpectContinue sendBody = do
         status <- withTimeout nextStatusHeaders
         case status of
             Just  s -> return s
-            Nothing -> sendBody >> getStatusNoContinue
+            Nothing -> sendBody >> getStatus
 
     nextStatusHeaders = do
         (s, v) <- nextStatusLine

http-client/test-nonet/Network/HTTP/Client/RequestSpec.hs

@@ -1,28 +1,85 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Network.HTTP.Client.RequestSpec where
 
+import Blaze.ByteString.Builder (fromByteString)
 import Control.Applicative ((<$>))
-import Control.Monad (join)
-import Data.Maybe (isJust)
-import Test.Hspec
+import Control.Monad (join, forM_)
+import Data.IORef
+import Data.Maybe (isJust, fromMaybe)
 import Network.HTTP.Client (parseUrl, requestHeaders, applyBasicProxyAuth)
-import Control.Monad (forM_)
+import Network.HTTP.Client.Internal
+import Test.Hspec
 
 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"
+    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"
+
+    describe "requestBuilder" $ do
+        it "sends the full request, combining headers and body in the non-streaming case" $ do
+            let Just req  = parseUrl "http://localhost"
+            let      req' = req { method = "PUT", path = "foo" }
+            (conn, out, _) <- dummyConnection []
+            forM_ (bodies `zip` out1) $ \(b, o) -> do
+                cont <- requestBuilder (req' { requestBody = b } ) conn
+                (const "<IO ()>" <$> cont) `shouldBe` Nothing
+                out >>= (`shouldBe` o)
+
+        it "sends only headers and returns an action for the body on 'Expect: 100-continue'" $ do
+            let Just req  = parseUrl "http://localhost"
+            let      req' = req { requestHeaders = [("Expect", "100-continue")]
+                                , method = "PUT"
+                                , path = "foo"
+                                }
+            (conn, out, _) <- dummyConnection []
+            forM_ (bodies `zip` out2) $ \(b, (h, o)) -> do
+                cont <- requestBuilder (req' { requestBody = b } ) conn
+                out >>= (`shouldBe` [h, ""])
+                fromMaybe (return ()) cont
+                out >>= (`shouldBe` o)
+      where
+        bodies = [ RequestBodyBS "data"
+                 , RequestBodyLBS "data"
+                 , RequestBodyBuilder 4 (fromByteString "data")
+                 , RequestBodyStream 4 (popper ["data"] >>=)
+                 , RequestBodyStreamChunked (popper ["data"] >>=)
+                 ]
+
+        out1 = [ [nonChunked <> "\r\ndata"]
+               , [nonChunked <> "\r\ndata"]
+               , [nonChunked <> "\r\ndata"]
+               , [nonChunked <> "\r\n", "", "data"]
+               , [chunked <> "\r\n", "", "4\r\n","data","\r\n","0\r\n\r\n"]
+               ]
+
+        out2 = [ (nonChunked <> "Expect: 100-continue\r\n\r\n", ["data"])
+               , (nonChunked <> "Expect: 100-continue\r\n\r\n", ["data"])
+               , (nonChunked <> "Expect: 100-continue\r\n\r\n", ["data"])
+               , (nonChunked <> "Expect: 100-continue\r\n\r\n", ["data"])
+               , (chunked    <> "Expect: 100-continue\r\n\r\n", ["4\r\n","data","\r\n","0\r\n\r\n"])
+               ]
+
+        nonChunked = "PUT /foo HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\nContent-Length: 4\r\n"
+        chunked    = "PUT /foo HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\nTransfer-Encoding: chunked\r\n"
+
+        popper dat = do
+            r <- newIORef dat
+            return . atomicModifyIORef' r $ \xs ->
+                case xs of
+                    (x:xs') -> (xs', x)
+                    [] -> ([], "")