diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+## [_Unreleased_](https://github.com/freckle/yesod-session-persist/compare/v__...main)
+
+## [v0.0.0.0](https://github.com/freckle/yesod-session-persist/tree/v0.0.0.0)
+
+First tagged release.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,21 @@
+The MIT License (MIT)
+
+Copyright (c) 2024 Renaissance Learning Inc
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,80 @@
+# yesod-session-persist
+
+[![Hackage](https://img.shields.io/hackage/v/yesod-session-persist.svg?style=flat)](https://hackage.haskell.org/package/yesod-session-persist)
+[![CI](https://github.com/freckle/yesod-session-persist/actions/workflows/ci.yml/badge.svg)](https://github.com/freckle/yesod-session-persist/actions/workflows/ci.yml)
+
+Use this package to construct a Yesod session backend for which sessions are
+stored in a database table. You provide a Persistent entity.
+
+## Features
+
+### Key rotation
+
+The key reason to switch from client-side sessions (Yesod's default) to server storage
+is to be able to rotate keys and invalidate old credentials.
+
+With client session storage, when a user logs out, you send them a new cookie.
+But this does nothing to satisfy a user who is logging out because their session secret may
+have been compromised; the old cookie value will still be a working authentication credential.
+Being able to _revoke_ authentication credentials requires storing state on the server.
+
+Whenever user's authentication changes (but especially on logging out), users of this library
+should use the `rotateSessionKey` action to provoke a key rotation.
+This copies any existing session data into a new session with a different secret key,
+deleting the session with the old key and thus disabling any outdated credentials that
+an attacker may possess.
+
+### Disabling session changes
+
+There may be some unusual circumstances in which you want to disable the effects of session
+management -- writes to the session backend and sending of session cookies -- for the
+handling of a particular request.
+At such times, you can use the `assignSessionFreeze` action to indicate whether the
+session should be persisted at the end of the handling of the request.
+
+### Expiration by idle timeout
+
+The most recent access time of each session is stored. After a configurable duration has
+elapsed without access, a session is considered to be expired. An expired session is treated
+as if it did not exist.
+
+### Expiration by absolute timeout
+
+The creation time of each session is stored. After a configurable duration has elapsed since
+the creation time, a session is considered to be expired, regardless of whether it is still
+in active use.
+
+### Approximate storage of access time
+
+To avoid excessive database writes, updates which would only increment a session's access
+time by a short duration are not performed.
+The definition of "a short duration" is configurable; we call it the _timeout resolution_.
+
+## Absent features
+
+### Garbage collection
+
+This library does not proactively seek out expired sessions for deletion from the database.
+Thus, in the absence of some other intervention, your session table will grow without bound.
+
+## Prior art
+
+### `serversession`
+
+This package is based on
+[serversession](https://hackage.haskell.org/package/serversession) +
+[serversession-frontend-yesod](https://hackage.haskell.org/package/serversession-frontend-yesod) +
+[serversession-backend-persistent](https://hackage.haskell.org/package/serversession-backend-persistent).
+
+Compared to `serversession`, here we simplify somewhat by concretizing to Yesod and
+Persistent rather than supporting multiple frontends and backends.
+
+Their sessions have a concept of "auth ID" specifying who is logged in.
+`serversession` uses this to automatically rotate keys when the auth ID changes, and
+to provide a means for mass invalidation of all the sessions belonging to a particular user.
+We do not borrow this concept, because it does not generalize well to more complex
+authentication situations where a session may have been authenticated as multiple principals.
+
+---
+
+[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE)
diff --git a/internal/Comparison.hs b/internal/Comparison.hs
new file mode 100644
--- /dev/null
+++ b/internal/Comparison.hs
@@ -0,0 +1,14 @@
+module Comparison
+  ( Comparison (..)
+  , differsOn
+  ) where
+
+import Internal.Prelude
+
+data Comparison a = Comparison
+  { old :: a
+  , new :: a
+  }
+
+differsOn :: Eq b => (a -> b) -> Comparison a -> Bool
+differsOn f Comparison {old, new} = f old /= f new
diff --git a/internal/Embedding.hs b/internal/Embedding.hs
new file mode 100644
--- /dev/null
+++ b/internal/Embedding.hs
@@ -0,0 +1,41 @@
+module Embedding
+  ( Embedding (..)
+  , embed
+  , extract
+  , extractIgnoringError
+  , dimapEmbedding
+  ) where
+
+import Internal.Prelude
+
+-- | Targets a value that is optionally present in some stateful monadic context
+data Embedding (con :: (Type -> Type) -> Constraint) e a = Embedding
+  { embed :: forall m. con m => Maybe a -> m ()
+  -- ^ Sets or clears the value
+  , extract :: forall m. (Functor m, con m) => m (Either e (Maybe a))
+  -- ^ Removes the value if present, returning what was removed
+  }
+
+embed :: con m => Embedding con e a -> Maybe a -> m ()
+embed Embedding {embed = x} = x
+
+extract :: (Functor m, con m) => Embedding con e a -> m (Either e (Maybe a))
+extract Embedding {extract = x} = x
+
+extractIgnoringError :: (Functor m, con m) => Embedding con e a -> m (Maybe a)
+extractIgnoringError e = extract e <&> fromRight Nothing
+
+dimapEmbedding
+  :: (a -> Either e b)
+  -> (b -> a)
+  -> Embedding con e a
+  -> Embedding con e b
+dimapEmbedding g f Embedding {embed = embed', extract = extract'} =
+  Embedding
+    { embed = embed' . fmap f
+    , extract =
+        extract' <&> \case
+          Left e -> Left e
+          Right Nothing -> Right Nothing
+          Right (Just x) -> Just <$> g x
+    }
diff --git a/internal/Internal/Prelude.hs b/internal/Internal/Prelude.hs
new file mode 100644
--- /dev/null
+++ b/internal/Internal/Prelude.hs
@@ -0,0 +1,86 @@
+module Internal.Prelude
+  ( module X
+  )
+where
+
+import Control.Applicative as X (Applicative (..), empty, (<|>))
+import Control.Category as X ((>>>))
+import Control.Exception as X (Exception, SomeException (..))
+import Control.Exception.Annotated as X
+  ( checkpointCallStack
+  , throwWithCallStack
+  )
+import Control.Monad as X
+  ( Monad (..)
+  , guard
+  , join
+  , replicateM
+  , replicateM_
+  , when
+  , (<=<)
+  , (=<<)
+  , (>=>)
+  )
+import Control.Monad.Catch as X (MonadThrow, throwM)
+import Control.Monad.Except as X (MonadError, throwError)
+import Control.Monad.Fail as X (fail)
+import Control.Monad.IO.Class as X (MonadIO (liftIO))
+import Control.Monad.Reader as X (ReaderT)
+import Control.Monad.Trans as X (MonadTrans (lift))
+import Control.Monad.Trans.Identity as X (IdentityT (..))
+import Data.Bifunctor as X (bimap)
+import Data.Bool as X
+import Data.ByteString as X (ByteString)
+import Data.Char as X (Char)
+import Data.Either as X (Either (..), either, fromRight)
+import Data.Eq as X (Eq, (/=), (==))
+import Data.Fixed as X (Fixed (MkFixed))
+import Data.Foldable as X (all, foldMap, for_, toList, traverse_)
+import Data.Function as X (const, flip, id, ($), (&), (.))
+import Data.Functor as X (Functor, fmap, void, ($>), (<$>), (<&>))
+import Data.Kind as X (Constraint, Type)
+import Data.List as X (concat, concatMap, filter)
+import Data.List.NonEmpty as X (nonEmpty)
+import Data.Map as X (Map)
+import Data.Maybe as X
+  ( Maybe (..)
+  , catMaybes
+  , fromMaybe
+  , isJust
+  , isNothing
+  , maybe
+  )
+import Data.Ord as X (Ord (..))
+import Data.Semigroup as X ((<>))
+import Data.Sequence as X (Seq)
+import Data.Set as X (Set)
+import Data.String as X (String)
+import Data.Text as X (Text)
+import Data.Traversable as X (for)
+import Data.Tuple as X (fst, snd, swap)
+import Data.Type.Equality as X
+import GHC.Stack as X (HasCallStack)
+import Numeric.Natural as X (Natural)
+import System.IO as X (IO)
+import Text.Read as X (Read, readMaybe)
+import Text.Show as X (Show, show)
+import Prelude as X
+  ( Bounded
+  , Enum
+  , Int
+  , Integral
+  , fromIntegral
+  , minimum
+  , negate
+  , pred
+  , succ
+  , truncate
+  , ($!)
+  , (*)
+  , (+)
+  , (-)
+  , (/)
+  )
+
+{-# ANN module ("HLint: ignore Avoid restricted alias" :: String) #-}
+{-# ANN module ("HLint: ignore Avoid restricted qualification" :: String) #-}
diff --git a/internal/Randomization.hs b/internal/Randomization.hs
new file mode 100644
--- /dev/null
+++ b/internal/Randomization.hs
@@ -0,0 +1,51 @@
+module Randomization
+  ( Randomization (..)
+  , deterministicallyRandom
+  , DeterministicRandomization (..)
+  , hoistRandomization
+  , defaultRandomization
+  ) where
+
+import Internal.Prelude
+
+import Crypto.Random (ChaChaDRG, DRG (randomBytesGenerate), drgNew)
+import Data.IORef (atomicModifyIORef', newIORef)
+
+-- | General means of obtaining randomness
+newtype Randomization m = Randomization
+  { getRandomBytes :: Natural -> m ByteString
+  -- ^ Given a requested number of bytes, this action
+  --   should produce a 'ByteString' of that length.
+  }
+
+hoistRandomization
+  :: (forall a. m a -> m' a) -> Randomization m -> Randomization m'
+hoistRandomization f (Randomization g) = Randomization (f . g)
+
+-- | Convert from a deterministic generator to an effectful one
+deterministicallyRandom
+  :: DeterministicRandomization -> IO (Randomization IO)
+deterministicallyRandom =
+  liftIO . newIORef >=> pure . \ref ->
+    Randomization $ \n ->
+      liftIO $ atomicModifyIORef' ref $ \(DeterministicRandomization gen) ->
+        swap $ gen n
+
+-- | A deterministic random generator
+newtype DeterministicRandomization = DeterministicRandomization
+  { nextRandomBytes :: Natural -> (ByteString, DeterministicRandomization)
+  -- ^ Given a requested number of bytes, this function should give a
+  --   'ByteString' of that length and a new deterministic generator.
+  }
+
+-- | Cryptographically secure deterministic randomization seeded from
+--   system entropy using @ChaChaDRG@ from the @crypton@ package
+defaultRandomization :: IO (Randomization IO)
+defaultRandomization =
+  deterministicallyRandom . makeDeterministicRandomization =<< liftIO drgNew
+ where
+  makeDeterministicRandomization :: ChaChaDRG -> DeterministicRandomization
+  makeDeterministicRandomization drg =
+    DeterministicRandomization $ \n ->
+      let (bs, drg') = randomBytesGenerate (fromIntegral n) drg
+      in  (bs, makeDeterministicRandomization drg')
diff --git a/internal/Session/Freeze.hs b/internal/Session/Freeze.hs
new file mode 100644
--- /dev/null
+++ b/internal/Session/Freeze.hs
@@ -0,0 +1,9 @@
+module Session.Freeze
+  ( SessionFreeze (..)
+  ) where
+
+import Internal.Prelude
+
+data SessionFreeze
+  = FreezeSessionForCurrentRequest
+  deriving stock (Eq, Ord, Show, Read, Bounded, Enum)
diff --git a/internal/Session/Key.hs b/internal/Session/Key.hs
new file mode 100644
--- /dev/null
+++ b/internal/Session/Key.hs
@@ -0,0 +1,62 @@
+module Session.Key
+  ( SessionKey (..)
+  , SessionKeyManager (..)
+  , makeSessionKeyManager
+  , sessionKeyToCookieValue
+  , sessionKeyFromCookieValue
+  )
+where
+
+import Internal.Prelude
+
+import Data.ByteString.Base64.URL qualified as B64URL
+import Data.ByteString.Char8 qualified as BS8
+import Data.Text qualified as T
+import Data.Text.Encoding (decodeUtf8', encodeUtf8)
+import Randomization
+
+data SessionKeyManager m = SessionKeyManager
+  { new :: m SessionKey
+  -- ^ Generate a new session key
+  --
+  -- In a production setting, it is critical that this action be
+  -- thread-safe and produce a securely random result.
+  , check :: SessionKey -> Bool
+  -- ^ Validate that a text is something that plausibly could have
+  --   been generated by 'new'.
+  }
+
+-- | Secret value that is sent to and subsequently furnished by
+--   the client to identify the session
+newtype SessionKey = SessionKey {text :: Text}
+  deriving newtype (Eq, Ord, Show)
+
+makeSessionKeyManager :: Monad m => Randomization m -> SessionKeyManager m
+makeSessionKeyManager (Randomization generateRandomBytes) =
+  let
+    new = SessionKey . B64URL.encodeBase64 <$> generateRandomBytes keyLengthInBytes
+
+    check (SessionKey text) =
+      T.length text
+        == keyLengthAsText
+        && either
+          (const False)
+          ((== keyLengthInBytes) . BS8.length)
+          (B64URL.decodeBase64 $ encodeUtf8 text)
+  in
+    SessionKeyManager {new, check}
+
+-- We generate 18-byte session keys. This number is rather arbitrary.
+keyLengthInBytes :: Integral a => a
+keyLengthInBytes = 18
+
+-- 18 bytes in base64 encoding ends up being a text 24 characters
+keyLengthAsText :: Integral a => a
+keyLengthAsText = 24
+
+sessionKeyToCookieValue :: SessionKey -> ByteString
+sessionKeyToCookieValue = (.text) >>> encodeUtf8
+
+sessionKeyFromCookieValue :: ByteString -> Maybe SessionKey
+sessionKeyFromCookieValue v =
+  decodeUtf8' v & either (const Nothing) Just <&> SessionKey
diff --git a/internal/Session/KeyRotation.hs b/internal/Session/KeyRotation.hs
new file mode 100644
--- /dev/null
+++ b/internal/Session/KeyRotation.hs
@@ -0,0 +1,12 @@
+module Session.KeyRotation
+  ( KeyRotation (..)
+  ) where
+
+import Internal.Prelude
+
+-- | /Key rotation/ means we delete the session on the server
+--   and copy the stored data into a new session with a different key.
+data KeyRotation
+  = -- | Generate a new session key and invalidate the old one
+    RotateSessionKey
+  deriving stock (Eq, Ord, Show, Read, Bounded, Enum)
diff --git a/internal/Session/Timing/Math.hs b/internal/Session/Timing/Math.hs
new file mode 100644
--- /dev/null
+++ b/internal/Session/Timing/Math.hs
@@ -0,0 +1,37 @@
+module Session.Timing.Math
+  ( nextExpires
+  , isExpired
+  ) where
+
+import Internal.Prelude
+
+import Session.Timing.Time
+import Session.Timing.Timeout
+import Time
+
+-- | Calculate the next point in time where the given session
+--   will expire assuming that it sees no activity until then
+--
+-- Returns 'Nothing' iff the settings do not specify any timeout limits.
+nextExpires
+  :: Timeout NominalDiffTime
+  -> Time UTCTime
+  -- ^ A session's timing information
+  -> Maybe UTCTime
+nextExpires timeout time =
+  (fmap minimum . nonEmpty . catMaybes)
+    [ flip addUTCTime time.accessed <$> timeout.idle
+    , flip addUTCTime time.created <$> timeout.absolute
+    ]
+
+-- | Check if a session has expired
+isExpired
+  :: Timeout NominalDiffTime
+  -- ^ Settings
+  -> UTCTime
+  -- ^ Now
+  -> Time UTCTime
+  -- ^ A session's timing information
+  -> Bool
+isExpired timeout now time =
+  maybe False (<= now) $ nextExpires timeout time
diff --git a/internal/Session/Timing/Options.hs b/internal/Session/Timing/Options.hs
new file mode 100644
--- /dev/null
+++ b/internal/Session/Timing/Options.hs
@@ -0,0 +1,34 @@
+module Session.Timing.Options
+  ( TimingOptions (..)
+  , defaultTimingOptions
+  ) where
+
+import Internal.Prelude
+
+import Session.Timing.Timeout
+import Time
+
+-- | Time duration settings
+--
+-- See 'defaultTimingOptions'.
+data TimingOptions a = TimingOptions
+  { timeout :: Timeout a
+  -- ^ How long sessions are allowed to live
+  , resolution :: Maybe a
+  -- ^ If @'Just' resolution@, this setting provides an optimization that can prevent
+  --   excessive database writes. If the only thing that needs to be updated is the
+  --   session's last access time, the write will be skipped if the previously recorded
+  --   access time is within @resolution@ long ago.
+  }
+  deriving stock (Eq, Show)
+
+-- | Default timing options
+--
+--   - timeout = 'defaultTimeout'
+--   - resolution = 10 minutes
+defaultTimingOptions :: TimingOptions NominalDiffTime
+defaultTimingOptions =
+  TimingOptions
+    { timeout = defaultTimeout
+    , resolution = Just $ minutes 10
+    }
diff --git a/internal/Session/Timing/Time.hs b/internal/Session/Timing/Time.hs
new file mode 100644
--- /dev/null
+++ b/internal/Session/Timing/Time.hs
@@ -0,0 +1,18 @@
+module Session.Timing.Time
+  ( Time (..)
+  ) where
+
+import Internal.Prelude
+
+-- | Creation and access times, used to determine session expiration
+data Time a = Time
+  { created :: a
+  -- ^ When the session was created
+  --
+  -- This is used to apply the absolute timeout.
+  , accessed :: a
+  -- ^ When the session was last accessed
+  --
+  -- This is used to apply the idle timeout.
+  }
+  deriving stock (Eq, Show)
diff --git a/internal/Session/Timing/Timeout.hs b/internal/Session/Timing/Timeout.hs
new file mode 100644
--- /dev/null
+++ b/internal/Session/Timing/Timeout.hs
@@ -0,0 +1,41 @@
+module Session.Timing.Timeout
+  ( Timeout (..)
+  , defaultTimeout
+  ) where
+
+import Internal.Prelude
+
+import Time
+
+-- | How long sessions are allowed to live
+--
+-- See 'defaultTimeout'.
+data Timeout a = Timeout
+  { idle :: Maybe a
+  -- ^ The amount of time a session will remain active in case there
+  --   is no activity in the session
+  --
+  -- This is used both on the client side (by setting the cookie expires fields)
+  -- and on the server.
+  --
+  -- Setting to 'Nothing' removes the idle timeout.
+  , absolute :: Maybe a
+  -- ^ The maximum amount of time a session can be active
+  --
+  -- This is used both on the client side (by setting the cookie expires fields)
+  -- and on the server side.
+  --
+  -- Setting to 'Nothing' removes the absolute timeout.
+  }
+  deriving stock (Eq, Show)
+
+-- | Default timeouts
+--
+--   - idle = 8 hours
+--   - absolute = 30 days
+defaultTimeout :: Timeout NominalDiffTime
+defaultTimeout =
+  Timeout
+    { idle = Just $ hours 8
+    , absolute = Just $ days 30
+    }
diff --git a/internal/Session/TransportSecurity.hs b/internal/Session/TransportSecurity.hs
new file mode 100644
--- /dev/null
+++ b/internal/Session/TransportSecurity.hs
@@ -0,0 +1,21 @@
+module Session.TransportSecurity
+  ( TransportSecurity (..)
+  , cookieSecure
+  ) where
+
+import Internal.Prelude
+
+data TransportSecurity
+  = -- | Only allow cookies on HTTPS connections
+    --
+    -- Set this in production.
+    RequireSecureTransport
+  | -- | Allow cookies over either HTTP or HTTPS
+    --
+    -- This is okay for development.
+    AllowPlaintextTranport
+
+cookieSecure :: TransportSecurity -> Bool
+cookieSecure = \case
+  RequireSecureTransport -> True
+  AllowPlaintextTranport -> False
diff --git a/internal/Time.hs b/internal/Time.hs
new file mode 100644
--- /dev/null
+++ b/internal/Time.hs
@@ -0,0 +1,38 @@
+module Time
+  ( subtractUTCTime
+  , minutes
+  , hours
+  , days
+  , years
+  , module X
+  ) where
+
+import Internal.Prelude
+
+import Data.Time as X
+  ( NominalDiffTime
+  , UTCTime (..)
+  , addUTCTime
+  , diffUTCTime
+  , nominalDay
+  , nominalDiffTimeToSeconds
+  , secondsToDiffTime
+  , secondsToNominalDiffTime
+  )
+import Data.Time.Calendar.OrdinalDate as X (fromOrdinalDate)
+import Data.Time.Clock.System as X (systemEpochDay)
+
+subtractUTCTime :: NominalDiffTime -> UTCTime -> UTCTime
+subtractUTCTime d t = addUTCTime (negate d) t
+
+minutes :: NominalDiffTime -> NominalDiffTime
+minutes = (* 60)
+
+hours :: NominalDiffTime -> NominalDiffTime
+hours = (* 60) . minutes
+
+days :: NominalDiffTime -> NominalDiffTime
+days = (* 24) . hours
+
+years :: NominalDiffTime -> NominalDiffTime
+years = (* 365.2) . days
diff --git a/internal/Yesod/Session/Cookie/Logic.hs b/internal/Yesod/Session/Cookie/Logic.hs
new file mode 100644
--- /dev/null
+++ b/internal/Yesod/Session/Cookie/Logic.hs
@@ -0,0 +1,51 @@
+module Yesod.Session.Cookie.Logic
+  ( setCookie
+  , CookieContext (..)
+  ) where
+
+import Internal.Prelude
+
+import Yesod.Core.Types (Header)
+import Yesod.Session.Cookie.SetCookie
+import Yesod.Session.Options
+import Yesod.Session.SaveResult
+import Yesod.Session.SessionType
+
+data CookieContext = CookieContext
+  { cookie :: Maybe ByteString
+  , load :: Maybe Session
+  , save :: SaveResult Session
+  }
+
+setCookie :: Options tx m -> CookieContext -> [Header]
+setCookie options = \case
+  CookieContext {save = Frozen} ->
+    -- Never send anything when a freeze was requested.
+    []
+  CookieContext {save = Deleted} ->
+    -- There was a session but it's now gone; send deletion
+    -- cookies so the client can forget all about it.
+    cookiesForSession Nothing
+  CookieContext {save = Saved s} ->
+    -- Any time a session was saved, send cookies.
+    -- At the very least this will probably be wanted to give
+    -- the client a new expiration time.
+    cookiesForSession (Just s)
+  CookieContext {save = NoChange, load = Just s} ->
+    -- There was a session loaded but change saved; send cookies
+    -- for the session that was loaded. This is probably superfluous.
+    -- It will only be useful if the server's timeout settings
+    -- have changed. But it's low cost, so might as well do it.
+    cookiesForSession (Just s)
+  CookieContext {save = NoChange, load = Nothing, cookie = Nothing} ->
+    -- No cookie was sent, no session was loaded, no change was saved.
+    -- There is nothing to send.
+    []
+  CookieContext {save = NoChange, load = Nothing, cookie = Just _} ->
+    -- The client sent a cookie but it did not result in a session load,
+    -- and there is no new session key to send. Send a deletion to put
+    -- this worthless session cookie out of its misery.
+    cookiesForSession Nothing
+ where
+  cookiesForSession :: Maybe Session -> [Header]
+  cookiesForSession = makeSetCookieHeaders options . fmap (\s -> (s.key, s.time))
diff --git a/internal/Yesod/Session/Cookie/Reading.hs b/internal/Yesod/Session/Cookie/Reading.hs
new file mode 100644
--- /dev/null
+++ b/internal/Yesod/Session/Cookie/Reading.hs
@@ -0,0 +1,24 @@
+module Yesod.Session.Cookie.Reading
+  ( findSessionKey
+  )
+where
+
+import Internal.Prelude
+
+import Network.HTTP.Types.Header
+import Network.Wai
+import Web.Cookie
+
+-- | Find a session key in the request
+findSessionKey :: ByteString -> Request -> Maybe ByteString
+findSessionKey cookieNameBS =
+  one
+    . concatMap (lookupAll cookieNameBS . parseCookies)
+    . lookupAll hCookie
+    . requestHeaders
+
+one :: [a] -> Maybe a
+one = \case [x] -> Just x; _ -> Nothing
+
+lookupAll :: Eq a => a -> [(a, b)] -> [b]
+lookupAll a = fmap snd . filter ((== a) . fst)
diff --git a/internal/Yesod/Session/Cookie/SetCookie.hs b/internal/Yesod/Session/Cookie/SetCookie.hs
new file mode 100644
--- /dev/null
+++ b/internal/Yesod/Session/Cookie/SetCookie.hs
@@ -0,0 +1,60 @@
+module Yesod.Session.Cookie.SetCookie
+  ( makeSetCookieHeaders
+  ) where
+
+import Internal.Prelude
+
+import Data.Text.Encoding (encodeUtf8)
+import Session.Key
+import Session.Timing.Math
+import Session.Timing.Options
+import Session.Timing.Time
+import Session.Timing.Timeout
+import Session.TransportSecurity qualified as TransportSecurity
+import Time
+import Web.Cookie qualified as C
+import Yesod.Core.Types (Header (AddCookie))
+import Yesod.Session.Options
+
+makeSetCookieHeaders
+  :: Options tx m -> Maybe (SessionKey, Time UTCTime) -> [Header]
+makeSetCookieHeaders options =
+  (: []) <$> maybe (deleteCookie options) (createCookie options)
+
+cookieNameBS :: Options tx m -> ByteString
+cookieNameBS options = encodeUtf8 options.cookieName
+
+-- | Create a cookie for the given session
+createCookie :: Options tx m -> (SessionKey, Time UTCTime) -> Header
+createCookie options (key, time) =
+  AddCookie
+    C.def
+      { C.setCookieName = cookieNameBS options
+      , C.setCookieValue = sessionKeyToCookieValue key
+      , C.setCookiePath = Just "/"
+      , C.setCookieExpires = Just $ cookieExpires options.timing.timeout time
+      , C.setCookieDomain = Nothing
+      , C.setCookieHttpOnly = True
+      , C.setCookieSecure = TransportSecurity.cookieSecure options.transportSecurity
+      }
+
+-- | Remove the session cookie from the client
+deleteCookie :: Options tx m -> Header
+deleteCookie options =
+  AddCookie
+    C.def
+      { C.setCookieName = cookieNameBS options
+      , C.setCookieValue = ""
+      , C.setCookiePath = Just "/"
+      , C.setCookieExpires = Just $ UTCTime systemEpochDay 1
+      , C.setCookieMaxAge = Just 0
+      , C.setCookieDomain = Nothing
+      , C.setCookieHttpOnly = True
+      , C.setCookieSecure = TransportSecurity.cookieSecure options.transportSecurity
+      }
+
+-- | Calculate the date that should be used for the cookie's "expires" field
+cookieExpires :: Timeout NominalDiffTime -> Time UTCTime -> UTCTime
+cookieExpires timeout time =
+  fromMaybe (addUTCTime (years 10) time.accessed)
+    $ nextExpires timeout time
diff --git a/internal/Yesod/Session/Embedding/Map.hs b/internal/Yesod/Session/Embedding/Map.hs
new file mode 100644
--- /dev/null
+++ b/internal/Yesod/Session/Embedding/Map.hs
@@ -0,0 +1,62 @@
+module Yesod.Session.Embedding.Map
+  ( SessionMapEmbedding
+  , MapOperations (..)
+  , bsKeyEmbedding
+  , showReadKeyEmbedding
+  ) where
+
+import Internal.Prelude
+
+import Control.Monad.State (StateT (..))
+import Control.Monad.State qualified as State
+import Data.Map.Strict qualified as Map
+import Data.Text qualified as T
+import Data.Text.Encoding (decodeUtf8', encodeUtf8)
+import Embedding
+import Yesod.Core (HandlerFor, deleteSession, lookupSessionBS, setSessionBS)
+
+-- | Specifies how we represent some value within a 'SessionMap'
+--
+-- We use this to sort of abuse the session; key rotation and freezing are
+-- done by embedding special values among the session data. These special
+-- values are extracted from the map before persisting to storage and are
+-- never actually saved.
+type SessionMapEmbedding a = Embedding (MapOperations Text ByteString) () a
+
+-- | A monadic context with operations over some 'Map'-like state
+--
+-- This allows us to generalize between pure operations over 'Map' and
+-- the more limited session manipulation utilities afforded by Yesod.
+-- (See the instance list for this class.)
+class (Monad m, Ord k) => MapOperations k v m | m -> k v where
+  lookup :: k -> m (Maybe v)
+  assign :: k -> Maybe v -> m ()
+
+instance MapOperations Text ByteString (HandlerFor site) where
+  lookup k = lookupSessionBS k
+  assign k v = maybe (deleteSession k) (setSessionBS k) v
+
+instance (Monad m, Ord k) => MapOperations k v (StateT (Map k v) m) where
+  lookup k = State.gets $ Map.lookup k
+  assign k v = State.modify' $ Map.alter (const v) k
+
+-- | An embedding which stores a value at some particular key in a map-like structure
+bsKeyEmbedding :: k -> Embedding (MapOperations k a) e a
+bsKeyEmbedding key =
+  Embedding
+    { embed = assign key
+    , extract = fmap Right $ lookup key <* assign key Nothing
+    }
+
+-- | Represents a value in a 'SessionMap' by storing the
+--   UTF-8 encoding of its 'show' representation at the given key
+showReadKeyEmbedding
+  :: (Read a, Show a) => k -> Embedding (MapOperations k ByteString) () a
+showReadKeyEmbedding k =
+  dimapEmbedding
+    ( maybe (throwError ()) pure
+        . readMaybe
+        <=< (bimap (const ()) T.unpack . decodeUtf8')
+    )
+    (encodeUtf8 . T.pack . show)
+    (bsKeyEmbedding k)
diff --git a/internal/Yesod/Session/Embedding/Options.hs b/internal/Yesod/Session/Embedding/Options.hs
new file mode 100644
--- /dev/null
+++ b/internal/Yesod/Session/Embedding/Options.hs
@@ -0,0 +1,25 @@
+module Yesod.Session.Embedding.Options
+  ( SessionEmbeddings (..)
+  , HasSessionEmbeddings (..)
+  ) where
+
+import Internal.Prelude
+
+import Session.Freeze
+import Session.KeyRotation
+import Yesod.Session.Embedding.Map
+
+data SessionEmbeddings = SessionEmbeddings
+  { keyRotation :: SessionMapEmbedding KeyRotation
+  -- ^ How to represent a key rotation instruction in the session data;
+  --   see 'Yesod.Session.Persist.assignSessionKeyRotation'
+  , freeze :: SessionMapEmbedding SessionFreeze
+  -- ^ How to represent a freeze instruction in the session data;
+  --   see 'Yesod.Session.Persist.assignSessionFreeze'
+  }
+
+class HasSessionEmbeddings a where
+  getSessionEmbeddings :: a -> SessionEmbeddings
+
+instance HasSessionEmbeddings SessionEmbeddings where
+  getSessionEmbeddings = id
diff --git a/internal/Yesod/Session/Freeze.hs b/internal/Yesod/Session/Freeze.hs
new file mode 100644
--- /dev/null
+++ b/internal/Yesod/Session/Freeze.hs
@@ -0,0 +1,30 @@
+module Yesod.Session.Freeze
+  ( disableSessionManagement
+  , assignSessionFreeze
+  ) where
+
+import Internal.Prelude
+
+import Embedding
+import Session.Freeze
+import Yesod.Core (HandlerSite, MonadHandler (liftHandler), getYesod)
+import Yesod.Session.Embedding.Options
+
+-- | Indicate whether the session should be frozen for the handling
+--   of the current request
+--
+-- At the end of the request handler, if the value is 'Just', no
+-- database actions will be performed and no cookies will be set.
+assignSessionFreeze
+  :: (MonadHandler m, HasSessionEmbeddings (HandlerSite m))
+  => Maybe SessionFreeze
+  -- ^ 'Just' to freeze the session, or 'Nothing' to cancel any previous
+  --   request for session freezing and restore the default behavior
+  -> m ()
+assignSessionFreeze f = do
+  embedding <- getSessionEmbeddings <$> getYesod
+  liftHandler $ embed embedding.freeze f
+
+disableSessionManagement
+  :: (MonadHandler m, HasSessionEmbeddings (HandlerSite m)) => m ()
+disableSessionManagement = assignSessionFreeze (Just FreezeSessionForCurrentRequest)
diff --git a/internal/Yesod/Session/KeyRotation.hs b/internal/Yesod/Session/KeyRotation.hs
new file mode 100644
--- /dev/null
+++ b/internal/Yesod/Session/KeyRotation.hs
@@ -0,0 +1,38 @@
+module Yesod.Session.KeyRotation
+  ( rotateSessionKey
+  , assignSessionKeyRotation
+  ) where
+
+import Internal.Prelude
+
+import Embedding
+import Session.KeyRotation
+import Yesod.Core (HandlerSite, MonadHandler (liftHandler), getYesod)
+import Yesod.Session.Embedding.Options
+
+-- | Indicate whether the current session key should be rotated
+--
+-- The key rotation does not occur immediately;
+-- this action only places a value into the session map.
+--
+-- Later calls to 'assignSessionKeyRotation' on the same handler will
+-- override earlier calls.
+--
+-- At the end of the request handler, if the value is 'Just',
+-- the session key will be rotated.
+--
+-- The session variable set by this function is then discarded
+-- and is not persisted across requests.
+assignSessionKeyRotation
+  :: (MonadHandler m, HasSessionEmbeddings (HandlerSite m))
+  => Maybe KeyRotation
+  -- ^ 'Just' to rotate, or 'Nothing' to cancel any previous
+  --   request for rotation and restore the default behavior
+  -> m ()
+assignSessionKeyRotation kr = do
+  embedding <- getSessionEmbeddings <$> getYesod
+  liftHandler $ embed embedding.keyRotation kr
+
+rotateSessionKey
+  :: (MonadHandler m, HasSessionEmbeddings (HandlerSite m)) => m ()
+rotateSessionKey = assignSessionKeyRotation (Just RotateSessionKey)
diff --git a/internal/Yesod/Session/Manager.hs b/internal/Yesod/Session/Manager.hs
new file mode 100644
--- /dev/null
+++ b/internal/Yesod/Session/Manager.hs
@@ -0,0 +1,35 @@
+module Yesod.Session.Manager
+  ( SessionManager (..)
+  , sessionKeyAppearsReasonable
+  , checkedSessionKeyFromCookieValue
+  , newSessionKey
+  ) where
+
+import Internal.Prelude
+
+import Session.Key
+import Yesod.Session.Options
+import Yesod.Session.Storage.Operation
+
+-- | Server-wide state for the session mechanism
+data SessionManager tx m = SessionManager
+  { keyManager :: SessionKeyManager tx
+  -- ^ A random session key generator
+  , storage :: forall a. StorageOperation a -> tx a
+  -- ^ The storage backend
+  , options :: Options tx m
+  , runTransaction :: forall a. tx a -> m a
+  }
+
+sessionKeyAppearsReasonable :: SessionManager tx m -> SessionKey -> Bool
+sessionKeyAppearsReasonable SessionManager {keyManager = SessionKeyManager {check}} = check
+
+checkedSessionKeyFromCookieValue
+  :: SessionManager tx m -> ByteString -> Maybe SessionKey
+checkedSessionKeyFromCookieValue x =
+  sessionKeyFromCookieValue
+    >=> (\v -> guard (sessionKeyAppearsReasonable x v) $> v)
+
+newSessionKey :: SessionManager tx m -> m SessionKey
+newSessionKey SessionManager {keyManager, runTransaction} =
+  runTransaction keyManager.new
diff --git a/internal/Yesod/Session/Manager/Load.hs b/internal/Yesod/Session/Manager/Load.hs
new file mode 100644
--- /dev/null
+++ b/internal/Yesod/Session/Manager/Load.hs
@@ -0,0 +1,57 @@
+module Yesod.Session.Manager.Load
+  ( loadSessionMaybe
+  , loadSession
+  , loadNothing
+  , Load (..)
+  , didSessionLoad
+  , loadedData
+  ) where
+
+import Internal.Prelude
+
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
+import Data.Map.Strict qualified as Map
+import Session.Key
+import Session.Timing.Math
+import Session.Timing.Options
+import Time
+import Yesod.Core (SessionMap)
+import Yesod.Session.Manager
+import Yesod.Session.Options
+import Yesod.Session.SessionType
+import Yesod.Session.Storage.Operation
+
+data Load a = Load
+  { got :: Maybe a
+  -- ^ The original session that was loaded from the database, if any
+  , time :: UTCTime
+  -- ^ The time at which the session was loaded
+  }
+  deriving stock (Eq, Show)
+
+didSessionLoad :: Load a -> Bool
+didSessionLoad = isJust . (.got)
+
+loadedData :: Load Session -> SessionMap
+loadedData load =
+  maybe Map.empty (.map) load.got
+
+loadSession :: Monad m => SessionManager tx m -> SessionKey -> m (Load Session)
+loadSession SessionManager {options, storage, runTransaction} sessionKey = do
+  now <- options.clock
+  got <-
+    runMaybeT $ do
+      session <-
+        MaybeT $ runTransaction $ storage $ GetSession sessionKey
+      MaybeT $ pure $ guard $ not $ isExpired options.timing.timeout now session.time
+      pure session
+  pure Load {got, time = now}
+
+loadNothing :: Monad m => SessionManager tx m -> m (Load a)
+loadNothing SessionManager {options} = do
+  now <- options.clock
+  pure Load {got = Nothing, time = now}
+
+loadSessionMaybe
+  :: Monad m => SessionManager tx m -> Maybe SessionKey -> m (Load Session)
+loadSessionMaybe sm = maybe (loadNothing sm) (loadSession sm)
diff --git a/internal/Yesod/Session/Manager/Save.hs b/internal/Yesod/Session/Manager/Save.hs
new file mode 100644
--- /dev/null
+++ b/internal/Yesod/Session/Manager/Save.hs
@@ -0,0 +1,62 @@
+module Yesod.Session.Manager.Save
+  ( saveSession
+  ) where
+
+import Internal.Prelude
+
+import Comparison
+import Control.Monad.State qualified as State
+import Embedding
+import Session.Freeze
+import Session.KeyRotation
+import Yesod.Core (SessionMap)
+import Yesod.Session.Embedding.Options
+import Yesod.Session.Manager
+import Yesod.Session.Manager.Load
+import Yesod.Session.Options
+import Yesod.Session.SaveResult
+import Yesod.Session.SessionType
+import Yesod.Session.Storage.Operation
+import Yesod.Session.Storage.Save qualified as Storage
+
+-- | Save the session on the storage backend
+--
+-- A 'SessionLoad' given by 'loadSession' is expected besides
+-- the new contents of the session.
+--
+-- Returns 'Nothing' if the session was empty and didn't need to be saved.
+-- Note that this does /not/ necessarily means that nothing was done.
+-- If you ask for a session key to be rotated and clear every other sesssion
+-- variable, then 'saveSession' will delete the older session but will
+-- avoid creating a new, empty one.
+saveSession
+  :: Monad tx
+  => SessionManager tx m
+  -> Load Session
+  -> SessionMap
+  -> m (SaveResult Session)
+saveSession SessionManager {options, storage, keyManager, runTransaction} load outputData =
+  runTransaction
+    $ case freeze of
+      Just FreezeSessionForCurrentRequest -> pure Frozen
+      Nothing ->
+        case (load.got, rotation) of
+          (Just s, Just RotateSessionKey) -> do
+            storage $ DeleteSession s.key
+            maybe Deleted Saved <$> save Nothing
+          _ -> maybe NoChange Saved <$> save load.got
+ where
+  ((requestedRotation, freeze), newInfo) =
+    flip State.runState outputData
+      $ (,)
+      <$> extractIgnoringError options.embedding.keyRotation
+      <*> extractIgnoringError options.embedding.freeze
+
+  autoRotation =
+    options.keyRotationTrigger
+      Comparison {old = loadedData load, new = newInfo}
+
+  rotation = requestedRotation <|> autoRotation
+
+  save oldSessionMaybe =
+    Storage.save options storage keyManager load.time newInfo oldSessionMaybe
diff --git a/internal/Yesod/Session/Options.hs b/internal/Yesod/Session/Options.hs
new file mode 100644
--- /dev/null
+++ b/internal/Yesod/Session/Options.hs
@@ -0,0 +1,79 @@
+module Yesod.Session.Options
+  ( Options (..)
+  , defaultOptions
+  , hoistOptions
+  ) where
+
+import Internal.Prelude
+
+import Comparison
+import Data.Time qualified as Time
+import Randomization
+import Session.KeyRotation
+import Session.Timing.Options
+import Session.TransportSecurity
+import Time
+import Yesod.Core (SessionMap)
+import Yesod.Session.Embedding.Map
+import Yesod.Session.Embedding.Options
+
+-- | Settings that have defaults
+--
+-- See 'defaultOptions'.
+data Options tx m = Options
+  { cookieName :: Text
+  -- ^ The name of cookie where the session key will be saved
+  , timing :: TimingOptions NominalDiffTime
+  -- ^ Various time duration settings
+  , transportSecurity :: TransportSecurity
+  -- ^ Whether cookies require HTTPS
+  , embedding :: SessionEmbeddings
+  -- ^ How special session management indicators get smuggled through a 'SessionMap'
+  , clock :: m UTCTime
+  -- ^ How to determine the current time;
+  --   you can change this to a fake for testing
+  , randomization :: m (Randomization tx)
+  -- ^ Generator of random byte strings, used to contrive session keys
+  , keyRotationTrigger :: Comparison SessionMap -> Maybe KeyRotation
+  -- ^ At the end of request handling, compare old session data to new
+  --   session data to determine whether a key rotation should be performed
+  }
+
+-- | Default options
+--
+--   - cookieName = @"session-key"@
+--   - timing = 'defaultTimingOptions'
+--   - transportSecurity = 'AllowPlaintextTranport' (change this in production)
+--   - embedding.keyRotation = @'showReadKeyEmbedding' "session-key-rotation"@
+--   - embedding.freeze = @'showReadKeyEmbedding' "session-freeze"@
+--   - clock = 'Time.getCurrentTime'
+--   - randomization = 'defaultRandomization'
+--   - keyRotationTrigger = 'const' 'Nothing'
+defaultOptions :: Options IO IO
+defaultOptions =
+  Options
+    { cookieName = "session-key"
+    , timing = defaultTimingOptions
+    , transportSecurity = AllowPlaintextTranport
+    , clock = Time.getCurrentTime
+    , randomization = defaultRandomization
+    , embedding =
+        SessionEmbeddings
+          { keyRotation = showReadKeyEmbedding "session-key-rotation"
+          , freeze = showReadKeyEmbedding "session-freeze"
+          }
+    , keyRotationTrigger = const Nothing
+    }
+
+hoistOptions
+  :: Functor m2
+  => (forall a. tx1 a -> tx2 a)
+  -> (forall a. m1 a -> m2 a)
+  -> Options tx1 m1
+  -> Options tx2 m2
+hoistOptions f g Options {..} =
+  Options
+    { clock = g clock
+    , randomization = hoistRandomization f <$> g randomization
+    , ..
+    }
diff --git a/internal/Yesod/Session/Persist/Storage.hs b/internal/Yesod/Session/Persist/Storage.hs
new file mode 100644
--- /dev/null
+++ b/internal/Yesod/Session/Persist/Storage.hs
@@ -0,0 +1,59 @@
+module Yesod.Session.Persist.Storage
+  ( persistentStorage
+  , SessionPersistence (..)
+
+    -- * Persistent reëxports
+  , PersistEntity
+  , PersistEntityBackend
+  , SafeToInsert
+  , ConnectionPool
+  ) where
+
+import Internal.Prelude
+
+import Database.Persist (Key, PersistRecordBackend)
+import Database.Persist qualified as Persist
+import Database.Persist.Class
+  ( PersistEntity
+  , PersistEntityBackend
+  , SafeToInsert
+  )
+import Database.Persist.Sql (ConnectionPool)
+import Session.Key
+import Yesod.Session.SessionType
+import Yesod.Session.Storage.Exceptions
+import Yesod.Session.Storage.Operation
+
+-- | Mapping between 'Yesod.Session.Persist.Session' and
+--   a Persistent entity of your choice
+data SessionPersistence backend record m = ( PersistRecordBackend record backend
+                                           , Persist.PersistStoreWrite backend
+                                           , SafeToInsert record
+                                           ) =>
+  SessionPersistence
+  { databaseKey :: SessionKey -> Key record
+  , toDatabase :: Session -> record
+  , fromDatabase :: record -> Session
+  , runTransaction :: forall a. ReaderT backend IO a -> m a
+  }
+
+persistentStorage
+  :: forall record backend result m
+   . (PersistRecordBackend record backend, Persist.PersistStoreWrite backend)
+  => SessionPersistence backend record m
+  -> StorageOperation result
+  -> ReaderT backend IO result
+persistentStorage sp@SessionPersistence {} = \case
+  GetSession sessionKey ->
+    fmap sp.fromDatabase <$> Persist.get (sp.databaseKey sessionKey)
+  DeleteSession sessionKey ->
+    Persist.delete $ sp.databaseKey sessionKey
+  InsertSession session ->
+    persistentStorage sp (GetSession session.key) >>= \case
+      Nothing -> void $ Persist.insert $ sp.toDatabase session
+      Just old -> throwWithCallStack $ SessionAlreadyExists old session
+  ReplaceSession session ->
+    let key = sp.databaseKey session.key
+    in  Persist.get key >>= \case
+          Nothing -> throwWithCallStack $ SessionDoesNotExist session
+          Just _old -> void $ Persist.replace key $ sp.toDatabase session
diff --git a/internal/Yesod/Session/Persist/Yesod.hs b/internal/Yesod/Session/Persist/Yesod.hs
new file mode 100644
--- /dev/null
+++ b/internal/Yesod/Session/Persist/Yesod.hs
@@ -0,0 +1,89 @@
+module Yesod.Session.Persist.Yesod
+  ( -- * Concretely
+    makeSessionBackend
+  , SessionConfiguration (..)
+
+    -- * More general
+  , makeSessionBackend'
+  , SessionConfiguration' (..)
+
+    -- * Extra general
+  , makeSessionBackend''
+
+    -- * Reëxport
+  , SessionBackend
+  ) where
+
+import Internal.Prelude
+
+import Data.Text.Encoding (encodeUtf8)
+import Session.Key
+import Yesod.Core.Types (SessionBackend (..))
+import Yesod.Session.Cookie.Logic
+import Yesod.Session.Cookie.Reading
+import Yesod.Session.Manager
+import Yesod.Session.Manager.Load
+import Yesod.Session.Manager.Save
+import Yesod.Session.Options
+import Yesod.Session.Persist.Storage
+import Yesod.Session.Storage.Operation
+
+data SessionConfiguration persistentBackend persistentRecord = SessionConfiguration
+  { persistence :: SessionPersistence persistentBackend persistentRecord IO
+  -- ^ Mapping between 'Yesod.Session.Persist.Session' and your Persistent entity
+  , options :: Options (ReaderT persistentBackend IO) IO
+  -- ^ Various options that have defaults; see 'defaultOptions'
+  }
+
+-- | Use this to implement 'Yesod.Core.makeSessionBackend'.
+--
+-- The @session@ type parameter represents the Persistent entity
+-- you're using to store sessions
+-- (see the 'SessionPersistence' field of the configuration).
+makeSessionBackend
+  :: forall persistentBackend persistentRecord
+   . SessionConfiguration persistentBackend persistentRecord
+  -> IO SessionBackend
+makeSessionBackend configuration =
+  let SessionConfiguration {persistence, options} = configuration
+  in  case persistence of
+        SessionPersistence {runTransaction} ->
+          makeSessionBackend'
+            SessionConfiguration'
+              { storage = persistentStorage persistence
+              , options = options
+              , runTransaction
+              }
+
+data SessionConfiguration' session = forall tx.
+  Monad tx =>
+  SessionConfiguration'
+  { storage :: forall a. StorageOperation a -> tx a
+  , options :: Options tx IO
+  , runTransaction :: forall a. tx a -> IO a
+  }
+
+makeSessionBackend' :: SessionConfiguration' session -> IO SessionBackend
+makeSessionBackend' SessionConfiguration' {options = options :: Options tx m, ..} = do
+  keyManager :: SessionKeyManager tx <-
+    makeSessionKeyManager <$> options.randomization
+  let sessionManager = SessionManager {keyManager, storage, options, runTransaction}
+  pure $ makeSessionBackend'' sessionManager
+
+makeSessionBackend'' :: Monad tx => SessionManager tx IO -> SessionBackend
+makeSessionBackend'' sessionManager@SessionManager {options} =
+  SessionBackend
+    { sbLoadSession = \req -> do
+        let
+          cookie = findSessionKey (encodeUtf8 options.cookieName) req
+          sessionKeyMaybe = cookie >>= checkedSessionKeyFromCookieValue sessionManager
+
+        load <- loadSessionMaybe sessionManager sessionKeyMaybe
+
+        pure
+          ( loadedData load
+          , \newData -> do
+              save <- saveSession sessionManager load newData
+              pure $ setCookie options CookieContext {cookie, load = load.got, save}
+          )
+    }
diff --git a/internal/Yesod/Session/SaveResult.hs b/internal/Yesod/Session/SaveResult.hs
new file mode 100644
--- /dev/null
+++ b/internal/Yesod/Session/SaveResult.hs
@@ -0,0 +1,16 @@
+module Yesod.Session.SaveResult
+  ( SaveResult (..)
+  ) where
+
+import Internal.Prelude
+
+data SaveResult a
+  = -- | Nothing was done because a session freeze was requested
+    Frozen
+  | -- | There were no changes worth saving.
+    NoChange
+  | -- | A session was saved (either a new or existing session key).
+    Saved a
+  | -- | A session was deleted, and no new session was inserted.
+    Deleted
+  deriving stock (Eq, Ord, Show)
diff --git a/internal/Yesod/Session/SessionType.hs b/internal/Yesod/Session/SessionType.hs
new file mode 100644
--- /dev/null
+++ b/internal/Yesod/Session/SessionType.hs
@@ -0,0 +1,22 @@
+module Yesod.Session.SessionType
+  ( Session (..)
+  )
+where
+
+import Internal.Prelude
+
+import Session.Key
+import Session.Timing.Time
+import Time
+import Yesod.Core (SessionMap)
+
+-- | What a saved session looks like in the database
+data Session = Session
+  { key :: SessionKey
+  -- ^ Session key (primary key)
+  , map :: SessionMap
+  -- ^ Arbitrary session data
+  , time :: Time UTCTime
+  -- ^ Creation and access times, used to determine expiration
+  }
+  deriving stock (Eq, Show)
diff --git a/internal/Yesod/Session/Storage/Exceptions.hs b/internal/Yesod/Session/Storage/Exceptions.hs
new file mode 100644
--- /dev/null
+++ b/internal/Yesod/Session/Storage/Exceptions.hs
@@ -0,0 +1,22 @@
+module Yesod.Session.Storage.Exceptions
+  ( StorageException (..)
+  ) where
+
+import Internal.Prelude
+
+import Yesod.Session.SessionType (Session (..))
+
+-- | Common exceptions that may be thrown by any storage.
+data StorageException
+  = -- | Thrown when attempting to insert a new session and
+    --   another session with the same key already exists
+    SessionAlreadyExists
+      { existingSession :: Session
+      , newSession :: Session
+      }
+  | -- | Thrown when attempting to replace an existing session
+    --   but no session with the same key exists
+    SessionDoesNotExist
+      {newSession :: Session}
+  deriving stock (Eq, Show)
+  deriving anyclass (Exception)
diff --git a/internal/Yesod/Session/Storage/Operation.hs b/internal/Yesod/Session/Storage/Operation.hs
new file mode 100644
--- /dev/null
+++ b/internal/Yesod/Session/Storage/Operation.hs
@@ -0,0 +1,48 @@
+module Yesod.Session.Storage.Operation
+  ( StorageOperation (..)
+  , StorageOperation' (..)
+  ) where
+
+import Internal.Prelude
+
+import Session.Key
+import Yesod.Session.SessionType
+
+data StorageOperation'
+  = forall result. StorageOperation' (StorageOperation result)
+
+deriving stock instance Show StorageOperation'
+
+{- FOURMOLU_DISABLE -}
+
+instance Eq StorageOperation' where
+  (==) = \case
+    StorageOperation' a@GetSession{}     -> \case StorageOperation' b@GetSession{}     -> a == b; _ -> False
+    StorageOperation' a@DeleteSession{}  -> \case StorageOperation' b@DeleteSession{}  -> a == b; _ -> False
+    StorageOperation' a@InsertSession{}  -> \case StorageOperation' b@InsertSession{}  -> a == b; _ -> False
+    StorageOperation' a@ReplaceSession{} -> \case StorageOperation' b@ReplaceSession{} -> a == b; _ -> False
+
+{- FOURMOLU_ENABLE -}
+
+data StorageOperation result
+  = -- | Get the session for the given session key
+    --
+    --   Returns 'Nothing' if the session is not found.
+    result ~ Maybe Session => GetSession SessionKey
+  | -- | Delete the session with given session key
+    --
+    -- Does not do anything if the session is not found.
+    result ~ () => DeleteSession SessionKey
+  | -- | Insert a new session
+    --
+    -- Throws 'SessionAlreadyExists' if there already exists a session with the same key.
+    -- We only call this method after generating a fresh session key.
+    result ~ () => InsertSession Session
+  | -- | Replace the contents of a session
+    --
+    -- Throws 'SessionDoesNotExist' if there is no session with the given session key.
+    -- We only call this method when updating a session that is known to exist.
+    result ~ () => ReplaceSession Session
+
+deriving stock instance Eq (StorageOperation result)
+deriving stock instance Show (StorageOperation result)
diff --git a/internal/Yesod/Session/Storage/Save.hs b/internal/Yesod/Session/Storage/Save.hs
new file mode 100644
--- /dev/null
+++ b/internal/Yesod/Session/Storage/Save.hs
@@ -0,0 +1,82 @@
+module Yesod.Session.Storage.Save
+  ( save
+  ) where
+
+import Internal.Prelude
+
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
+import Data.Map.Strict qualified as Map
+import Session.Key
+import Session.Timing.Options
+import Session.Timing.Time
+import Time
+import Yesod.Core (SessionMap)
+import Yesod.Session.Options
+import Yesod.Session.SessionType
+import Yesod.Session.Storage.Operation
+
+-- | Save a session to the database
+--
+-- Return value of 'Nothing' indicates that no changes were made.
+-- 'Just' is returned when a session was saved, either by an insert
+-- or a replace operation.
+save
+  :: Monad tx
+  => Options tx m
+  -> (forall a. StorageOperation a -> tx a)
+  -> SessionKeyManager tx
+  -> UTCTime
+  -- ^ The current time
+  -> SessionMap
+  -- ^ The new session data to be saved
+  -> Maybe Session
+  -- ^ What's in the database
+  -> tx (Maybe Session)
+save options storage sessionKeyManager now newInfo oldSessionMaybe =
+  asumM
+    [ runMaybeT $ do
+        guardMaybeT $ isNothing oldSessionMaybe
+        guardMaybeT $ Map.null newInfo
+        pure Nothing
+    , runMaybeT $ do
+        -- If the data is the same and the old access time is within
+        -- the timeout resolution, just return the old session without
+        -- doing anything else.
+        res <- assertJust options.timing.resolution
+        old <- assertJust oldSessionMaybe
+        guardMaybeT $ old.map == newInfo
+        guardMaybeT $ diffUTCTime now old.time.accessed < res
+        pure Nothing
+    , runMaybeT $ do
+        oldSession <- assertJust oldSessionMaybe
+        let newSession =
+              Session
+                { key = oldSession.key
+                , map = newInfo
+                , time = Time {created = oldSession.time.created, accessed = now}
+                }
+        lift $ storage $ ReplaceSession newSession
+        pure $ Just newSession
+    ]
+    `orElseM` do
+      sessionKey <- sessionKeyManager.new
+      let newSession =
+            Session
+              { key = sessionKey
+              , map = newInfo
+              , time = Time {created = now, accessed = now}
+              }
+      storage $ InsertSession newSession
+      pure $ Just newSession
+
+orElseM :: Monad m => m (Maybe a) -> m a -> m a
+a `orElseM` b = a >>= maybe b pure
+
+asumM :: Monad m => [m (Maybe a)] -> m (Maybe a)
+asumM = \case [] -> pure Nothing; x : xs -> x >>= maybe (asumM xs) (pure . Just)
+
+guardMaybeT :: Monad m => Bool -> MaybeT m ()
+guardMaybeT = \case True -> pure (); False -> MaybeT (pure Nothing)
+
+assertJust :: Monad m => Maybe a -> MaybeT m a
+assertJust = MaybeT . pure
diff --git a/library/Yesod/Session/Persist.hs b/library/Yesod/Session/Persist.hs
new file mode 100644
--- /dev/null
+++ b/library/Yesod/Session/Persist.hs
@@ -0,0 +1,80 @@
+module Yesod.Session.Persist
+  ( -- * Setup
+    makeSessionBackend
+  , SessionConfiguration (..)
+
+    -- * Options
+  , Options (..)
+  , defaultOptions
+  , hoistOptions
+
+    -- * Timing
+  , TimingOptions (..)
+  , defaultTimingOptions
+
+    -- * Timeout
+  , Timeout (..)
+  , defaultTimeout
+
+    -- * Transport security
+  , TransportSecurity (..)
+
+    -- * Session data model
+  , Session (..)
+  , SessionKey (..)
+  , Time (..)
+
+    -- * Randomization
+  , Randomization (..)
+  , defaultRandomization
+  , deterministicallyRandom
+  , DeterministicRandomization (..)
+
+    -- * Storage
+  , SessionPersistence (..)
+  , StorageException (..)
+
+    -- * Key rotation
+  , rotateSessionKey
+  , assignSessionKeyRotation
+  , KeyRotation (..)
+
+    -- * Freezing
+  , disableSessionManagement
+  , assignSessionFreeze
+  , SessionFreeze (..)
+
+    -- * Session map embedding
+  , SessionEmbeddings (..)
+  , HasSessionEmbeddings (..)
+  , Embedding (..)
+  , SessionMapEmbedding
+  , MapOperations (..)
+  , bsKeyEmbedding
+  , dimapEmbedding
+  , showReadKeyEmbedding
+
+    -- * Comparison
+  , Comparison (..)
+  , differsOn
+  ) where
+
+import Comparison
+import Embedding
+import Randomization
+import Session.Freeze
+import Session.Key
+import Session.KeyRotation
+import Session.Timing.Options
+import Session.Timing.Time
+import Session.Timing.Timeout
+import Session.TransportSecurity
+import Yesod.Session.Embedding.Map
+import Yesod.Session.Embedding.Options
+import Yesod.Session.Freeze
+import Yesod.Session.KeyRotation
+import Yesod.Session.Options
+import Yesod.Session.Persist.Storage
+import Yesod.Session.Persist.Yesod
+import Yesod.Session.SessionType
+import Yesod.Session.Storage.Exceptions
diff --git a/package.yaml b/package.yaml
new file mode 100644
--- /dev/null
+++ b/package.yaml
@@ -0,0 +1,103 @@
+name: yesod-session-persist
+version: 0.0.0.0
+maintainer: Freckle Education
+category: Web
+github: freckle/yesod-session-persist
+synopsis: SQL session backend for Yesod
+description: |
+  Use Persistent to store Yesod sessions
+
+extra-doc-files:
+  - README.md
+  - CHANGELOG.md
+
+extra-source-files:
+  - package.yaml
+
+language: GHC2021
+
+ghc-options:
+  - -Weverything
+  - -Wno-all-missed-specialisations
+  - -Wno-missed-specialisations
+  - -Wno-missing-exported-signatures # re-enables missing-signatures
+  - -Wno-missing-import-lists
+  - -Wno-missing-kind-signatures
+  - -Wno-missing-local-signatures
+  - -Wno-missing-safe-haskell-mode
+  - -Wno-monomorphism-restriction
+  - -Wno-partial-fields
+  - -Wno-prepositive-qualified-module
+  - -Wno-safe
+  - -Wno-unsafe
+  - -fwrite-ide-info
+
+dependencies:
+  - base < 5
+
+default-extensions:
+  - AllowAmbiguousTypes
+  - DeriveAnyClass
+  - DerivingStrategies
+  - DuplicateRecordFields
+  - FunctionalDependencies
+  - GADTs
+  - ImpredicativeTypes
+  - LambdaCase
+  - NoFieldSelectors
+  - NoImplicitPrelude
+  - OverloadedRecordDot
+  - OverloadedStrings
+  - QuantifiedConstraints
+  - RecordWildCards
+  - TypeFamilies
+  - UndecidableInstances
+
+library:
+  source-dirs: library
+  dependencies:
+    - internal
+
+internal-libraries:
+  internal:
+    source-dirs: internal
+    dependencies:
+      - annotated-exception
+      - base64
+      - bytestring
+      - containers
+      - cookie
+      - crypton
+      - exceptions
+      - http-types
+      - mtl
+      - persistent
+      - text
+      - time
+      - transformers
+      - wai
+      - yesod-core
+
+tests:
+  spec:
+    main: Spec.hs
+    source-dirs: tests
+    ghc-options: -threaded -rtsopts "-with-rtsopts=-N"
+    dependencies:
+      - aeson
+      - containers
+      - cookie
+      - hspec
+      - internal
+      - mtl
+      - QuickCheck
+      - random
+      - stm
+      - text
+      - time
+      - wai
+      - wai-extra
+      - yesod
+      - yesod-core
+      - yesod-session-persist
+      - yesod-test
diff --git a/tests/Session/KeySpec.hs b/tests/Session/KeySpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Session/KeySpec.hs
@@ -0,0 +1,83 @@
+module Session.KeySpec
+  ( spec
+  ) where
+
+import Test.Prelude
+
+import Data.Set qualified as Set
+import Data.Text qualified as T
+import Data.Text.Encoding (encodeUtf8)
+import Session.Key
+import Yesod.Session.Manager
+
+spec :: Spec
+spec = context "SessionKeyManager" $ do
+  specify "generates 24-character text"
+    $ forAll (genMockInit id)
+    $ \mockInit -> ioProperty $ do
+      Mock {sessionManager} <- newMock id mockInit
+      sessionKey <- newSessionKey sessionManager
+      pure $ T.length sessionKey.text == 24
+
+  specify "uses only letters, numbers, dash, underscore"
+    $ forAll (genMockInit id)
+    $ \mockInit -> ioProperty $ do
+      Mock {sessionManager} <- newMock id mockInit
+      sessionKey <- newSessionKey sessionManager
+      let charactersPresent = Set.fromList (T.unpack sessionKey.text)
+      pure $ charactersPresent `Set.isSubsetOf` charactersWanted
+
+  specify "never generates the same key twice"
+    $ forAll (genMockInit id)
+    $ \mockInit -> ioProperty $ do
+      Mock {sessionManager} <- newMock id mockInit
+      let n = 1000
+      sessionKeys <-
+        fmap Set.fromList
+          $ replicateM n
+          $ newSessionKey sessionManager
+      pure $ Set.size sessionKeys == n
+
+  specify "accepts its own keys"
+    $ forAll (genMockInit id)
+    $ \mockInit -> ioProperty $ do
+      Mock {sessionManager} <- newMock id mockInit
+      sessionKey <- newSessionKey sessionManager
+      pure $ sessionKeyAppearsReasonable sessionManager sessionKey
+
+  specify "does not accept invalid keys"
+    $ forAll (genMockInit id)
+    $ \mockInit -> ioProperty $ do
+      Mock {sessionManager} <- newMock id mockInit
+      pure
+        $ all
+          (isNothing . checkedSessionKeyFromCookieValue sessionManager)
+          someInvalidCookies
+
+charactersWanted :: Set Char
+charactersWanted =
+  foldMap Set.fromList [['a' .. 'z'], ['A' .. 'Z'], ['0' .. '9'], "-_"]
+
+someInvalidSessionKeyTexts :: [Text]
+someInvalidSessionKeyTexts =
+  [ ""
+  , "123456789-123456789-123"
+  , "123456789-123456789-12345"
+  , "aaaaaaaaaaaaaaaaaa*aaaaa"
+  ]
+
+someInvalidCookies :: [ByteString]
+someInvalidCookies =
+  (encodeUtf8 <$> someInvalidSessionKeyTexts)
+    <> someInvalidUtf8ByteStrings
+
+someInvalidUtf8ByteStrings :: [ByteString]
+someInvalidUtf8ByteStrings =
+  [ "\xc3\x28"
+  , "\xa0\xa1"
+  , "\xe2\x28\xa1"
+  , "\xe2\x82\x28"
+  , "\xf0\x28\x8c\xbc"
+  , "\xf0\x90\x28\xbc"
+  , "\xf0\x28\x8c\x28"
+  ]
diff --git a/tests/Spec.hs b/tests/Spec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Spec.hs
@@ -0,0 +1,3 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover -Wno-missing-export-lists #-}
+
+module Spec (main) where
diff --git a/tests/Test/Gen/General.hs b/tests/Test/Gen/General.hs
new file mode 100644
--- /dev/null
+++ b/tests/Test/Gen/General.hs
@@ -0,0 +1,43 @@
+module Test.Gen.General
+  ( chooseNominalDiffTime
+  , chooseTime
+  , chooseFixed
+  , genMaybe
+  , genVectorOfRange
+  ) where
+
+import Internal.Prelude
+
+import Test.QuickCheck (Gen, choose)
+import Test.QuickCheck.Gen qualified as Gen
+import Time
+
+chooseNominalDiffTime
+  :: (NominalDiffTime, NominalDiffTime) -> Gen NominalDiffTime
+chooseNominalDiffTime =
+  fmap secondsToNominalDiffTime
+    . chooseFixed
+    . both nominalDiffTimeToSeconds
+
+chooseFixed :: (Fixed a, Fixed a) -> Gen (Fixed a)
+chooseFixed = fmap MkFixed . Gen.choose . both (\(MkFixed x) -> x)
+
+both :: (a -> b) -> (a, a) -> (b, b)
+both f = bimap f f
+
+chooseTime :: (UTCTime, UTCTime) -> Gen UTCTime
+chooseTime (a, b) =
+  Gen.frequency
+    [ (1,) $ Gen.elements [a, b]
+    , (10,) $ do
+        d <- chooseNominalDiffTime (0, diffUTCTime b a)
+        Gen.elements [addUTCTime d a, addUTCTime (negate d) b]
+    ]
+
+genMaybe :: Gen a -> Gen (Maybe a)
+genMaybe g = Gen.oneof [pure Nothing, Just <$> g]
+
+genVectorOfRange :: (Int, Int) -> Gen a -> Gen [a]
+genVectorOfRange (a, b) g = do
+  i <- choose (a, b)
+  Gen.vectorOf i g
diff --git a/tests/Test/Gen/Mock.hs b/tests/Test/Gen/Mock.hs
new file mode 100644
--- /dev/null
+++ b/tests/Test/Gen/Mock.hs
@@ -0,0 +1,87 @@
+module Test.Gen.Mock
+  ( MockInit (..)
+  , genMockInit
+  , TimeoutGenOptions
+  , requireSomeTimeLimit
+  , noTimeoutResolution
+  )
+where
+
+import Internal.Prelude
+
+import Test.Gen.General
+import Test.QuickCheck (Arbitrary (arbitrary), Gen)
+import Test.QuickCheck.Gen qualified as Gen
+import Time
+import Yesod.Session.Persist
+
+data MockInit = MockInit
+  { randomSeed :: Int
+  , time :: UTCTime
+  , timing :: TimingOptions NominalDiffTime
+  }
+  deriving stock (Eq, Show)
+
+genMockInit :: (TimeoutGenOptions -> TimeoutGenOptions) -> Gen MockInit
+genMockInit timeoutOptions = do
+  randomSeed <- arbitrary
+  time <-
+    chooseTime
+      (UTCTime (fromOrdinalDate 1950 0) 0, UTCTime (fromOrdinalDate 2050 0) 0)
+  timing <- genTimingOptions (timeoutOptions defaultTimeoutGenOptions)
+  pure MockInit {..}
+
+data TimeoutGenOptions = TimeoutGenOptions
+  { requireSomeLimit :: Bool
+  , generateResolution :: Maybe Bool
+  }
+
+defaultTimeoutGenOptions :: TimeoutGenOptions
+defaultTimeoutGenOptions =
+  TimeoutGenOptions
+    { requireSomeLimit = False
+    , generateResolution = Nothing
+    }
+
+-- | Ensure that the generated settings have at least and idle or an absolute timeout
+--
+-- Use this for tests that require an expired session, since without timeout
+-- settings no session can expire.
+requireSomeTimeLimit :: TimeoutGenOptions -> TimeoutGenOptions
+requireSomeTimeLimit x = x {requireSomeLimit = True}
+
+-- | Ensure that the generate settings do not have a timeout resolution
+--
+-- This disables the optimization that prevents a session from being saved to the
+-- database when the only change is a small increment in the access time.
+-- Use this when the optimization would overcomplicate a test's assertion that it
+-- performs an update to an existing session.
+noTimeoutResolution :: TimeoutGenOptions -> TimeoutGenOptions
+noTimeoutResolution x = x {generateResolution = Just False}
+
+genTimingOptions :: TimeoutGenOptions -> Gen (TimingOptions NominalDiffTime)
+genTimingOptions x = do
+  timeout <- do
+    (requireIdle, requireAbsolute) <-
+      if x.requireSomeLimit
+        then Gen.elements [(False, True), (True, False)]
+        else pure (False, False)
+    idle <-
+      (if requireIdle then fmap Just else genMaybe)
+        $ chooseNominalDiffTime (secondsToNominalDiffTime 60, nominalDay)
+    absolute <-
+      (if requireAbsolute then fmap Just else genMaybe)
+        $ maybe id (+) idle -- Absolute timeout should be greater than idle timeout
+        <$> chooseNominalDiffTime (secondsToNominalDiffTime 60, nominalDay)
+    pure Timeout {idle, absolute}
+  let resolutionGenerator = case timeout.idle <|> timeout.absolute of
+        Just t ->
+          -- Resolution should be a fraction of the smaller of the timeout limits
+          chooseNominalDiffTime (t / 10, t / 2)
+        Nothing ->
+          chooseNominalDiffTime (secondsToNominalDiffTime 2, secondsToNominalDiffTime 60)
+  resolution <- case x.generateResolution of
+    Nothing -> genMaybe resolutionGenerator
+    Just True -> Just <$> resolutionGenerator
+    Just False -> pure Nothing
+  pure TimingOptions {timeout, resolution}
diff --git a/tests/Test/Gen/Session.hs b/tests/Test/Gen/Session.hs
new file mode 100644
--- /dev/null
+++ b/tests/Test/Gen/Session.hs
@@ -0,0 +1,161 @@
+module Test.Gen.Session
+  ( SessionInit (..)
+  , genSessionInit
+  , SessionGenOptions
+  , requireLive
+  , requireExpired
+  ) where
+
+import Internal.Prelude
+
+import Data.Map.Strict qualified as Map
+import Test.Gen.General
+import Test.Gen.Mock
+import Test.QuickCheck (Gen)
+import Test.QuickCheck.Gen qualified as Gen
+import Time
+import Yesod.Core (SessionMap)
+import Yesod.Session.Persist
+import Prelude (error)
+
+data SessionInit = SessionInit
+  { time :: Time UTCTime
+  , map :: SessionMap
+  }
+  deriving stock (Eq, Show)
+
+genSessionInit
+  :: (SessionGenOptions -> SessionGenOptions) -> MockInit -> Gen SessionInit
+genSessionInit fsgo mockInit = do
+  let SessionGenOptions {liveness} = fsgo defaultSessionGenOptions
+  map <- genSessionData
+  let now = mockInit.time
+  let timeout = mockInit.timing.timeout
+  time <- case liveness of
+    Nothing -> whatever now
+    Just Live -> live timeout now
+    Just (Expired reasonMaybe) -> do
+      reason <- case reasonMaybe of
+        Nothing ->
+          case (nonEmpty . catMaybes)
+            [ timeout.idle $> IdleTimeout
+            , timeout.absolute $> AbsoluteTimeout
+            ] of
+            Just xs -> Gen.elements $ toList xs
+            Nothing ->
+              error
+                "Cannot generate an expired session for a configuration \
+                \with no timeout limits"
+        Just x -> pure x
+      case reason of
+        IdleTimeout ->
+          fromMaybe
+            ( error
+                "Cannot generate an expired-by-idle-timeout \
+                \session for a configuration with no idle timeout limit"
+            )
+            $ expiredViaIdleTimeout timeout now
+        AbsoluteTimeout ->
+          fromMaybe
+            ( error
+                "Cannot generate an expired-by-absolute-timeout session \
+                \for a configuration with no absolute timeout limit"
+            )
+            $ expiredViaAbsoluteTimeout timeout now
+
+  pure SessionInit {..}
+
+whatever :: UTCTime -> Gen (Time UTCTime)
+whatever now = do
+  created <- chooseTime (subtractUTCTime nominalDay now, now)
+  accessed <- chooseTime (created, now)
+  pure Time {accessed, created}
+
+-- | Generates times for a session that is still live
+live :: Timeout NominalDiffTime -> UTCTime -> Gen (Time UTCTime)
+live timeout now = do
+  accessed <-
+    chooseTime
+      ( subtractUTCTime
+          ( case (timeout.idle, timeout.absolute) of
+              (Just idleTimeout, _) -> pred idleTimeout
+              (_, Just absoluteTimeout) -> pred absoluteTimeout
+              _ -> nominalDay
+          )
+          now
+      , now
+      )
+  created <-
+    chooseTime
+      ( case timeout.absolute of
+          Just absoluteTimeout -> subtractUTCTime (pred absoluteTimeout) now
+          Nothing -> subtractUTCTime nominalDay accessed
+      , accessed
+      )
+  pure Time {accessed, created}
+
+-- | Generates times for a session that is expired due to idle timeout
+--   (returns 'Nothing' if there is no idle timeout)
+expiredViaIdleTimeout
+  :: Timeout NominalDiffTime -> UTCTime -> Maybe (Gen (Time UTCTime))
+expiredViaIdleTimeout timeout now =
+  timeout.idle <&> \idleTimeout -> do
+    accessed <-
+      chooseTime
+        ( case timeout.absolute of
+            Just absoluteTimeout -> subtractUTCTime absoluteTimeout now
+            Nothing -> subtractUTCTime (idleTimeout + nominalDay) now
+        , subtractUTCTime idleTimeout now
+        )
+    created <-
+      chooseTime
+        ( case timeout.absolute of
+            Just absoluteTimeout -> subtractUTCTime absoluteTimeout now
+            Nothing -> subtractUTCTime nominalDay accessed
+        , accessed
+        )
+    pure Time {accessed, created}
+
+-- | Generates times for a session that is expired due to absolute timeout
+--   (returns 'Nothing' if there is no absolute timeout)
+expiredViaAbsoluteTimeout
+  :: Timeout NominalDiffTime -> UTCTime -> Maybe (Gen (Time UTCTime))
+expiredViaAbsoluteTimeout timeout now =
+  timeout.absolute <&> \absoluteTimeout -> do
+    created <-
+      let base = subtractUTCTime absoluteTimeout now
+       in chooseTime (subtractUTCTime nominalDay base, base)
+    accessed <-
+      chooseTime
+        ( case timeout.idle of
+            Just idleTimeout -> subtractUTCTime idleTimeout now
+            Nothing -> created
+        , now
+        )
+    pure Time {accessed, created}
+
+newtype SessionGenOptions = SessionGenOptions
+  { liveness :: Maybe Liveness
+  }
+
+defaultSessionGenOptions :: SessionGenOptions
+defaultSessionGenOptions = SessionGenOptions {liveness = Nothing}
+
+requireLive :: SessionGenOptions -> SessionGenOptions
+requireLive x = x {liveness = Just Live}
+
+requireExpired :: SessionGenOptions -> SessionGenOptions
+requireExpired x = x {liveness = Just (Expired Nothing)}
+
+data Liveness = Live | Expired (Maybe ExpirationReason)
+
+data ExpirationReason = IdleTimeout | AbsoluteTimeout
+  deriving stock (Show)
+
+genSessionData :: Gen (Map Text ByteString)
+genSessionData = fmap Map.fromList $ do
+  k <- Gen.choose (0, 5)
+  Gen.vectorOf k
+    $ (,)
+    <$> Gen.elements ["", "a", "bc", "def", "ghij"]
+    <*> Gen.elements ["", "a", "\0", "what"]
diff --git a/tests/Test/Mock.hs b/tests/Test/Mock.hs
new file mode 100644
--- /dev/null
+++ b/tests/Test/Mock.hs
@@ -0,0 +1,78 @@
+module Test.Mock
+  ( Mock (..)
+  , newMock
+  , createArbitrarySession
+  , advanceTime
+  , advanceTimeBriefly
+  ) where
+
+import Internal.Prelude
+
+import Control.Concurrent.STM.TVar
+  ( TVar
+  , modifyTVar'
+  , newTVarIO
+  , readTVarIO
+  )
+import Control.Monad.STM (STM, atomically)
+import Session.Key
+import Test.Gen.Mock
+import Test.Gen.Session
+import Test.MockStorage
+import Test.Randomization
+import Time
+import Yesod.Session.Manager
+import Yesod.Session.Persist
+import Yesod.Session.Storage.Operation
+
+data Mock tx m = Mock
+  { sessionManager :: SessionManager tx m
+  , currentTime :: TVar UTCTime
+  , mockStorage :: MockStorage m
+  }
+
+newMock :: (Options STM IO -> Options STM IO) -> MockInit -> IO (Mock STM IO)
+newMock opt MockInit {randomSeed, time, timing} = do
+  let randomization = liftIO $ atomically $ newRandomization randomSeed
+  currentTime <- newTVarIO time
+  let clock = readTVarIO currentTime
+  mockStorage@MockStorage {storage} <-
+    hoistMockStorage atomically <$> atomically newMockStorage
+  let options = opt defaultOptions {timing, clock, randomization}
+  keyManager <- makeSessionKeyManager <$> randomization
+  let sessionManager =
+        SessionManager {keyManager, storage, options, runTransaction = atomically}
+  pure Mock {sessionManager, currentTime, mockStorage}
+
+createArbitrarySession :: Mock STM IO -> SessionInit -> IO SessionKey
+createArbitrarySession mock sessionInit =
+  let
+    Mock {mockStorage, sessionManager} = mock
+    SessionManager {storage, runTransaction} = sessionManager
+  in
+    offTheRecordIO mockStorage
+      $ do
+        key <- newSessionKey sessionManager
+        let session =
+              Session
+                { key
+                , map = sessionInit.map
+                , time = sessionInit.time
+                }
+        runTransaction $ storage $ InsertSession session
+        pure session.key
+
+advanceTime :: MonadIO m => NominalDiffTime -> Mock STM IO -> m ()
+advanceTime amount mock = do
+  liftIO $ atomically $ modifyTVar' mock.currentTime $ addUTCTime amount
+
+advanceTimeBriefly :: MonadIO m => Mock STM IO -> m ()
+advanceTimeBriefly mock =
+  let
+    timeout = mock.sessionManager.options.timing.timeout
+
+    change = case timeout.idle <|> timeout.absolute of
+      Nothing -> secondsToNominalDiffTime 1
+      Just upperBound -> upperBound / 10
+  in
+    advanceTime change mock
diff --git a/tests/Test/MockStorage.hs b/tests/Test/MockStorage.hs
new file mode 100644
--- /dev/null
+++ b/tests/Test/MockStorage.hs
@@ -0,0 +1,100 @@
+module Test.MockStorage
+  ( newMockStorage
+  , MockStorage (..)
+  , hoistMockStorage
+  , offTheRecordIO
+  , takeTranscript
+  ) where
+
+import Internal.Prelude
+
+import Control.Concurrent.STM.TVar
+  ( TVar
+  , modifyTVar'
+  , newTVar
+  , readTVar
+  , readTVarIO
+  , writeTVar
+  )
+import Control.Monad.STM (STM, atomically)
+import Data.Map.Strict qualified as Map
+import Data.Sequence ((|>))
+import Data.Sequence qualified as Seq
+import Session.Key
+import Yesod.Session.SessionType
+import Yesod.Session.Storage.Exceptions
+import Yesod.Session.Storage.Operation
+
+data MockStorage m = MockStorage
+  { storage :: forall a. StorageOperation a -> STM a
+  , runSTM :: forall a. STM a -> m a
+  , transcript :: TVar (Seq StorageOperation')
+  , getSessionKeys :: STM (Set SessionKey)
+  , recordingVar :: TVar Bool
+  }
+
+hoistMockStorage :: (forall a. m a -> m' a) -> MockStorage m -> MockStorage m'
+hoistMockStorage f MockStorage {..} =
+  MockStorage {runSTM = f . runSTM, ..}
+
+-- | Perform some action without modifying the transcript
+offTheRecordIO :: MonadIO m => MockStorage m -> m a -> m a
+offTheRecordIO mock action = do
+  wasRecording <- liftIO $ readTVarIO mock.recordingVar
+  liftIO $ atomically $ writeTVar mock.recordingVar False
+  x <- action
+  liftIO $ atomically $ writeTVar mock.recordingVar wasRecording
+  pure x
+
+takeTranscript :: MockStorage m -> m (Seq StorageOperation')
+takeTranscript MockStorage {transcript, runSTM} =
+  runSTM $ readTVar transcript <* writeTVar transcript Seq.empty
+
+newMockStorage :: HasCallStack => STM (MockStorage STM)
+newMockStorage = do
+  transcript <- newTVar Seq.empty
+  sessionsVar <- newTVar Map.empty
+  recordingVar <- newTVar True
+
+  pure
+    MockStorage
+      { transcript
+      , recordingVar
+      , getSessionKeys = Map.keysSet <$> readTVar sessionsVar
+      , storage = \(op :: StorageOperation result) ->
+          do
+            readTVar recordingVar
+              >>= (`when` modifyTVar' transcript (|> StorageOperation' op))
+            handleOp sessionsVar op
+      , runSTM = id
+      }
+
+handleOp
+  :: HasCallStack
+  => TVar (Map SessionKey Session)
+  -> StorageOperation result
+  -> STM result
+handleOp ref = \case
+  GetSession sessionKey -> readTVar ref <&> Map.lookup sessionKey
+  DeleteSession sessionKey -> modifyTVar' ref $ Map.delete sessionKey
+  InsertSession newSession -> do
+    modifyTVarSTM ref
+      $ Map.alterF
+        ( maybe
+            (pure $ Just newSession)
+            ( \existingSession ->
+                throwWithCallStack SessionAlreadyExists {existingSession, newSession}
+            )
+        )
+        newSession.key
+  ReplaceSession newSession ->
+    modifyTVarSTM ref
+      $ Map.alterF
+        ( maybe
+            (throwWithCallStack SessionDoesNotExist {newSession})
+            (const $ pure $ Just newSession)
+        )
+        newSession.key
+
+modifyTVarSTM :: TVar a -> (a -> STM a) -> STM ()
+modifyTVarSTM ref f = readTVar ref >>= f >>= (writeTVar ref $!)
diff --git a/tests/Test/Prelude.hs b/tests/Test/Prelude.hs
new file mode 100644
--- /dev/null
+++ b/tests/Test/Prelude.hs
@@ -0,0 +1,13 @@
+module Test.Prelude
+  ( module X
+  ) where
+
+import GHC.Generics as X (Generic)
+import Internal.Prelude as X
+import Test.Gen.General as X
+import Test.Gen.Mock as X
+import Test.Gen.Session as X
+import Test.Hspec as X
+import Test.Mock as X
+import Test.MockStorage as X
+import Test.QuickCheck as X hiding (Fixed)
diff --git a/tests/Test/Randomization.hs b/tests/Test/Randomization.hs
new file mode 100644
--- /dev/null
+++ b/tests/Test/Randomization.hs
@@ -0,0 +1,29 @@
+module Test.Randomization
+  ( newRandomization
+  ) where
+
+import Internal.Prelude
+
+import Control.Concurrent.STM.TVar (newTVar, readTVar, writeTVar)
+import Control.Monad.STM (STM)
+import Randomization
+import System.Random qualified as Random
+
+newRandomization :: Int -> STM (Randomization STM)
+newRandomization seed =
+  deterministicallyRandomSTM
+    $ let go g =
+            DeterministicRandomization $ \n ->
+              let (bs, g') = Random.genByteString (fromIntegral n) g
+              in  (bs, go g')
+      in  go $ Random.mkStdGen seed
+
+deterministicallyRandomSTM
+  :: DeterministicRandomization -> STM (Randomization STM)
+deterministicallyRandomSTM =
+  newTVar >=> pure . \ref ->
+    Randomization $ \n -> do
+      DeterministicRandomization gen <- readTVar ref
+      let (bs, gen') = gen n
+      writeTVar ref $! gen'
+      pure bs
diff --git a/tests/Yesod/Session/Manager/LoadSpec.hs b/tests/Yesod/Session/Manager/LoadSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Yesod/Session/Manager/LoadSpec.hs
@@ -0,0 +1,60 @@
+module Yesod.Session.Manager.LoadSpec
+  ( spec
+  ) where
+
+import Test.Prelude
+
+import Data.Sequence qualified as Seq
+import Yesod.Session.Manager
+import Yesod.Session.Manager.Load
+import Yesod.Session.SessionType
+
+spec :: Spec
+spec = context "Session loading" $ do
+  specify "may load a session"
+    $ forAll (genMockInit id)
+    $ \mockInit ->
+      forAll (genSessionInit requireLive mockInit) $ \sessionInit ->
+        forAll (genVectorOfRange (0, 5) $ genSessionInit id mockInit)
+          $ \otherSessionInits ->
+            ioProperty $ do
+              mock@Mock {sessionManager} <- newMock id mockInit
+              traverse_ (createArbitrarySession mock) otherSessionInits
+              sessionKey <- createArbitrarySession mock sessionInit
+              load <- loadSession sessionManager sessionKey
+              pure $ counterexample (show load) $ didSessionLoad load
+
+  context "may load nothing" $ do
+    specify "when there is no session key"
+      $ forAll (genMockInit id)
+      $ \mockInit ->
+        forAll (genVectorOfRange (0, 5) $ genSessionInit id mockInit)
+          $ \sessionInits -> ioProperty $ do
+            mock@Mock {sessionManager} <- newMock id mockInit
+            traverse_ (createArbitrarySession mock) sessionInits
+            load :: Load Session <- loadNothing sessionManager
+            transcript <- takeTranscript mock.mockStorage
+            pure
+              $ counterexample (show load) (not $ didSessionLoad load)
+              .&&. counterexample (show transcript) (transcript == Seq.empty)
+
+    specify "when the key is not in storage"
+      $ forAll (genMockInit id)
+      $ \mockInit ->
+        forAll (genVectorOfRange (0, 5) $ genSessionInit id mockInit)
+          $ \sessionInits -> ioProperty $ do
+            mock@Mock {sessionManager} <- newMock id mockInit
+            traverse_ (createArbitrarySession mock) sessionInits
+            sessionKey <- newSessionKey sessionManager
+            load <- loadSession sessionManager sessionKey
+            pure $ counterexample (show load) (not $ didSessionLoad load)
+
+    specify "when the session is expired"
+      $ forAll (genMockInit requireSomeTimeLimit)
+      $ \mockInit ->
+        forAll (genSessionInit requireExpired mockInit)
+          $ \sessionInit -> ioProperty $ do
+            mock@Mock {sessionManager} <- newMock id mockInit
+            sessionKey <- createArbitrarySession mock sessionInit
+            load <- loadSession sessionManager sessionKey
+            pure $ counterexample (show load) (not $ didSessionLoad load)
diff --git a/tests/Yesod/Session/Manager/SaveSpec.hs b/tests/Yesod/Session/Manager/SaveSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Yesod/Session/Manager/SaveSpec.hs
@@ -0,0 +1,134 @@
+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
diff --git a/tests/Yesod/Session/Persist/YesodApp.hs b/tests/Yesod/Session/Persist/YesodApp.hs
new file mode 100644
--- /dev/null
+++ b/tests/Yesod/Session/Persist/YesodApp.hs
@@ -0,0 +1,110 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -fno-warn-missing-deriving-strategies #-}
+{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}
+
+module Yesod.Session.Persist.YesodApp where
+
+import Test.Prelude
+
+import Comparison
+import Control.Monad.STM (STM)
+import Data.Map.Strict qualified as Map
+import Data.Text qualified as T
+import Data.Time qualified as Time
+import Session.KeyRotation
+import Session.Timing.Options
+import Time
+import Yesod
+  ( FromJSON
+  , Html
+  , RenderRoute (renderRoute)
+  , Yesod (defaultLayout, makeSessionBackend)
+  , deleteSession
+  , getSession
+  , mkYesod
+  , parseRoutes
+  , requireInsecureJsonBody
+  , setSession
+  , whamlet
+  )
+import Yesod.Core (SessionMap)
+import Yesod.Session.Manager
+import Yesod.Session.Persist
+import Yesod.Session.Persist.Yesod
+
+newApp :: TimingOptions NominalDiffTime -> IO App
+newApp timing = do
+  -- We have limited ability to mock time in a Yesod test, because
+  -- the cookie manager will expire cookies based on the real time.
+  time <- Time.getCurrentTime
+
+  randomSeed <- generate arbitrary
+  let mockInit = MockInit {randomSeed, time, timing}
+  mock <- newMock (\x -> x {keyRotationTrigger}) mockInit
+  pure App {mock}
+
+keyRotationTrigger :: Comparison SessionMap -> Maybe KeyRotation
+keyRotationTrigger x = do
+  guard $ differsOn (Map.lookup "user-id") x
+  Just RotateSessionKey
+
+newtype App = App
+  { mock :: Mock STM IO
+  }
+
+-- Derive routes and instances for App.
+mkYesod
+  "App"
+  [parseRoutes|
+    / HomeR GET
+    /ping PingR GET
+    /user UserR GET
+    /log-in LogInR POST
+    /log-out LogOutR POST
+    /rotate RotateR GET
+  |]
+
+instance HasSessionEmbeddings App where
+  getSessionEmbeddings app =
+    let
+      App {mock} = app
+      Mock {sessionManager} = mock
+      SessionManager {options} = sessionManager
+      Options {embedding} = options
+    in
+      embedding
+
+instance Yesod App where
+  makeSessionBackend App {mock} = do
+    let Mock {sessionManager} = mock
+    pure $ Just $ makeSessionBackend'' sessionManager
+
+getHomeR :: Handler Html
+getHomeR = defaultLayout [whamlet|Hello World!|]
+
+getPingR :: Handler Text
+getPingR = do
+  disableSessionManagement
+  pure "pong"
+
+getUserR :: Handler Text
+getUserR =
+  maybe "-" (T.pack . show) . Map.lookup "user-id" <$> getSession
+
+postLogInR :: Handler ()
+postLogInR = do
+  form :: LoginForm <- requireInsecureJsonBody
+  setSession "user-id" form.uid
+
+postLogOutR :: Handler ()
+postLogOutR = deleteSession "user-id"
+
+newtype LoginForm = LoginForm
+  { uid :: Text
+  }
+  deriving stock (Generic)
+  deriving anyclass (FromJSON)
+
+getRotateR :: Handler ()
+getRotateR = rotateSessionKey
diff --git a/tests/Yesod/Session/Persist/YesodSpec.hs b/tests/Yesod/Session/Persist/YesodSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Yesod/Session/Persist/YesodSpec.hs
@@ -0,0 +1,209 @@
+module Yesod.Session.Persist.YesodSpec
+  ( spec
+  ) where
+
+import Test.Prelude
+
+import Control.Concurrent.STM.TVar (readTVarIO)
+import Data.Aeson (encode, object)
+import Data.List qualified as List
+import Data.Sequence qualified as Seq
+import Data.Text.Encoding (encodeUtf8)
+import Network.Wai (Middleware)
+import Network.Wai.Test (simpleHeaders)
+import Time
+import Web.Cookie (SetCookie (..), def, parseSetCookie)
+import Yesod.Session.Persist
+import Yesod.Session.Persist.YesodApp (App (..), Route (..), newApp)
+import Yesod.Session.Storage.Operation
+import Yesod.Test
+  ( YesodExample
+  , bodyEquals
+  , getTestYesod
+  , request
+  , setMethod
+  , setRequestBody
+  , setUrl
+  , withResponse
+  )
+
+spec :: Spec
+spec =
+  withApp defaultTimingOptions $ do
+    context "Yesod App" $ do
+      specify @(YesodExample App ()) "Sets a session cookie" $ do
+        app <- getTestYesod
+        now <- liftIO $ readTVarIO app.mock.currentTime
+
+        -- Make a request to a normal route
+        request $ do setUrl HomeR; setMethod "GET"
+
+        -- Since there was no session, one should be inserted
+        sessionKey :: SessionKey <- do
+          transcript <- liftIO $ takeTranscript app.mock.mockStorage
+          case toList transcript of
+            [StorageOperation' (InsertSession s)] -> pure s.key
+            _ -> liftIO $ fail $ show transcript
+
+        -- We should receive a set-cookie header
+        assertSetCookie
+          $ def
+            { setCookieName = "session-key"
+            , setCookieValue = encodeUtf8 sessionKey.text
+            , setCookiePath = Just "/"
+            , setCookieExpires =
+                Just
+                  $ truncateToSeconds
+                  $ addUTCTime (60 * 60 * 8) now
+            , setCookieHttpOnly = True
+            }
+
+      specify @(YesodExample App ())
+        "Doesn't set a session cookie if sessions are disabled"
+        $ do
+          app <- getTestYesod
+
+          -- Make a request to a route without session management
+          request $ do setUrl PingR; setMethod "GET"
+
+          -- No storage operations should have been performed
+          transcript <- liftIO $ takeTranscript app.mock.mockStorage
+          liftIO $ transcript `shouldBe` Seq.empty
+
+          -- No cookie should be set
+          assertNoSetCookie
+
+      specify @(YesodExample App ()) "Saves the session"
+        $ do
+          app <- getTestYesod
+
+          -- Log in
+          request $ do
+            setUrl LogInR
+            setMethod "POST"
+            setRequestBody $ encode $ object [("uid", "xyz")]
+
+          sessionKey :: SessionKey <- do
+            transcript <- liftIO $ takeTranscript app.mock.mockStorage
+            case toList transcript of
+              [StorageOperation' (InsertSession s)] -> pure s.key
+              _ -> liftIO $ fail $ show transcript
+
+          replicateM_ 3 $ do
+            -- A short pause should not affect anything
+            advanceTime 90 app.mock
+
+            -- Verify that we're now logged in
+            request $ do setUrl UserR; setMethod "GET"
+            bodyEquals (show @ByteString "xyz")
+
+            liftIO $ do
+              transcript <- takeTranscript app.mock.mockStorage
+              toList transcript
+                `shouldBe` [StorageOperation' (GetSession sessionKey)]
+
+      specify @(YesodExample App ()) "Does not load an expired session"
+        $ do
+          app <- getTestYesod
+
+          request $ do
+            setUrl LogInR
+            setMethod "POST"
+            setRequestBody $ encode $ object [("uid", "xyz")]
+
+          -- A pause longer than the idle timeout should kill the session
+          advanceTime (60 * 60 * 10) app.mock
+
+          request $ do setUrl UserR; setMethod "GET"
+          bodyEquals "-"
+
+      specify @(YesodExample App ()) "rotates the key when 'rotateSessionKey' is used" $ do
+        app <- getTestYesod
+
+        -- Log in
+        request $ do
+          setUrl LogInR
+          setMethod "POST"
+          setRequestBody $ encode $ object [("uid", "xyz")]
+
+        -- Get the session
+        transcript <- liftIO $ takeTranscript app.mock.mockStorage
+        sessionKey :: SessionKey <-
+          case toList transcript of
+            [StorageOperation' (InsertSession s)] -> pure s.key
+            _ -> liftIO $ fail $ show transcript
+
+        -- Make a request to the route that does a key rotation
+        request $ do setUrl RotateR; setMethod "GET"
+
+        -- The old session should be deleted
+        transcript' <- liftIO $ takeTranscript app.mock.mockStorage
+        liftIO
+          $ List.take 2 (toList transcript')
+          `shouldBe` [ StorageOperation' (GetSession sessionKey)
+                     , StorageOperation' (DeleteSession sessionKey)
+                     ]
+
+        -- But we're still logged in
+        request $ do setUrl UserR; setMethod "GET"
+        bodyEquals (show @ByteString "xyz")
+
+      specify @(YesodExample App ()) "rotates the key on auth changes"
+        $ do
+          app <- getTestYesod
+
+          -- Log in
+          request $ do
+            setUrl LogInR
+            setMethod "POST"
+            setRequestBody $ encode $ object [("uid", "xyz")]
+
+          -- Get the session
+          transcript <- liftIO $ takeTranscript app.mock.mockStorage
+          sessionKey :: SessionKey <-
+            case toList transcript of
+              [StorageOperation' (InsertSession s)] -> pure s.key
+              _ -> liftIO $ fail $ show transcript
+
+          -- Log in differently
+          request $ do
+            setUrl LogInR
+            setMethod "POST"
+            setRequestBody $ encode $ object [("uid", "hello")]
+
+          -- The old session should be deleted
+          transcript' <- liftIO $ takeTranscript app.mock.mockStorage
+          liftIO
+            $ List.take 2 (toList transcript')
+            `shouldBe` [ StorageOperation' (GetSession sessionKey)
+                       , StorageOperation' (DeleteSession sessionKey)
+                       ]
+
+          -- But we're still logged in as the new user
+          request $ do setUrl UserR; setMethod "GET"
+          bodyEquals (show @ByteString "hello")
+
+withApp :: TimingOptions NominalDiffTime -> SpecWith (App, Middleware) -> Spec
+withApp timing = around ((=<< newApp timing) . (. (,id :: Middleware)))
+
+-- | Assert that the response contains a set-cookie header that parses to a particular value
+assertSetCookie :: SetCookie -> YesodExample site ()
+assertSetCookie expected =
+  withResponse $ \response ->
+    case List.lookup "set-cookie" $ simpleHeaders response of
+      Just value -> liftIO $ parseSetCookie value `shouldBe` expected
+      Nothing -> liftIO $ expectationFailure "no set-cookie header present"
+
+-- | Fail if set-cookie is present in the response
+assertNoSetCookie :: YesodExample site ()
+assertNoSetCookie =
+  withResponse $ \response ->
+    case List.lookup "set-cookie" $ simpleHeaders response of
+      Just value ->
+        liftIO $ expectationFailure $ "expected no set-cookie, but got " <> show value
+      Nothing -> pure ()
+
+-- | Round a time to seconds, because that is the precision in cookie headers
+truncateToSeconds :: UTCTime -> UTCTime
+truncateToSeconds x =
+  x {utctDayTime = secondsToDiffTime (truncate (utctDayTime x))}
diff --git a/yesod-session-persist.cabal b/yesod-session-persist.cabal
new file mode 100644
--- /dev/null
+++ b/yesod-session-persist.cabal
@@ -0,0 +1,175 @@
+cabal-version:      2.0
+name:               yesod-session-persist
+version:            0.0.0.0
+license:            MIT
+license-file:       LICENSE
+maintainer:         Freckle Education
+homepage:           https://github.com/freckle/yesod-session-persist#readme
+bug-reports:        https://github.com/freckle/yesod-session-persist/issues
+synopsis:           SQL session backend for Yesod
+description:        Use Persistent to store Yesod sessions
+category:           Web
+build-type:         Simple
+extra-source-files: package.yaml
+extra-doc-files:
+    README.md
+    CHANGELOG.md
+
+source-repository head
+    type:     git
+    location: https://github.com/freckle/yesod-session-persist
+
+library
+    exposed-modules:    Yesod.Session.Persist
+    hs-source-dirs:     library
+    other-modules:      Paths_yesod_session_persist
+    autogen-modules:    Paths_yesod_session_persist
+    default-language:   GHC2021
+    default-extensions:
+        AllowAmbiguousTypes DeriveAnyClass DerivingStrategies
+        DuplicateRecordFields FunctionalDependencies GADTs
+        ImpredicativeTypes LambdaCase NoFieldSelectors NoImplicitPrelude
+        OverloadedRecordDot OverloadedStrings QuantifiedConstraints
+        RecordWildCards TypeFamilies UndecidableInstances
+
+    ghc-options:
+        -Weverything -Wno-all-missed-specialisations
+        -Wno-missed-specialisations -Wno-missing-exported-signatures
+        -Wno-missing-import-lists -Wno-missing-kind-signatures
+        -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode
+        -Wno-monomorphism-restriction -Wno-partial-fields
+        -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe
+        -fwrite-ide-info
+
+    build-depends:
+        base >=4.16.4.0 && <5,
+        internal
+
+library internal
+    exposed-modules:
+        Comparison
+        Embedding
+        Internal.Prelude
+        Randomization
+        Session.Freeze
+        Session.Key
+        Session.KeyRotation
+        Session.Timing.Math
+        Session.Timing.Options
+        Session.Timing.Time
+        Session.Timing.Timeout
+        Session.TransportSecurity
+        Time
+        Yesod.Session.Cookie.Logic
+        Yesod.Session.Cookie.Reading
+        Yesod.Session.Cookie.SetCookie
+        Yesod.Session.Embedding.Map
+        Yesod.Session.Embedding.Options
+        Yesod.Session.Freeze
+        Yesod.Session.KeyRotation
+        Yesod.Session.Manager
+        Yesod.Session.Manager.Load
+        Yesod.Session.Manager.Save
+        Yesod.Session.Options
+        Yesod.Session.Persist.Storage
+        Yesod.Session.Persist.Yesod
+        Yesod.Session.SaveResult
+        Yesod.Session.SessionType
+        Yesod.Session.Storage.Exceptions
+        Yesod.Session.Storage.Operation
+        Yesod.Session.Storage.Save
+
+    hs-source-dirs:     internal
+    other-modules:      Paths_yesod_session_persist
+    autogen-modules:    Paths_yesod_session_persist
+    default-language:   GHC2021
+    default-extensions:
+        AllowAmbiguousTypes DeriveAnyClass DerivingStrategies
+        DuplicateRecordFields FunctionalDependencies GADTs
+        ImpredicativeTypes LambdaCase NoFieldSelectors NoImplicitPrelude
+        OverloadedRecordDot OverloadedStrings QuantifiedConstraints
+        RecordWildCards TypeFamilies UndecidableInstances
+
+    ghc-options:
+        -Weverything -Wno-all-missed-specialisations
+        -Wno-missed-specialisations -Wno-missing-exported-signatures
+        -Wno-missing-import-lists -Wno-missing-kind-signatures
+        -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode
+        -Wno-monomorphism-restriction -Wno-partial-fields
+        -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe
+        -fwrite-ide-info
+
+    build-depends:
+        annotated-exception >=0.2.0.0,
+        base >=4.16.4.0 && <5,
+        base64 >=0.4.2.4,
+        bytestring >=0.11.4.0,
+        containers >=0.6.5.1,
+        cookie >=0.4.6,
+        crypton >=0.33,
+        exceptions >=0.10.4,
+        http-types >=0.12.3,
+        mtl >=2.2.2,
+        persistent >=2.14.1.0,
+        text >=1.2.5.0,
+        time >=1.11.1.1,
+        transformers >=0.5.6.2,
+        wai >=3.2.3,
+        yesod-core >=1.6.24.2
+
+test-suite spec
+    type:               exitcode-stdio-1.0
+    main-is:            Spec.hs
+    hs-source-dirs:     tests
+    other-modules:
+        Session.KeySpec
+        Test.Gen.General
+        Test.Gen.Mock
+        Test.Gen.Session
+        Test.Mock
+        Test.MockStorage
+        Test.Prelude
+        Test.Randomization
+        Yesod.Session.Manager.LoadSpec
+        Yesod.Session.Manager.SaveSpec
+        Yesod.Session.Persist.YesodApp
+        Yesod.Session.Persist.YesodSpec
+        Paths_yesod_session_persist
+
+    autogen-modules:    Paths_yesod_session_persist
+    default-language:   GHC2021
+    default-extensions:
+        AllowAmbiguousTypes DeriveAnyClass DerivingStrategies
+        DuplicateRecordFields FunctionalDependencies GADTs
+        ImpredicativeTypes LambdaCase NoFieldSelectors NoImplicitPrelude
+        OverloadedRecordDot OverloadedStrings QuantifiedConstraints
+        RecordWildCards TypeFamilies UndecidableInstances
+
+    ghc-options:
+        -Weverything -Wno-all-missed-specialisations
+        -Wno-missed-specialisations -Wno-missing-exported-signatures
+        -Wno-missing-import-lists -Wno-missing-kind-signatures
+        -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode
+        -Wno-monomorphism-restriction -Wno-partial-fields
+        -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe
+        -fwrite-ide-info -threaded -rtsopts -with-rtsopts=-N
+
+    build-depends:
+        QuickCheck >=2.14.3,
+        aeson >=2.0.3.0,
+        base >=4.16.4.0 && <5,
+        containers >=0.6.5.1,
+        cookie >=0.4.6,
+        hspec >=2.9.7,
+        internal,
+        mtl >=2.2.2,
+        random >=1.2.1.1,
+        stm >=2.5.0.2,
+        text >=1.2.5.0,
+        time >=1.11.1.1,
+        wai >=3.2.3,
+        wai-extra >=3.1.13.0,
+        yesod >=1.6.2.1,
+        yesod-core >=1.6.24.2,
+        yesod-session-persist,
+        yesod-test >=1.6.15