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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Snap.Test.Common where
import Blaze.ByteString.Builder
import Control.Exception (SomeException)
import Control.Monad
import Control.Monad.CatchIO
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Internal (c2w)
import Data.Monoid
import Network.Socket
import qualified Network.Socket.ByteString as N
import Prelude hiding (catch)
import Test.HUnit (assertFailure)
import Test.QuickCheck
import System.Timeout
import Snap.Internal.Iteratee.Debug ()
instance Arbitrary S.ByteString where
arbitrary = liftM (S.pack . map c2w) arbitrary
instance Arbitrary L.ByteString where
arbitrary = do
n <- choose(0,5)
chunks <- replicateM n arbitrary
return $! L.fromChunks chunks
expectException :: IO a -> IO ()
expectException m = do
e <- try m
case e of
Left (_::SomeException) -> return ()
Right _ -> assertFailure "expected exception, didn't get it"
expectExceptionBeforeTimeout :: IO a -- ^ action to run
-> Int -- ^ number of seconds to expect
-- exception by
-> IO Bool
expectExceptionBeforeTimeout act nsecs = do
x <- timeout (nsecs * (10::Int)^(6::Int)) f
case x of
Nothing -> return False
(Just y) -> return y
where
f = (act >> return False) `catch` \(e::SomeException) -> do
if show e == "<<timeout>>"
then return False
else return True
withSock :: Int -> (Socket -> IO a) -> IO a
withSock port go = do
addr <- liftM (addrAddress . Prelude.head) $
getAddrInfo (Just myHints)
(Just "127.0.0.1")
(Just $ show port)
sock <- socket AF_INET Stream defaultProtocol
connect sock addr
go sock `finally` sClose sock
where
myHints = defaultHints { addrFlags = [ AI_NUMERICHOST ] }
recvAll :: Socket -> IO ByteString
recvAll sock = do
b <- f mempty sock
return $! toByteString b
where
f b sk = do
s <- N.recv sk 100000
if S.null s
then return b
else f (b `mappend` fromByteString s) sk
ditchHeaders :: [ByteString] -> [ByteString]
ditchHeaders ("":xs) = xs
ditchHeaders ("\r":xs) = xs
ditchHeaders (_:xs) = ditchHeaders xs
ditchHeaders [] = []
|
