SessionSpec.hs

{-# LANGUAGE OverloadedLists #-}

module Test.SessionSpec where

import Data.String.Conversions (cs)
import Data.Text (Text)
import Network.HTTP.Types (urlEncode)
import Skeletest
import Web.Hyperbole
import Web.Hyperbole.Data.Cookie as Cookie
import Web.Hyperbole.Data.Encoded qualified as Encoded
import Web.Hyperbole.Data.URI
import Web.Hyperbole.Effect.Session (sessionCookie)


-- import Skeletest.Predicate qualified as P

data Woot = Woot Text
  deriving (Generic, Show, ToEncoded, FromEncoded)
instance Session Woot where
  cookiePath = Just $ Path ["somepage"]


spec :: Spec
spec = do
  describe "Session" $ do
    it "should encode cookie" $ do
      let woot = Woot "hello"
      toCookie woot `shouldBe` CookieValue (cs $ Encoded.encode woot)

  describe "sessionCookie" $ do
    it "should create cookie" $ do
      let woot = Woot "hello"
      sessionCookie woot `shouldBe` Cookie (sessionKey @Woot) (cookiePath @Woot) (Just (toCookie woot))

  describe "render" $ do
    it "should parse cookies" $ do
      Cookie.parse [("Woot", "Woot")] `shouldBe` Right (Cookie.fromList [Cookie "Woot" Nothing (Just (CookieValue "Woot"))])

    it "should render cookie with root path" $ do
      let cookie = Cookie "Woot" Nothing (Just (CookieValue "Woot"))
      Cookie.render [] cookie `shouldBe` "Woot=Woot; SameSite=None; secure; path=/"

    it "should render complex cookie with included path" $ do
      let woot = Woot "hello world"
      let cookie = sessionCookie woot
      Cookie.render [] cookie `shouldBe` "Woot=" <> urlEncode True (cs $ Encoded.encode woot) <> "; SameSite=None; secure; path=/somepage"

  describe "Session class" $ do
    it "should encode class" $ do
      let prefs = Preferences "hello" Warning
      let cooks = Cookie.insert (sessionCookie prefs) mempty
      Cookie.lookup (sessionKey @Preferences) cooks `shouldBe` Just (CookieValue $ cs $ Encoded.encode prefs)

    it "should decode class" $ do
      let prefs = Preferences "hello" Warning
      let cooks = Cookie.insert (sessionCookie prefs) mempty
      Just val <- pure $ Cookie.lookup (sessionKey @Preferences) cooks
      parseCookie val `shouldBe` Right prefs


data Preferences = Preferences
  { message :: Text
  , color :: AppColor
  }
  deriving (Generic, Eq, Show, ToEncoded, FromEncoded, Session)
instance Default Preferences where
  def = Preferences "_" White


data AppColor
  = White
  | Light
  | GrayLight
  | GrayDark
  | Dark
  | DarkHighlight
  | Success
  | Danger
  | Warning
  | Primary
  | PrimaryLight
  | Secondary
  | SecondaryLight
  deriving (Show, Eq, Generic, ToParam, FromParam)