CookieSpec.hs

{-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.Client.CookieSpec where

import           Control.Monad (when)
import           Data.Monoid
import           Data.Time.Clock
import           Network.HTTP.Client.Internal
import           Test.Hspec
import qualified Data.Time                 as DT
import qualified Web.Cookie                as WC

main :: IO ()
main = hspec spec

spec :: Spec
spec = describe "CookieSpec" $ do
    it "cookie equality - case insensitive Eq" $ do
      now <- getCurrentTime
      let cookie1 = Cookie "test" "value" now "doMain.Org" "/" now now False False False False
          cookie2 = Cookie "test" "value" now "DOMAIn.ORg" "/" now now False False False False
      cookie1 `shouldSatisfy` (equivCookie cookie2)

    it "domainMatches - case insensitive" $ do
      domainMatches "www.org" "www.org" `shouldBe` True
      domainMatches "wWw.OrG" "Www.oRG" `shouldBe` True
      domainMatches "wxw.OrG" "Www.oRG" `shouldBe` False

    it "domainMatches - case insensitive, partial" $ do
      domainMatches "www.org" "xxx.www.org" `shouldBe` False
      domainMatches "xxx.www.org" "WWW.ORG" `shouldBe` True

    describe "equalCookie vs. equivCookie" $ do
      let make :: IO Cookie
          make = do
            now <- DT.getCurrentTime
            req <- parseRequest "http://www.example.com/path"
            let Just cky = generateCookie (WC.parseSetCookie raw) req now True
                raw = "somename=somevalue.v=1.k=1.d=1590419679.t=u.l=s.u=8b2734ae-9dd1-11ea-bd7f-3bcf5b8d5d2a.r=795e71b5; " <>
                      "Path=/access; Domain=example.com; HttpOnly; Secure"
            return cky

          modifications :: [(String, Cookie -> Cookie, Bool)]
          modifications
              = [ ("cookie_name", \cky -> cky { cookie_name = "othername" }, True)
                , ("cookie_value", \cky -> cky { cookie_value = "othervalue" }, False)
                , ("cookie_expiry_time", \cky -> cky { cookie_expiry_time = DT.addUTCTime 60 $ cookie_expiry_time cky }, False)
                , ("cookie_domain", \cky -> cky { cookie_domain = cookie_domain cky <> ".com" }, True)
                , ("cookie_path", \cky -> cky { cookie_path = cookie_path cky <> "/sub" }, True)
                , ("cookie_creation_time", \cky -> cky { cookie_creation_time = DT.addUTCTime 60 $ cookie_creation_time cky }, False)
                , ("cookie_last_access_time", \cky -> cky { cookie_last_access_time = DT.addUTCTime 60 $ cookie_last_access_time cky }, False)
                , ("cookie_persistent", \cky -> cky { cookie_persistent = not $ cookie_persistent cky }, False)
                , ("cookie_host_only", \cky -> cky { cookie_host_only = not $ cookie_host_only cky }, False)
                , ("cookie_secure_only", \cky -> cky { cookie_secure_only = not $ cookie_secure_only cky }, False)
                , ("cookie_http_only", \cky -> cky { cookie_http_only = not $ cookie_http_only cky }, False)
                ]

          check :: (String, Cookie -> Cookie, Bool) -> Spec
          check (msg, f, countsForEquiv) = it msg $ do
            cky <- make
            cky `equalCookie` f cky `shouldBe` False
            when countsForEquiv $ cky `equivCookie` f cky `shouldBe` False

      check `mapM_` modifications

    it "isPotentiallyTrustworthyOrigin" $ do
      isPotentiallyTrustworthyOrigin True "" `shouldBe` True
      let untrusty = ["example", "example.", "example.com", "foolocalhost", "1.1.1.1", "::1", "[::2]"]
          trusty =
            [ "127.0.0.1", "127.0.0.2", "127.127.127.127"
            , "[::1]", "[0:0:0:0:0:0:0:1]"
            , "localhost", "localhost."
            , "a.b.c.localhost", "a.b.c.localhost."
            ]
      or (map (isPotentiallyTrustworthyOrigin False) untrusty) `shouldBe` False
      and (map (isPotentiallyTrustworthyOrigin False) trusty) `shouldBe` True