on wai-extra/3.0.14.3 help sign in
typeable/wai/warp/test/SendFileSpec.hs
116 lines 4.3 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
3module SendFileSpec where
5import Control.Exception
6import Control.Monad (when)
7import Data.ByteString (ByteString)
8import qualified Data.ByteString as BS
9import Network.Wai.Handler.Warp.Buffer
10import Network.Wai.Handler.Warp.SendFile
11import Network.Wai.Handler.Warp.Types
12import System.Directory
13import System.Exit
14import qualified System.IO as IO
15import System.Process (system)
16import Test.Hspec
18main :: IO ()
19main = hspec spec
21spec :: Spec
22spec = do
23 describe "packHeader" $ do
24 it "returns how much the buffer is consumed (1)" $
25 tryPackHeader 10 ["foo"] `shouldReturn` 3
26 it "returns how much the buffer is consumed (2)" $
27 tryPackHeader 10 ["foo", "bar"] `shouldReturn` 6
28 it "returns how much the buffer is consumed (3)" $
29 tryPackHeader 10 ["0123456789"] `shouldReturn` 0
30 it "returns how much the buffer is consumed (4)" $
31 tryPackHeader 10 ["01234", "56789"] `shouldReturn` 0
32 it "returns how much the buffer is consumed (5)" $
33 tryPackHeader 10 ["01234567890", "12"] `shouldReturn` 3
34 it "returns how much the buffer is consumed (6)" $
35 tryPackHeader 10 ["012345678901234567890123456789012", "34"] `shouldReturn` 5
37 it "sends headers correctly (1)" $
38 tryPackHeader2 10 ["foo"] "" `shouldReturn` True
39 it "sends headers correctly (2)" $
40 tryPackHeader2 10 ["foo", "bar"] "" `shouldReturn` True
41 it "sends headers correctly (3)" $
42 tryPackHeader2 10 ["0123456789"] "0123456789" `shouldReturn` True
43 it "sends headers correctly (4)" $
44 tryPackHeader2 10 ["01234", "56789"] "0123456789" `shouldReturn` True
45 it "sends headers correctly (5)" $
46 tryPackHeader2 10 ["01234567890", "12"] "0123456789" `shouldReturn` True
47 it "sends headers correctly (6)" $
48 tryPackHeader2 10 ["012345678901234567890123456789012", "34"] "012345678901234567890123456789" `shouldReturn` True
50 describe "readSendFile" $ do
51 it "sends a file correctly (1)" $
52 tryReadSendFile 10 0 1474 ["foo"] `shouldReturn` ExitSuccess
53 it "sends a file correctly (2)" $
54 tryReadSendFile 10 0 1474 ["012345678", "901234"] `shouldReturn` ExitSuccess
55 it "sends a file correctly (3)" $
56 tryReadSendFile 10 20 100 ["012345678", "901234"] `shouldReturn` ExitSuccess
58tryPackHeader :: Int -> [ByteString] -> IO Int
59tryPackHeader siz hdrs = bracket (allocateBuffer siz) freeBuffer $ \buf ->
60 packHeader buf siz send hook hdrs 0
61 where
62 send _ = return ()
63 hook = return ()
65tryPackHeader2 :: Int -> [ByteString] -> ByteString -> IO Bool
66tryPackHeader2 siz hdrs ans = bracket setup teardown $ \buf -> do
67 _ <- packHeader buf siz send hook hdrs 0
68 checkFile outputFile ans
69 where
70 setup = allocateBuffer siz
71 teardown buf = freeBuffer buf >> removeFileIfExists outputFile
72 outputFile = "tempfile"
73 send = BS.appendFile outputFile
74 hook = return ()
76tryReadSendFile :: Int -> Integer -> Integer -> [ByteString] -> IO ExitCode
77tryReadSendFile siz off len hdrs = bracket setup teardown $ \buf -> do
78 mapM_ (BS.appendFile expectedFile) hdrs
79 copyfile inputFile expectedFile off len
80 readSendFile buf siz send fid off len hook hdrs
81 compareFiles expectedFile outputFile
82 where
83 hook = return ()
84 setup = allocateBuffer siz
85 teardown buf = do
86 freeBuffer buf
87 removeFileIfExists outputFile
88 removeFileIfExists expectedFile
89 inputFile = "test/inputFile"
90 outputFile = "outputFile"
91 expectedFile = "expectedFile"
92 fid = FileId inputFile Nothing
93 send = BS.appendFile outputFile
95checkFile :: FilePath -> ByteString -> IO Bool
96checkFile path bs = do
97 exist <- doesFileExist path
98 if exist then do
99 bs' <- BS.readFile path
100 return $ bs == bs'
101 else
102 return $ bs == ""
104compareFiles :: FilePath -> FilePath -> IO ExitCode
105compareFiles file1 file2 = system $ "cmp -s " ++ file1 ++ " " ++ file2
107copyfile :: FilePath -> FilePath -> Integer -> Integer -> IO ()
108copyfile src dst off len =
109 IO.withBinaryFile src IO.ReadMode $ \h -> do
110 IO.hSeek h IO.AbsoluteSeek off
111 BS.hGet h (fromIntegral len) >>= BS.appendFile dst
113removeFileIfExists :: FilePath -> IO ()
114removeFileIfExists file = do
115 exist <- doesFileExist file
116 when exist $ removeFile file