SessionStore.hs

{-#LANGUAGE NoImplicitPrelude #-}
{-#LANGUAGE OverloadedStrings #-}
{-#LANGUAGE OverloadedLists #-}
{-#LANGUAGE LambdaCase #-}
{-#LANGUAGE TupleSections #-}
module Web.Sprinkles.SessionStore
where

import Web.Sprinkles.Prelude
import Data.Time.Clock.POSIX

type SessionID = ByteString

data SessionExpiry = NeverExpires | Expires POSIXTime
        deriving (Show, Eq)

data SessionNotFoundException = SessionNotFoundException
    deriving (Show)

instance Exception SessionNotFoundException where

data SessionSupportDisabled = SessionSupportDisabled
    deriving (Show)

instance Exception SessionSupportDisabled where

-- | Common interface for session store backends.
data SessionStore =
    SessionStore
        { ssGet :: SessionID -> Text -> IO (Maybe Text)
        -- ^ Attempt to retrieve a value from a session
        , ssList :: SessionID -> IO [Text]
        -- ^ List all the keys in the session
        , ssGetAll :: SessionID -> IO [(Text,Text)]
        -- ^ Retrieve the entire session contents (key, value)
        , ssPut :: SessionID -> Text -> Text -> IO ()
        -- ^ Store a value in a session. Fail if session does not exist.
        , ssCreateSession :: SessionID -> SessionExpiry -> IO ()
        -- ^ Create a new session
        , ssDropSession :: SessionID -> IO ()
        -- ^ Drop a session and delete its associated data
        , ssDoesSessionExist :: SessionID -> IO Bool
        -- ^ Checks if a session exists

        -- , ssTouchSession :: SessionID -> IO ()
        -- -- ^ Shift a session's expiry timestamp to current time + expiry
        -- , ssVacuum :: IO ()
        -- -- ^ Drop all expired sessions
        }

nullSessionStore =
    SessionStore
        { ssGet = const . const $ return Nothing
        , ssList = const $ return []
        , ssGetAll = const $ return []
        , ssPut = const . const . const $ return ()
        , ssCreateSession = const . const $ throwM SessionSupportDisabled
        , ssDropSession = const $ return ()
        , ssDoesSessionExist = const $ return False
        }