SaveSpec.hs

module Yesod.Session.Manager.SaveSpec
  ( spec
  ) where

import Test.Prelude

import Control.Concurrent.STM.TVar (readTVarIO)
import Control.Monad.State (execState)
import Data.Map.Strict qualified as Map
import Data.Sequence qualified as Seq
import Embedding
import Session.KeyRotation
import Session.Timing.Time
import Yesod.Core (SessionMap)
import Yesod.Session.Embedding.Options
import Yesod.Session.Manager
import Yesod.Session.Manager.Load
import Yesod.Session.Manager.Save
import Yesod.Session.Options
import Yesod.Session.SaveResult
import Yesod.Session.SessionType
import Yesod.Session.Storage.Operation

spec :: Spec
spec = context "saveSession" $ do
  specify "doesn't unnecessarily create a session"
    $ forAll (genMockInit id)
    $ \mockInit -> ioProperty $ do
      mock@Mock {sessionManager} <- newMock id mockInit
      load <- loadNothing sessionManager
      save <- saveSession sessionManager load $ loadedData load
      transcript <- takeTranscript mock.mockStorage
      pure
        $ counterexample (show save) (save === NoChange)
        .&&. counterexample (show transcript) (transcript == Seq.empty)

  specify "may create a session"
    $ forAll (genMockInit id)
    $ \mockInit -> ioProperty $ do
      mock@Mock {sessionManager} <- newMock id mockInit
      now <- readTVarIO mock.currentTime
      load <- loadNothing sessionManager
      let newData = loadedData load & Map.insert "a" "b"
      session <- assertSaved =<< saveSession sessionManager load newData
      transcript <- takeTranscript mock.mockStorage
      pure
        $ counterexample
          (show session)
          ( (session.map == newData)
              .&&. (session.time.created == now)
              .&&. (session.time.accessed == now)
          )
        .&&. counterexample
          (show transcript)
          (transcript == Seq.fromList [StorageOperation' $ InsertSession session])

  specify "may update a loaded session"
    $ forAll (genMockInit noTimeoutResolution)
    $ \mockInit -> ioProperty $ do
      mock@Mock {sessionManager} <- newMock id mockInit
      time1 <- readTVarIO mock.currentTime
      session1 <- do
        load <- loadNothing sessionManager
        let newData = loadedData load & Map.insert "a" "b"
        assertSaved =<< saveSession sessionManager load newData
      advanceTimeBriefly mock
      time2 <- readTVarIO mock.currentTime
      void $ takeTranscript mock.mockStorage
      load <- loadSession sessionManager session1.key
      let newData = loadedData load & Map.insert "c" "d"
      session2 <- assertSaved =<< saveSession sessionManager load newData
      transcript <- takeTranscript mock.mockStorage
      pure
        $ counterexample
          (show session2)
          ( (session2.map == Map.fromList [("a", "b"), ("c", "d")])
              .&&. (session2.time.created == time1)
              .&&. (session2.time.accessed == time2)
          )
        .&&. counterexample
          (show transcript)
          ( transcript
              == Seq.fromList
                [ StorageOperation' $ GetSession session2.key
                , StorageOperation' $ ReplaceSession session2
                ]
          )

  specify "changes the session key when we rotate"
    $ forAll (genMockInit noTimeoutResolution)
    $ \mockInit -> ioProperty $ do
      mock@Mock {sessionManager} <- newMock id mockInit
      let SessionManager {options} = sessionManager
      session1 <- do
        load <- loadNothing sessionManager
        let newData = loadedData load & Map.insert "a" "b"
        assertSaved =<< saveSession sessionManager load newData
      advanceTimeBriefly mock
      (session2, transcript) <- do
        load <- loadSession sessionManager session1.key
        void $ takeTranscript mock.mockStorage
        let newData =
              loadedData load
                & setSessionKeyRotation options (Just RotateSessionKey)
                & Map.insert "c" "d"
        session <- assertSaved =<< saveSession sessionManager load newData
        transcript <- takeTranscript mock.mockStorage
        pure (session, transcript)
      loadForOldSession <- loadSession sessionManager session1.key
      loadForNewSession <- loadSession sessionManager session2.key
      pure
        $ counterexample (show (session1, session2)) (session1.key /= session2.key)
        .&&. counterexample (show loadForOldSession) (not $ didSessionLoad loadForOldSession)
        .&&. counterexample
          (show loadForNewSession)
          (loadedData loadForNewSession == Map.fromList [("a", "b"), ("c", "d")])
        .&&. counterexample
          (show transcript)
          ( transcript
              == Seq.fromList
                [ StorageOperation' $ DeleteSession session1.key
                , StorageOperation' $ InsertSession session2
                ]
          )

setSessionKeyRotation
  :: Options tx m -> Maybe KeyRotation -> SessionMap -> SessionMap
setSessionKeyRotation options =
  execState . embed options.embedding.keyRotation

assertSaved :: Show a => SaveResult a -> IO a
assertSaved = \case
  Saved x -> pure x
  x -> fail $ "Expected Saved, but got: " <> show x