content: {-# OPTIONS_GHC -Wno-orphans #-}
  
  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.Time.Clock
  import Data.Time.Calendar
  import qualified Data.CaseInsensitive as CI
  import Web.Cookie
  
  -- We use these Eq instances here because they make sense and may be added to the library in
  -- the future.  We do not add them now because they would silently break the old Eq behavior,
  -- which was `equivCookie`.
  instance Eq Cookie where
    (==) = equalCookie
  
  instance Eq CookieJar where
    (==) = equalCookieJar
  
  instance Eq body => Eq (Response body) where
    resp == resp' = and
      [ responseStatus resp == responseStatus resp'
      , responseVersion resp == responseVersion resp'
      , responseHeaders resp == responseHeaders resp'
      , responseBody resp == responseBody resp'
      , responseCookieJar resp `equivCookieJar` responseCookieJar resp'  -- !
      -- , responseClose  -- !
      ]
  
  default_request :: HC.Request
  default_request = HC.parseRequest_ "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 = assertBool "Cookies should still be equal if extra options are changed" $
    (default_cookie {cookie_persistent = True}) `equivCookie` (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 nonexistent 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 = do
    assertEqual "Sorting works correctly (computed string)" (fst format_output) (fromString "c1=v1;c3=v3;c4=v4;c2=v2")
    assertBool "Sorting works correctly (remaining jar)" $ (snd format_output) `equivCookieJar` cookie_jar_out
    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 = assertBool "Receiving a Set-Cookie" $
    (createCookieJar [default_cookie]) `equivCookieJar` (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 = assertBool "Receiving a Set-Cookie with a leading domain dot" $
    (createCookieJar [default_cookie]) `equivCookieJar` (receiveSetCookie set_cookie default_request default_time True $ createCookieJar [])
    where set_cookie = default_set_cookie {setCookieDomain = Just $ fromString ".www.google.com"}
  
  testReceiveSetCookieNoDomain :: IO ()
  testReceiveSetCookieNoDomain = assertBool "Receiving cookie without domain" $
    (createCookieJar [default_cookie]) `equivCookieJar` (receiveSetCookie set_cookie default_request default_time True $ createCookieJar [])
    where set_cookie = default_set_cookie {setCookieDomain = Nothing}
  
  testReceiveSetCookieEmptyDomain :: IO ()
  testReceiveSetCookieEmptyDomain = assertBool "Receiving cookie with empty domain" $
    (createCookieJar [default_cookie]) `equivCookieJar` (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 nonexistent"
    (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] `Data.Monoid.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 nonexistent 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 nonexistent" 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
  