content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE LambdaCase #-}
  
  {- |
  Module      : Web.Scotty.Session
  Copyright   : (c) 2025 Tushar Adhatrao,
                (c) 2025 Marco Zocca
  
  License     : BSD-3-Clause
  Maintainer  :
  Stability   : experimental
  Portability : GHC
  
  This module provides session management functionality for Scotty web applications.
  
  ==Example usage:
  
  @
  \{\-\# LANGUAGE OverloadedStrings \#\-\}
  
  import Web.Scotty
  import Web.Scotty.Session
  import Control.Monad.IO.Class (liftIO)
  main :: IO ()
  main = do
      -- Create a session jar
      sessionJar <- createSessionJar
      scotty 3000 $ do
          -- Route to create a session
          get "/create" $ do
              sess <- createUserSession sessionJar "user data"
              html $ "Session created with ID: " <> sessId sess
          -- Route to read a session
          get "/read" $ do
              eSession <- getUserSession sessionJar
              case eSession of
                  Left _-> html "No session found or session expired."
                  Right sess -> html $ "Session content: " <> sessContent sess
  @
  -}
  module Web.Scotty.Session (
      Session (..),
      SessionId,
      SessionJar,
      SessionStatus,
  
      -- * Create Session Jar
      createSessionJar,
  
      -- * Create session
      createUserSession,
      createSession,
  
      -- * Read session
      readUserSession,
      readSession,
      getUserSession,
      getSession,
  
      -- * Add session
      addSession,
  
      -- * Delte session
      deleteSession,
  
      -- * Helper functions
      maintainSessions,
  ) where
  
  import Control.Concurrent
  import Control.Concurrent.STM
  import Control.Monad
  import Control.Monad.IO.Class (MonadIO (..))
  import qualified Data.HashMap.Strict as HM
  import qualified Data.Text as T
  import Data.Time (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime)
  import System.Random (randomRIO)
  import Web.Scotty.Action (ActionT)
  import Web.Scotty.Cookie
  
  -- | Type alias for session identifiers.
  type SessionId = T.Text
  
  -- | Status of a session lookup.
  data SessionStatus = SessionNotFound | SessionExpired
    deriving (Show, Eq)
  
  -- | Represents a session containing an ID, expiration time, and content.
  data Session a = Session
      { sessId :: SessionId
      -- ^ Unique identifier for the session.
      , sessExpiresAt :: UTCTime
      -- ^ Expiration time of the session.
      , sessContent :: a
      -- ^ Content stored in the session.
      }
      deriving (Eq, Show)
  
  -- | Type for session storage, a transactional variable containing a map of session IDs to sessions.
  type SessionJar a = TVar (HM.HashMap SessionId (Session a))
  
  -- | Creates a new session jar and starts a background thread to maintain it.
  createSessionJar :: IO (SessionJar a)
  createSessionJar = do
      storage <- newTVarIO HM.empty
      _ <- forkIO $ maintainSessions storage
      return storage
  
  -- | Continuously removes expired sessions from the session jar.
  maintainSessions :: SessionJar a -> IO ()
  maintainSessions sessionJar =
      forever $ do
          now <- getCurrentTime
          let stillValid sess = sessExpiresAt sess > now
          atomically $ modifyTVar sessionJar $ \m -> HM.filter stillValid m
          threadDelay 1000000
          
  
  -- | Adds or overwrites a new session to the session jar.
  addSession :: SessionJar a -> Session a -> IO ()
  addSession sessionJar sess =
      atomically $ modifyTVar sessionJar $ \m -> HM.insert (sessId sess) sess m
  
  -- | Retrieves a session by its ID from the session jar.
  getSession :: (MonadIO m) => SessionJar a -> SessionId -> ActionT m (Either SessionStatus (Session a))
  getSession sessionJar sId =
      do
          s <- liftIO $ readTVarIO sessionJar
          case HM.lookup sId s of
            Nothing -> pure $ Left SessionNotFound
            Just sess -> do 
              now <- liftIO getCurrentTime
              if sessExpiresAt sess < now
                then deleteSession sessionJar (sessId sess) >> pure (Left SessionExpired)
                else pure $ Right sess
  
  -- | Deletes a session by its ID from the session jar.
  deleteSession :: (MonadIO m) => SessionJar a -> SessionId -> ActionT m ()
  deleteSession sessionJar sId =
      liftIO $
          atomically $
              modifyTVar sessionJar $
                  HM.delete sId
  
  {- | Retrieves the current user's session based on the "sess_id" cookie.
  | Returns `Left SessionStatus` if the session is expired or does not exist.
  -}
  getUserSession :: (MonadIO m) => SessionJar a -> ActionT m (Either SessionStatus (Session a))
  getUserSession sessionJar = do
      getCookie "sess_id" >>= \case
          Nothing -> pure $ Left SessionNotFound
          Just sid -> lookupSession sid
    where
      lookupSession = getSession sessionJar
  
  -- | Reads the content of a session by its ID.
  readSession :: (MonadIO m) => SessionJar a -> SessionId -> ActionT m (Either SessionStatus a)
  readSession sessionJar sId = do
      res <- getSession sessionJar sId
      return $ sessContent <$> res
  
  -- | Reads the content of the current user's session.
  readUserSession :: (MonadIO m) => SessionJar a -> ActionT m (Either SessionStatus a)
  readUserSession sessionJar = do
      res <- getUserSession sessionJar
      return $ sessContent <$> res
  
  -- | The time-to-live for sessions, in seconds.
  sessionTTL :: NominalDiffTime
  sessionTTL = 36000 -- in seconds
  
  -- | Creates a new session for a user, storing the content and setting a cookie.
  createUserSession :: (MonadIO m) => 
      SessionJar a -- ^ SessionJar, which can be created by createSessionJar
      -> Maybe Int  -- ^ Optional expiration time (in seconds)
      -> a          -- ^ Content
      -> ActionT m (Session a)
  createUserSession sessionJar mbExpirationTime content = do
      sess <- liftIO $ createSession sessionJar mbExpirationTime content
      setSimpleCookie "sess_id" (sessId sess)
      return sess
  
  -- | Creates a new session with a generated ID, sets its expiration, 
  -- | and adds it to the session jar.
  createSession :: SessionJar a -> Maybe Int -> a -> IO (Session a)
  createSession sessionJar mbExpirationTime content = do
      sId <- liftIO $ T.pack <$> replicateM 32 (randomRIO ('a', 'z'))
      now <- getCurrentTime
      let expiresAt = addUTCTime (maybe sessionTTL fromIntegral mbExpirationTime) now
          sess = Session sId expiresAt content
      liftIO $ addSession sessionJar sess
      return $ Session sId expiresAt content
  