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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Snap.Internal.Http.Parser.Tests
( tests ) where
import qualified Control.Exception as E
import Control.Exception hiding (try, assert)
import Control.Monad
import Control.Parallel.Strategies
import Data.Attoparsec hiding (Result(..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Internal (c2w)
import Data.List
import qualified Data.Map as Map
import Data.Maybe (isNothing)
import Data.Monoid
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2
import Test.QuickCheck
import qualified Test.QuickCheck.Monadic as QC
import Test.QuickCheck.Monadic hiding (run, assert)
import Test.HUnit hiding (Test, path)
import Text.Printf
import Snap.Internal.Http.Parser
import Snap.Internal.Http.Types
import Snap.Internal.Debug
import Snap.Iteratee hiding (map, sequence)
import qualified Snap.Iteratee as I
import Snap.Test.Common()
tests :: [Test]
tests = [ testShow
, testCookie
, testChunked
, testP2I
, testNull
, testPartial
, testParseError
, testFormEncoded ]
emptyParser :: Parser ByteString
emptyParser = option "foo" $ string "bar"
testShow :: Test
testShow = testCase "parser/show" $ do
let i = IRequest GET "/" (1,1) []
let !b = show i `using` rdeepseq
return $ b `seq` ()
testP2I :: Test
testP2I = testCase "parser/iterParser" $ do
i <- liftM (enumBS "z") $ runIteratee (iterParser emptyParser)
l <- run_ i
assertEqual "should be foo" "foo" l
forceErr :: SomeException -> IO ()
forceErr e = f `seq` (return ())
where
!f = show e
testNull :: Test
testNull = testCase "parser/shortParse" $ do
f <- run_ (parseRequest)
assertBool "should be Nothing" $ isNothing f
testPartial :: Test
testPartial = testCase "parser/partial" $ do
i <- liftM (enumBS "GET / ") $ runIteratee parseRequest
f <- E.try $ run_ i
case f of (Left e) -> forceErr e
(Right x) -> assertFailure $ "expected exception, got " ++ show x
testParseError :: Test
testParseError = testCase "parser/error" $ do
step <- runIteratee parseRequest
let i = enumBS "ZZZZZZZZZZ" step
f <- E.try $ run_ i
case f of (Left e) -> forceErr e
(Right x) -> assertFailure $ "expected exception, got " ++ show x
-- | convert a bytestring to chunked transfer encoding
transferEncodingChunked :: L.ByteString -> L.ByteString
transferEncodingChunked = f . L.toChunks
where
toChunk s = L.concat [ len, "\r\n", L.fromChunks [s], "\r\n" ]
where
len = L.pack $ map c2w $ printf "%x" $ S.length s
f l = L.concat $ (map toChunk l ++ ["0\r\n\r\n"])
-- | ensure that running the 'readChunkedTransferEncoding' iteratee against
-- 'transferEncodingChunked' returns the original string
testChunked :: Test
testChunked = testProperty "parser/chunkedTransferEncoding" $
monadicIO $ forAllM arbitrary prop_chunked
where
prop_chunked s = do
QC.run $ debug "=============================="
QC.run $ debug $ "input is " ++ show s
QC.run $ debug $ "chunked is " ++ show chunked
QC.run $ debug "------------------------------"
sstep <- QC.run $ runIteratee $ stream2stream
step <- QC.run $ runIteratee $
joinI $ readChunkedTransferEncoding sstep
out <- QC.run $ run_ $ enum step
QC.assert $ s == out
QC.run $ debug "==============================\n"
where
chunked = (transferEncodingChunked s)
enum = enumLBS chunked
testCookie :: Test
testCookie =
testCase "parser/parseCookie" $ do
assertEqual "cookie parsing" (Just [cv]) cv2
where
cv = Cookie nm v Nothing Nothing Nothing False False
cv2 = parseCookie ct
nm = "foo"
v = "bar"
ct = S.concat [ nm , "=" , v ]
testFormEncoded :: Test
testFormEncoded = testCase "parser/formEncoded" $ do
let bs = "foo1=bar1&foo2=bar2+baz2;foo3=foo%20bar"
let mp = parseUrlEncoded bs
assertEqual "foo1" (Just ["bar1"] ) $ Map.lookup "foo1" mp
assertEqual "foo2" (Just ["bar2 baz2"]) $ Map.lookup "foo2" mp
assertEqual "foo3" (Just ["foo bar"] ) $ Map.lookup "foo3" mp
copyingStream2Stream :: (Monad m) => Iteratee ByteString m ByteString
copyingStream2Stream = go []
where
go l = do
mbx <- I.head
maybe (return $ S.concat $ reverse l)
(\x -> let !z = S.copy x in go (z:l))
mbx
stream2stream :: (Monad m) => Iteratee ByteString m L.ByteString
stream2stream = liftM L.fromChunks consume
|
