module CookieTest (cookieTest) where import Prelude hiding (exp) import Test.Hspec import qualified Data.ByteString as BS import Test.HUnit hiding (path) import Network.HTTP.Client import qualified Network.HTTP.Conduit as HC import Data.ByteString.UTF8 import Data.Monoid import Data.Maybe import Data.Time.Clock import Data.Time.Calendar import qualified Data.CaseInsensitive as CI import Web.Cookie default_request :: HC.Request default_request = fromJust $ HC.parseUrl "http://www.google.com/" default_cookie :: Cookie default_cookie = Cookie { cookie_name = fromString "name" , cookie_value = fromString "value" , cookie_expiry_time = default_time , cookie_domain = fromString "www.google.com" , cookie_path = fromString "/" , cookie_creation_time = default_time , cookie_last_access_time = default_time , cookie_persistent = False , cookie_host_only = False , cookie_secure_only = False , cookie_http_only = False } default_time :: UTCTime default_time = UTCTime (ModifiedJulianDay 56200) (secondsToDiffTime 0) default_diff_time :: DiffTime default_diff_time = secondsToDiffTime 1209600 default_set_cookie :: SetCookie default_set_cookie = def { setCookieName = fromString "name" , setCookieValue = fromString "value" , setCookiePath = Just $ fromString "/" , setCookieExpires = Just default_time , setCookieMaxAge = Just default_diff_time , setCookieDomain = Just $ fromString "www.google.com" , setCookieHttpOnly = False , setCookieSecure = False } testValidIp :: IO () testValidIp = assertBool "Couldn't parse valid IP address" $ isIpAddress $ fromString "1.2.3.4" testIpNumTooHigh :: IO () testIpNumTooHigh = assertBool "One of the digits in the IP address is too large" $ not $ isIpAddress $ fromString "501.2.3.4" testTooManySegmentsInIp :: IO () testTooManySegmentsInIp = assertBool "Too many segments in the ip address" $ not $ isIpAddress $ fromString "1.2.3.4.5" testCharsInIp :: IO () testCharsInIp = assertBool "Chars are not allowed in IP addresses" $ not $ isIpAddress $ fromString "1.2a3.4.5" testDomainMatchesSuccess :: IO () testDomainMatchesSuccess = assertBool "Domains should match" $ domainMatches (fromString "www.google.com") (fromString "google.com") testSameDomain :: IO () testSameDomain = assertBool "Same domain should match" $ domainMatches domain domain where domain = fromString "www.google.com" testSiblingDomain :: IO () testSiblingDomain = assertBool "Sibling domain should not match" $ not $ domainMatches (fromString "www.google.com") (fromString "secure.google.com") testParentDomain :: IO () testParentDomain = assertBool "Parent domain should fail" $ not $ domainMatches (fromString "google.com") (fromString "www.google.com") testNaiveSuffixDomain :: IO () testNaiveSuffixDomain = assertBool "Naively checking for suffix for domain matching should fail" $ not $ domainMatches (fromString "agoogle.com") (fromString "google.com") testDefaultPath :: IO () testDefaultPath = assertEqual "Getting default path from a request" (fromString "/") (defaultPath default_request) testShortDefaultPath :: IO () testShortDefaultPath = assertEqual "Getting default path from a short path" (fromString "/") (defaultPath $ default_request {HC.path = fromString "/search"}) testPopulatedDefaultPath :: IO () testPopulatedDefaultPath = assertEqual "Getting default path from a request with a path" (fromString "/search") (defaultPath $ default_request {HC.path = fromString "/search/term"}) testParamsDefaultPath :: IO () testParamsDefaultPath = assertEqual "Getting default path from a request with a path and GET params" (fromString "/search") (defaultPath $ default_request {HC.path = fromString "/search/term?var=val"}) testDefaultPathEndingInSlash :: IO () testDefaultPathEndingInSlash = assertEqual "Getting default path that ends in a slash" (fromString "/search/term") (defaultPath $ default_request {HC.path = fromString "/search/term/"}) testSamePathsMatch :: IO () testSamePathsMatch = assertBool "The same path should match" $ pathMatches path' path' where path' = fromString "/a/path" testPathSlashAtEnd :: IO () testPathSlashAtEnd = assertBool "Putting the slash at the end should still match paths" $ pathMatches (fromString "/a/path/to/here") (fromString "/a/path/") testPathNoSlashAtEnd :: IO () testPathNoSlashAtEnd = assertBool "Not putting the slash at the end should still match paths" $ pathMatches (fromString "/a/path/to/here") (fromString "/a/path") testDivergingPaths :: IO () testDivergingPaths = assertBool "Diverging paths don't match" $ not $ pathMatches (fromString "/a/path/to/here") (fromString "/a/different/path") testCookieEqualitySuccess :: IO () testCookieEqualitySuccess = assertEqual "The same cookies should be equal" cookie cookie where cookie = default_cookie testCookieEqualityResiliance :: IO () testCookieEqualityResiliance = assertEqual "Cookies should still be equal if extra options are changed" (default_cookie {cookie_persistent = True}) (default_cookie {cookie_host_only = True}) testDomainChangesEquality :: IO () testDomainChangesEquality = assertBool "Changing the domain should make cookies not equal" $ default_cookie /= (default_cookie {cookie_domain = fromString "/search"}) testRemoveCookie :: IO () testRemoveCookie = assertEqual "Removing a cookie works" (Just default_cookie, createCookieJar []) (removeExistingCookieFromCookieJar default_cookie $ createCookieJar [default_cookie]) testRemoveNonexistantCookie :: IO () testRemoveNonexistantCookie = assertEqual "Removing a nonexistant cookie doesn't work" (Nothing, createCookieJar [default_cookie]) (removeExistingCookieFromCookieJar (default_cookie {cookie_name = fromString "key2"}) $ createCookieJar [default_cookie]) testRemoveCorrectCookie :: IO () testRemoveCorrectCookie = assertEqual "Removing only the correct cookie" (Just search_for, createCookieJar [red_herring]) (removeExistingCookieFromCookieJar search_for $ createCookieJar [red_herring, search_for]) where search_for = default_cookie {cookie_name = fromString "name1"} red_herring = default_cookie {cookie_name = fromString "name2"} testEvictExpiredCookies :: IO () testEvictExpiredCookies = assertEqual "Evicting expired cookies works" (createCookieJar [a, c]) (evictExpiredCookies (createCookieJar [a, b, c, d]) middle) where a = default_cookie { cookie_name = fromString "a" , cookie_expiry_time = UTCTime (ModifiedJulianDay 3) (secondsToDiffTime 0) } b = default_cookie { cookie_name = fromString "b" , cookie_expiry_time = UTCTime (ModifiedJulianDay 1) (secondsToDiffTime 0) } c = default_cookie { cookie_name = fromString "c" , cookie_expiry_time = UTCTime (ModifiedJulianDay 3) (secondsToDiffTime 0) } d = default_cookie { cookie_name = fromString "d" , cookie_expiry_time = UTCTime (ModifiedJulianDay 1) (secondsToDiffTime 0) } middle = UTCTime (ModifiedJulianDay 2) (secondsToDiffTime 0) testEvictNoCookies :: IO () testEvictNoCookies = assertEqual "Evicting empty cookie jar" (createCookieJar []) (evictExpiredCookies (createCookieJar []) middle) where middle = UTCTime (ModifiedJulianDay 2) (secondsToDiffTime 0) testComputeCookieStringUpdateLastAccessTime :: IO () testComputeCookieStringUpdateLastAccessTime = assertEqual "Updates last access time upon using cookies" (fromString "name=value", out_cookie_jar) (computeCookieString request cookie_jar now True) where request = default_request cookie_jar = createCookieJar [default_cookie] now = UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 1) out_cookie_jar = createCookieJar [default_cookie {cookie_last_access_time = now}] testComputeCookieStringHostOnly :: IO () testComputeCookieStringHostOnly = assertEqual "Host only cookies should match host exactly" (fromString "name=value", cookie_jar) (computeCookieString request cookie_jar default_time True) where request = default_request cookie_jar = createCookieJar [default_cookie {cookie_host_only = True}] testComputeCookieStringHostOnlyFilter :: IO () testComputeCookieStringHostOnlyFilter = assertEqual "Host only cookies shouldn't match subdomain" (fromString "", cookie_jar) (computeCookieString request cookie_jar default_time True) where request = default_request {HC.host = fromString "sub1.sub2.google.com"} cookie_jar = createCookieJar [default_cookie { cookie_host_only = True , cookie_domain = fromString "sub2.google.com" } ] testComputeCookieStringDomainMatching :: IO () testComputeCookieStringDomainMatching = assertEqual "Domain matching works for new requests" (fromString "name=value", cookie_jar) (computeCookieString request cookie_jar default_time True) where request = default_request {HC.host = fromString "sub1.sub2.google.com"} cookie_jar = createCookieJar [default_cookie {cookie_domain = fromString "sub2.google.com"}] testComputeCookieStringPathMatching :: IO () testComputeCookieStringPathMatching = assertEqual "Path matching works for new requests" (fromString "name=value", cookie_jar) (computeCookieString request cookie_jar default_time True) where request = default_request {HC.path = fromString "/a/path/to/nowhere"} cookie_jar = createCookieJar [default_cookie {cookie_path = fromString "/a/path"}] testComputeCookieStringPathMatchingFails :: IO () testComputeCookieStringPathMatchingFails = assertEqual "Path matching fails when it should" (fromString "", cookie_jar) (computeCookieString request cookie_jar default_time True) where request = default_request {HC.path = fromString "/a/different/path/to/nowhere"} cookie_jar = createCookieJar [default_cookie {cookie_path = fromString "/a/path"}] testComputeCookieStringPathMatchingWithParms :: IO () testComputeCookieStringPathMatchingWithParms = assertEqual "Path matching succeeds when request has GET params" (fromString "name=value", cookie_jar) (computeCookieString request cookie_jar default_time True) where request = default_request {HC.path = fromString "/a/path/to/nowhere?var=val"} cookie_jar = createCookieJar [default_cookie {cookie_path = fromString "/a/path"}] testComputeCookieStringSecure :: IO () testComputeCookieStringSecure = assertEqual "Secure flag filters properly" (fromString "", cookie_jar) (computeCookieString default_request cookie_jar default_time True) where cookie_jar = createCookieJar [default_cookie {cookie_secure_only = True}] testComputeCookieStringHttpOnly :: IO () testComputeCookieStringHttpOnly = assertEqual "http-only flag filters properly" (fromString "", cookie_jar) (computeCookieString default_request cookie_jar default_time False) where cookie_jar = createCookieJar [default_cookie {cookie_http_only = True}] testComputeCookieStringSort :: IO () testComputeCookieStringSort = assertEqual "Sorting works correctly" (fromString "c1=v1;c3=v3;c4=v4;c2=v2", cookie_jar_out) format_output where now = UTCTime (ModifiedJulianDay 10) (secondsToDiffTime 11) cookie_jar = createCookieJar [ default_cookie { cookie_name = fromString "c1" , cookie_value = fromString "v1" , cookie_path = fromString "/all/encompassing/request" } , default_cookie { cookie_name = fromString "c2" , cookie_value = fromString "v2" , cookie_path = fromString "/all" } , default_cookie { cookie_name = fromString "c3" , cookie_value = fromString "v3" , cookie_path = fromString "/all/encompassing" , cookie_creation_time = UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 1) } , default_cookie { cookie_name = fromString "c4" , cookie_value = fromString "v4" , cookie_path = fromString "/all/encompassing" , cookie_creation_time = UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 2) } ] cookie_jar_out = createCookieJar [ default_cookie { cookie_name = fromString "c1" , cookie_value = fromString "v1" , cookie_path = fromString "/all/encompassing/request" , cookie_last_access_time = now } , default_cookie { cookie_name = fromString "c2" , cookie_value = fromString "v2" , cookie_path = fromString "/all" , cookie_last_access_time = now } , default_cookie { cookie_name = fromString "c3" , cookie_value = fromString "v3" , cookie_path = fromString "/all/encompassing" , cookie_creation_time = UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 1) , cookie_last_access_time = now } , default_cookie { cookie_name = fromString "c4" , cookie_value = fromString "v4" , cookie_path = fromString "/all/encompassing" , cookie_creation_time = UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 2) , cookie_last_access_time = now } ] request = default_request {HC.path = fromString "/all/encompassing/request/path"} format_output = computeCookieString request cookie_jar default_time False testInsertCookiesIntoRequestWorks :: IO () testInsertCookiesIntoRequestWorks = assertEqual "Inserting cookies works" [(CI.mk $ fromString "Cookie", fromString "key=val")] out_headers where out_headers = HC.requestHeaders req (req, _) = insertCookiesIntoRequest req' cookie_jar default_time cookie_jar = createCookieJar [ default_cookie { cookie_name = fromString "key" , cookie_value = fromString "val" } ] req' = default_request {HC.requestHeaders = [(CI.mk $ fromString "Cookie", fromString "otherkey=otherval")]} testReceiveSetCookie :: IO () testReceiveSetCookie = assertEqual "Receiving a Set-Cookie" (createCookieJar [default_cookie]) (receiveSetCookie default_set_cookie default_request default_time True $ createCookieJar []) testReceiveSetCookieTrailingDot :: IO () testReceiveSetCookieTrailingDot = assertEqual "Receiving a Set-Cookie with a trailing domain dot" (createCookieJar []) (receiveSetCookie set_cookie default_request default_time True $ createCookieJar []) where set_cookie = default_set_cookie {setCookieDomain = Just $ fromString "www.google.com."} testReceiveSetCookieLeadingDot :: IO () testReceiveSetCookieLeadingDot = assertEqual "Receiving a Set-Cookie with a leading domain dot" (createCookieJar [default_cookie]) (receiveSetCookie set_cookie default_request default_time True $ createCookieJar []) where set_cookie = default_set_cookie {setCookieDomain = Just $ fromString ".www.google.com"} testReceiveSetCookieNoDomain :: IO () testReceiveSetCookieNoDomain = assertEqual "Receiving cookie without domain" (createCookieJar [default_cookie]) (receiveSetCookie set_cookie default_request default_time True $ createCookieJar []) where set_cookie = default_set_cookie {setCookieDomain = Nothing} testReceiveSetCookieEmptyDomain :: IO () testReceiveSetCookieEmptyDomain = assertEqual "Receiving cookie with empty domain" (createCookieJar [default_cookie]) (receiveSetCookie set_cookie default_request default_time True $ createCookieJar []) where set_cookie = default_set_cookie {setCookieDomain = Just BS.empty} -- Can't test public suffixes until that module is written testReceiveSetCookieNonMatchingDomain :: IO () testReceiveSetCookieNonMatchingDomain = assertEqual "Receiving cookie with non-matching domain" (createCookieJar []) (receiveSetCookie set_cookie default_request default_time True $ createCookieJar []) where set_cookie = default_set_cookie {setCookieDomain = Just $ fromString "www.wikipedia.org"} testReceiveSetCookieHostOnly :: IO () testReceiveSetCookieHostOnly = assertBool "Checking host-only flag gets set" $ cookie_host_only $ head $ destroyCookieJar $ receiveSetCookie set_cookie default_request default_time True $ createCookieJar [] where set_cookie = default_set_cookie {setCookieDomain = Nothing} testReceiveSetCookieHostOnlyNotSet :: IO () testReceiveSetCookieHostOnlyNotSet = assertBool "Checking host-only flag doesn't get set" $ not $ cookie_host_only $ head $ destroyCookieJar $ receiveSetCookie set_cookie default_request default_time True $ createCookieJar [] where set_cookie = default_set_cookie {setCookieDomain = Just $ fromString "google.com"} testReceiveSetCookieHttpOnly :: IO () testReceiveSetCookieHttpOnly = assertBool "Checking http-only flag gets set" $ cookie_http_only $ head $ destroyCookieJar $ receiveSetCookie set_cookie default_request default_time True $ createCookieJar [] where set_cookie = default_set_cookie {setCookieHttpOnly = True} testReceiveSetCookieHttpOnlyNotSet :: IO () testReceiveSetCookieHttpOnlyNotSet = assertBool "Checking http-only flag doesn't get set" $ not $ cookie_http_only $ head $ destroyCookieJar $ receiveSetCookie set_cookie default_request default_time True $ createCookieJar [] where set_cookie = default_set_cookie {setCookieHttpOnly = False} testReceiveSetCookieHttpOnlyDrop :: IO () testReceiveSetCookieHttpOnlyDrop = assertEqual "Checking non http request gets dropped" (createCookieJar []) (receiveSetCookie set_cookie default_request default_time False $ createCookieJar []) where set_cookie = default_set_cookie {setCookieHttpOnly = True} testReceiveSetCookieName :: IO () testReceiveSetCookieName = assertEqual "Name gets set correctly" (fromString "name") (cookie_name $ head $ destroyCookieJar $ receiveSetCookie default_set_cookie default_request default_time True $ createCookieJar []) testReceiveSetCookieValue :: IO () testReceiveSetCookieValue = assertEqual "Value gets set correctly" (fromString "value") (cookie_value $ head $ destroyCookieJar $ receiveSetCookie default_set_cookie default_request default_time True $ createCookieJar []) testReceiveSetCookieExpiry :: IO () testReceiveSetCookieExpiry = assertEqual "Expiry gets set correctly" now_plus_diff_time (cookie_expiry_time $ head $ destroyCookieJar $ receiveSetCookie default_set_cookie default_request default_time True $ createCookieJar []) where now_plus_diff_time = ((fromRational $ toRational default_diff_time) `addUTCTime` default_time) testReceiveSetCookieNoMaxAge :: IO () testReceiveSetCookieNoMaxAge = assertEqual "Expiry is based on the given value" default_time (cookie_expiry_time $ head $ destroyCookieJar $ receiveSetCookie cookie_without_max_age default_request default_time True $ createCookieJar []) where cookie_without_max_age = default_set_cookie {setCookieMaxAge = Nothing} testReceiveSetCookieNoExpiry :: IO () testReceiveSetCookieNoExpiry = assertEqual "Expiry is based on max age" now_plus_diff_time (cookie_expiry_time $ head $ destroyCookieJar $ receiveSetCookie cookie_without_expiry default_request default_time True $ createCookieJar []) where now_plus_diff_time = ((fromRational $ toRational default_diff_time) `addUTCTime` default_time) cookie_without_expiry = default_set_cookie {setCookieExpires = Nothing} testReceiveSetCookieNoExpiryNoMaxAge :: IO () testReceiveSetCookieNoExpiryNoMaxAge = assertBool "Expiry is set to a future date" $ default_time < (cookie_expiry_time $ head $ destroyCookieJar $ receiveSetCookie basic_cookie default_request default_time True $ createCookieJar []) where basic_cookie = default_set_cookie { setCookieExpires = Nothing, setCookieMaxAge = Nothing } testReceiveSetCookiePath :: IO () testReceiveSetCookiePath = assertEqual "Path gets set correctly" (fromString "/a/path") (cookie_path $ head $ destroyCookieJar $ receiveSetCookie set_cookie default_request default_time True $ createCookieJar []) where set_cookie = default_set_cookie {setCookiePath = Just $ fromString "/a/path"} testReceiveSetCookieNoPath :: IO () testReceiveSetCookieNoPath = assertEqual "Path gets set correctly when nonexistant" (fromString "/a/path/to") (cookie_path $ head $ destroyCookieJar $ receiveSetCookie set_cookie request default_time True $ createCookieJar []) where set_cookie = default_set_cookie {setCookiePath = Nothing} request = default_request {HC.path = fromString "/a/path/to/nowhere"} testReceiveSetCookieCreationTime :: IO () testReceiveSetCookieCreationTime = assertEqual "Creation time gets set correctly" now (cookie_creation_time $ head $ destroyCookieJar $ receiveSetCookie default_set_cookie default_request now True $ createCookieJar []) where now = UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 1) testReceiveSetCookieAccessTime :: IO () testReceiveSetCookieAccessTime = assertEqual "Last access time gets set correctly" now (cookie_last_access_time $ head $ destroyCookieJar $ receiveSetCookie default_set_cookie default_request now True $ createCookieJar []) where now = UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 1) testReceiveSetCookiePersistent :: IO () testReceiveSetCookiePersistent = assertBool "Persistent flag gets set correctly" $ cookie_persistent $ head $ destroyCookieJar $ receiveSetCookie set_cookie default_request default_time True $ createCookieJar [] where set_cookie = default_set_cookie {setCookieExpires = Just default_time} testReceiveSetCookieSecure :: IO () testReceiveSetCookieSecure = assertBool "Secure flag gets set correctly" $ cookie_secure_only $ head $ destroyCookieJar $ receiveSetCookie set_cookie default_request default_time True $ createCookieJar [] where set_cookie = default_set_cookie {setCookieSecure = True} testReceiveSetCookieMaxAge :: IO () testReceiveSetCookieMaxAge = assertEqual "Max-Age gets set correctly" total (cookie_expiry_time $ head $ destroyCookieJar $ receiveSetCookie set_cookie default_request now True $ createCookieJar []) where set_cookie = default_set_cookie { setCookieExpires = Nothing , setCookieMaxAge = Just $ secondsToDiffTime 10 } now = UTCTime (ModifiedJulianDay 10) (secondsToDiffTime 12) total = UTCTime (ModifiedJulianDay 10) (secondsToDiffTime 22) testReceiveSetCookiePreferMaxAge :: IO () testReceiveSetCookiePreferMaxAge = assertEqual "Max-Age is preferred over Expires" total (cookie_expiry_time $ head $ destroyCookieJar $ receiveSetCookie set_cookie default_request now True $ createCookieJar []) where set_cookie = default_set_cookie { setCookieExpires = Just exp , setCookieMaxAge = Just $ secondsToDiffTime 10 } exp = UTCTime (ModifiedJulianDay 11) (secondsToDiffTime 5) now = UTCTime (ModifiedJulianDay 10) (secondsToDiffTime 12) total = UTCTime (ModifiedJulianDay 10) (secondsToDiffTime 22) testReceiveSetCookieExisting :: IO () testReceiveSetCookieExisting = assertEqual "Existing cookie gets updated" t (cookie_expiry_time $ head $ destroyCookieJar $ receiveSetCookie set_cookie default_request default_time True $ createCookieJar [default_cookie]) where set_cookie = default_set_cookie { setCookieExpires = Just t , setCookieMaxAge = Nothing } t = UTCTime (ModifiedJulianDay 10) (secondsToDiffTime 12) testReceiveSetCookieExistingCreation :: IO () testReceiveSetCookieExistingCreation = assertEqual "Creation time gets updated in existing cookie" default_time (cookie_creation_time $ head $ destroyCookieJar $ receiveSetCookie default_set_cookie default_request now True $ createCookieJar [default_cookie]) where now = UTCTime (ModifiedJulianDay 10) (secondsToDiffTime 12) testReceiveSetCookieExistingHttpOnly :: IO () testReceiveSetCookieExistingHttpOnly = assertEqual "Existing http-only cookie gets dropped" default_time (cookie_expiry_time $ head $ destroyCookieJar $ receiveSetCookie default_set_cookie default_request default_time False $ createCookieJar [existing_cookie]) where existing_cookie = default_cookie {cookie_http_only = True} testMonoidPreferRecent :: IO () testMonoidPreferRecent = assertEqual "Monoid prefers more recent cookies" (cct $ createCookieJar [c2]) (cct $ createCookieJar [c1] `mappend` createCookieJar [c2]) where c1 = default_cookie {cookie_creation_time = UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 1)} c2 = default_cookie {cookie_creation_time = UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 2)} cct cj = cookie_creation_time $ head $ destroyCookieJar cj ipParseTests :: Spec ipParseTests = do it "Valid IP" testValidIp it "Digit Too High" testIpNumTooHigh it "Too Many Segments" testTooManySegmentsInIp it "Chars in IP" testCharsInIp domainMatchingTests :: Spec domainMatchingTests = do it "Should Match" testDomainMatchesSuccess it "Same Domain" testSameDomain it "Sibling Domain" testSiblingDomain it "Parent Domain" testParentDomain it "Checking for Naive suffix-check" testNaiveSuffixDomain defaultPathTests :: Spec defaultPathTests = do it "Basic default path test" testDefaultPath it "Basic populated default path" testPopulatedDefaultPath it "Default path from request with GET params works" testParamsDefaultPath it "Getting a default path that ends in a slash" testDefaultPathEndingInSlash it "Getting a short default path" testShortDefaultPath pathMatchingTests :: Spec pathMatchingTests = do it "Same paths match" testSamePathsMatch it "Putting slash at end" testPathSlashAtEnd it "Not putting slash at end" testPathNoSlashAtEnd it "Diverging paths don't match" testDivergingPaths equalityTests :: Spec equalityTests = do it "The same cookie should be equal to itself" testCookieEqualitySuccess it "Changing extra options shouldn't change equality" testCookieEqualityResiliance it "Changing a cookie's domain should change its equality" testDomainChangesEquality removeTests :: Spec removeTests = do it "Removing a cookie works" testRemoveCookie it "Removing a nonexistant cookie doesn't work" testRemoveNonexistantCookie it "Removing the correct cookie" testRemoveCorrectCookie evictionTests :: Spec evictionTests = do it "Testing eviction" testEvictExpiredCookies it "Evicting from empty cookie jar" testEvictNoCookies sendingTests :: Spec sendingTests = do it "Updates last access time upon using cookies" testComputeCookieStringUpdateLastAccessTime it "Host-only flag matches exact host" testComputeCookieStringHostOnly it "Host-only flag doesn't match subdomain" testComputeCookieStringHostOnlyFilter it "Domain matching works properly" testComputeCookieStringDomainMatching it "Path matching works" testComputeCookieStringPathMatching it "Path matching fails when it should" testComputeCookieStringPathMatchingFails it "Path matching succeeds when request has GET params" testComputeCookieStringPathMatchingWithParms it "Secure flag filters correctly" testComputeCookieStringSecure it "Http-only flag filters correctly" testComputeCookieStringHttpOnly it "Sorting works correctly" testComputeCookieStringSort it "Inserting cookie header works" testInsertCookiesIntoRequestWorks receivingTests :: Spec receivingTests = do it "Can receive set-cookie" testReceiveSetCookie it "Receiving a Set-Cookie with a trailing dot on the domain" testReceiveSetCookieTrailingDot it "Receiving a Set-Cookie with a leading dot on the domain" testReceiveSetCookieLeadingDot it "Set-Cookie with no domain" testReceiveSetCookieNoDomain it "Set-Cookie with empty domain" testReceiveSetCookieEmptyDomain it "Set-Cookie with non-matching domain" testReceiveSetCookieNonMatchingDomain it "Host-only flag gets set" testReceiveSetCookieHostOnly it "Host-only flag doesn't get set" testReceiveSetCookieHostOnlyNotSet it "Http-only flag gets set" testReceiveSetCookieHttpOnly it "Http-only flag doesn't get set" testReceiveSetCookieHttpOnlyNotSet it "Checking non http request gets dropped" testReceiveSetCookieHttpOnlyDrop it "Name gets set correctly" testReceiveSetCookieName it "Value gets set correctly" testReceiveSetCookieValue it "Expiry gets set correctly" testReceiveSetCookieExpiry it "Expiry gets set based on max age if no expiry is given" testReceiveSetCookieNoExpiry it "Expiry gets set based on given value if no max age is given" testReceiveSetCookieNoMaxAge it "Expiry gets set to a future date if no expiry and no max age are given" testReceiveSetCookieNoExpiryNoMaxAge it "Path gets set correctly when nonexistant" testReceiveSetCookieNoPath it "Path gets set correctly" testReceiveSetCookiePath it "Creation time gets set correctly" testReceiveSetCookieCreationTime it "Last access time gets set correctly" testReceiveSetCookieAccessTime it "Persistent flag gets set correctly" testReceiveSetCookiePersistent it "Existing cookie gets updated" testReceiveSetCookieExisting it "Creation time gets updated in existing cookie" testReceiveSetCookieExistingCreation it "Existing http-only cookie gets dropped" testReceiveSetCookieExistingHttpOnly it "Secure flag gets set correctly" testReceiveSetCookieSecure it "Max-Age flag gets set correctly" testReceiveSetCookieMaxAge it "Max-Age is preferred over Expires" testReceiveSetCookiePreferMaxAge monoidTests :: Spec monoidTests = do it "Monoid prefers more recent cookies" testMonoidPreferRecent cookieTest :: Spec cookieTest = do describe "ipParseTests" ipParseTests describe "domainMatchingTests" domainMatchingTests describe "defaultPathTests" defaultPathTests describe "pathMatchingTests" pathMatchingTests describe "equalityTests" equalityTests describe "removeTests" removeTests describe "evictionTests" evictionTests describe "sendingTests" sendingTests describe "receivingTests" receivingTests describe "monoidTest" monoidTests