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