on wai-app-static/1.3.2.1 help sign in
typeable/wai/warp/test/PartialFileSpec.hs
82 lines 2.9 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2module PartialFileSpec (main, spec) where
4import Network.Wai.Handler.Warp.Conduit
5import Data.Conduit
6import qualified Data.Conduit.List as CL
7import Test.Hspec
8import qualified Data.IORef as I
9import qualified Data.ByteString as S
10import qualified Data.ByteString.Char8 as S8
11import Control.Monad.Trans.Class (lift)
12import RunSpec (withApp)
13import Network.HTTP.Types (status200)
14import Network.Wai
15import System.IO (hClose, hFlush)
16import Network (connectTo, PortID (PortNumber))
17import Network.Wai.Handler.Warp
18import Data.Maybe (mapMaybe)
19import Control.Concurrent (threadDelay)
21main :: IO ()
22main = hspec spec
24testRange :: S.ByteString -- ^ range value
25 -> String -- ^ expected output
26 -> String -- ^ expected content-range value
27 -> Spec
28testRange range out crange = it title $ withApp defaultSettings app $ \port -> do
29 handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
30 S.hPutStr handle "GET / HTTP/1.0\r\n"
31 S.hPutStr handle "Range: bytes="
32 S.hPutStr handle range
33 S.hPutStr handle "\r\n\r\n"
34 hFlush handle
35 threadDelay 10000
36 bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ S.hGetSome handle 1024
37 hClose handle
38 out `shouldBe` last bss
39 let hs = mapMaybe toHeader bss
40 lookup "Content-Range" hs `shouldBe` Just ("bytes " ++ crange)
41 lookup "Content-Length" hs `shouldBe` Just (show $ length $ last bss)
42 where
43 app _ = return $ ResponseFile status200 [] "attic/hex" Nothing
44 title = show (range, out, crange)
45 toHeader s =
46 case break (== ':') s of
47 (x, ':':y) -> Just (x, dropWhile (== ' ') y)
48 _ -> Nothing
50testPartial :: Integer -- ^ offset
51 -> Integer -- ^ byte count
52 -> String -- ^ expected output
53 -> Spec
54testPartial offset count out = it title $ withApp defaultSettings app $ \port -> do
55 handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
56 S.hPutStr handle "GET / HTTP/1.0\r\n\r\n"
57 hFlush handle
58 threadDelay 10000
59 bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ S.hGetSome handle 1024
60 hClose handle
61 out `shouldBe` last bss
62 let hs = mapMaybe toHeader bss
63 lookup "Content-Length" hs `shouldBe` Just (show $ length $ last bss)
64 where
65 app _ = return $ ResponseFile status200 [] "attic/hex" $ Just $ FilePart offset count
66 title = show (offset, count, out)
67 toHeader s =
68 case break (== ':') s of
69 (x, ':':y) -> Just (x, dropWhile (== ' ') y)
70 _ -> Nothing
72spec :: Spec
73spec = do
74 describe "range requests" $ do
75 testRange "2-3" "23" "2-3/16"
76 testRange "5-" "56789abcdef" "5-15/16"
77 testRange "5-8" "5678" "5-8/16"
78 testRange "-3" "def" "13-15/16"
79 describe "partial files" $ do
80 testPartial 2 2 "23"
81 testPartial 0 2 "01"
82 testPartial 3 8 "3456789a"