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
|
import Test.Framework (defaultMain)
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.Framework.Providers.HUnit (testCase)
import Test.QuickCheck
import Test.HUnit ((@=?), Assertion)
import Web.Cookie
import Blaze.ByteString.Builder (Builder, toLazyByteString)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
import Data.Word (Word8)
import Control.Arrow ((***))
import Control.Applicative ((<$>), (<*>))
import Data.Time (UTCTime (UTCTime), toGregorian)
import qualified Data.Text as T
main :: IO ()
main = defaultMain
[ testProperty "parse/render cookies" propParseRenderCookies
, testProperty "parse/render SetCookie" propParseRenderSetCookie
, testProperty "parse/render cookies text" propParseRenderCookiesText
, testCase "parseCookies" caseParseCookies
, twoDigit 24 2024
, twoDigit 69 2069
, twoDigit 70 1970
]
propParseRenderCookies :: Cookies' -> Bool
propParseRenderCookies cs' =
parseCookies (builderToBs $ renderCookies cs) == cs
where
cs = map (fromUnChars *** fromUnChars) cs'
propParseRenderCookiesText :: Cookies' -> Bool
propParseRenderCookiesText cs' =
parseCookiesText (builderToBs $ renderCookiesText cs) == cs
where
cs = map (T.pack . map unChar'' *** T.pack . map unChar'') cs'
unChar'' = toEnum . fromEnum . unChar'
fromUnChars :: [Char'] -> S.ByteString
fromUnChars = S.pack . map unChar'
builderToBs :: Builder -> S.ByteString
builderToBs = S.concat . L.toChunks . toLazyByteString
type Cookies' = [([Char'], [Char'])]
newtype Char' = Char' { unChar' :: Word8 }
instance Show Char' where
show (Char' w) = [toEnum $ fromEnum w]
showList = (++) . show . concatMap show
instance Arbitrary Char' where
arbitrary = fmap (Char' . toEnum) $ choose (62, 125)
propParseRenderSetCookie :: SetCookie -> Bool
propParseRenderSetCookie sc =
parseSetCookie (builderToBs $ renderSetCookie sc) == sc
instance Arbitrary SetCookie where
arbitrary = do
name <- fmap fromUnChars arbitrary
value <- fmap fromUnChars arbitrary
path <- fmap (fmap fromUnChars) arbitrary
expires <- fmap (parseCookieExpires . formatCookieExpires)
(UTCTime <$> fmap toEnum arbitrary <*> return 0)
domain <- fmap (fmap fromUnChars) arbitrary
httponly <- arbitrary
secure <- arbitrary
return def
{ setCookieName = name
, setCookieValue = value
, setCookiePath = path
, setCookieExpires = expires
, setCookieDomain = domain
, setCookieHttpOnly = httponly
, setCookieSecure = secure
}
caseParseCookies :: Assertion
caseParseCookies = do
let input = S8.pack "a=a1;b=b2; c=c3"
expected = [("a", "a1"), ("b", "b2"), ("c", "c3")]
map (S8.pack *** S8.pack) expected @=? parseCookies input
-- Tests for two digit years, see:
--
-- https://github.com/snoyberg/cookie/issues/5
twoDigit x y =
testCase ("year " ++ show x) (y @=? year)
where
(year, _, _) = toGregorian day
Just (UTCTime day _) = setCookieExpires sc
sc = parseSetCookie str
str = S8.pack $ concat
[ "foo=bar; Expires=Mon, 29-Jul-"
, show x
, " 04:52:08 GMT"
]
|
