1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
{-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.Client.RequestBodySpec where
import Control.Monad
import Test.Hspec
import Control.Exception
import System.IO
import Data.IORef
import qualified Data.ByteString as BS
import Network.HTTP.Client (streamFile, parseUrlThrow, requestBody)
import Network.HTTP.Client.Internal (dummyConnection, connectionWrite, requestBuilder)
import System.Directory (getTemporaryDirectory)
spec :: Spec
spec = describe "streamFile" $ it "works" $ withTmpFile $ \(path, h) -> do
replicateM_ 5000 $ BS.hPut h "Hello, world!\r\n"
hClose h
withBinaryFile path ReadMode $ \h' -> do
conn <- verifyFileConnection h'
req0 <- parseUrlThrow "http://example.com"
body <- streamFile path
let req = req0 { requestBody = body }
_ <- requestBuilder req conn
hIsEOF h' `shouldReturn` True
where
withTmpFile = bracket getTmpFile closeTmpFile
getTmpFile = do
tmp <- getTemporaryDirectory
openBinaryTempFile tmp "request-body-stream-file"
closeTmpFile (_, h) = hClose h
firstReadBS = "GET / HTTP/1.1\r\nHost: example.com\r\nAccept-Encoding: gzip\r\nContent-Length: 75000\r\n\r\n"
verifyFileConnection h = do
(conn, _, _) <- dummyConnection []
isFirstReadRef <- newIORef True
return conn
{ connectionWrite = \bs -> do
isFirstRead <- readIORef isFirstReadRef
if isFirstRead
then do
bs `shouldBe` firstReadBS
writeIORef isFirstReadRef False
else do
bs' <- BS.hGet h (BS.length bs)
bs `shouldBe` bs'
}
|
