Added ActionM versions of session functions

Web/Scotty.hs

@@ -57,9 +57,10 @@ module Web.Scotty
     -- ** Functions from Cookie module
     , setSimpleCookie, getCookie, getCookies, deleteCookie, makeSimpleCookie
     -- ** Session Management
-    , Session (..), SessionId, SessionJar, createSessionJar,
-    createUserSession, createSession, readUserSession,
-    readSession, getUserSession, getSession, addSession, deleteSession, maintainSessions
+    , Session (..), SessionId, SessionJar, SessionStatus
+    , createSessionJar, createUserSession, createSession, addSession
+    , readSession, getUserSession, getSession, readUserSession
+    , deleteSession, maintainSessions
     ) where
 
 import qualified Web.Scotty.Trans as Trans
@@ -81,9 +82,8 @@ import Web.FormUrlEncoded (FromForm)
 import Web.Scotty.Internal.Types (ScottyT, ActionT, ErrorHandler, Param, RoutePattern, Options, defaultOptions, File, Kilobytes, ScottyState, defaultScottyState, ScottyException, StatusError(..), Content(..))
 import UnliftIO.Exception (Handler(..), catch)
 import Web.Scotty.Cookie (setSimpleCookie, getCookie, getCookies, deleteCookie, makeSimpleCookie)
-import Web.Scotty.Session (Session (..), SessionId, SessionJar, createSessionJar,
-    createUserSession, createSession, readUserSession,
-    readSession, getUserSession, getSession, addSession, deleteSession, maintainSessions)
+import Web.Scotty.Session (Session (..), SessionId, SessionJar, SessionStatus , createSessionJar,
+    createSession, addSession, maintainSessions)
 
 {- $setup
 >>> :{
@@ -601,5 +601,32 @@ literal :: String -> RoutePattern
 literal = Trans.literal
 
 
-
-
+-- | Retrieves a session by its ID from the session jar.
+getSession :: SessionJar a -> SessionId -> ActionM (Either SessionStatus (Session a))
+getSession = Trans.getSession
+
+-- | Deletes a session by its ID from the session jar.
+deleteSession :: SessionJar a -> SessionId -> ActionM ()
+deleteSession = Trans.deleteSession
+
+{- | 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 :: SessionJar a -> ActionM (Either SessionStatus (Session a))
+getUserSession = Trans.getUserSession
+
+-- | Reads the content of a session by its ID.
+readSession :: SessionJar a -> SessionId -> ActionM (Either SessionStatus a)
+readSession = Trans.readSession
+
+-- | Reads the content of the current user's session.
+readUserSession ::SessionJar a -> ActionM (Either SessionStatus a)
+readUserSession = Trans.readUserSession
+
+-- | Creates a new session for a user, storing the content and setting a cookie.
+createUserSession :: 
+    SessionJar a -- ^ SessionJar, which can be created by createSessionJar
+    -> Maybe Int  -- ^ Optional expiration time (in seconds)
+    -> a          -- ^ Content
+    -> ActionM (Session a)
+createUserSession = Trans.createUserSession

Web/Scotty/Session.hs

@@ -2,9 +2,9 @@
 {-# LANGUAGE LambdaCase #-}
 
 {- |
-Module      : Web.Scotty.Cookie
-Copyright   : (c) 2014, 2015 Mārtiņš Mačs,
-              (c) 2023 Marco Zocca
+Module      : Web.Scotty.Session
+Copyright   : (c) 2025 Tushar Adhatrao,
+              (c) 2025 Marco Zocca
 
 License     : BSD-3-Clause
 Maintainer  :
@@ -32,8 +32,8 @@ main = do
             html $ "Session created with ID: " <> sessId sess
         -- Route to read a session
         get "/read" $ do
-            mSession <- getUserSession sessionJar
-            case mSession of
+            eSession <- getUserSession sessionJar
+            case eSession of
                 Left _-> html "No session found or session expired."
                 Right sess -> html $ "Session content: " <> sessContent sess
 @
@@ -116,7 +116,7 @@ maintainSessions sessionJar =
         threadDelay 1000000
 
 
--- | Adds a new session to the session jar.
+-- | 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
@@ -143,7 +143,7 @@ deleteSession sessionJar sId =
                 HM.delete sId
 
 {- | Retrieves the current user's session based on the "sess_id" cookie.
-| Returns 'Nothing' if the session is expired or does not exist.
+| 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
@@ -170,18 +170,23 @@ 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 -> a -> ActionT m (Session a)
-createUserSession sessionJar content = do
-    sess <- liftIO $ createSession sessionJar content
+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 -> a -> IO (Session a)
-createSession sessionJar content = do
+-- | 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 sessionTTL now
+    let expiresAt = addUTCTime (maybe sessionTTL fromIntegral mbExpirationTime) now
         sess = Session sId expiresAt content
     liftIO $ addSession sessionJar sess
     return $ Session sId expiresAt content

changelog.md

@@ -1,6 +1,6 @@
 ## next [????.??.??]
 
-* Added sessions.
+* Added sessions (#317).
 * Fixed cookie example from `Cookie` module documentation. `getCookie` Function would return strict variant of `Text`. Will convert it into lazy variant using `fromStrict`. 
 * Exposed simple functions of `Cookie` module via `Web.Scotty` & `Web.Scotty.Trans`.
 * Add tests for URL encoding of query parameters and form parameters. Add `formData` action for decoding `FromForm` instances (#321).

examples/session.hs

@@ -15,7 +15,7 @@ main = do
             password <- queryParam "password" :: ActionM String
             if username == "foo" && password == "bar"
                 then do
-                    _ <- createUserSession sessionJar "foo"
+                    _ <- createUserSession sessionJar Nothing "foo"
                     text "Login successful!"
                 else
                     text "Invalid username or password."
@@ -28,4 +28,4 @@ main = do
         -- Logout route
         get "/logout" $ do
             deleteCookie "sess_id"
-            text "Logged out successfully."
+            text "Logged out successfully."

test/Web/ScottySpec.hs

@@ -542,7 +542,7 @@ spec = do
     describe "Session Management" $ do
       withApp (Scotty.get "/scotty" $ do
                  sessionJar <- liftIO createSessionJar 
-                 sess <- createUserSession sessionJar ("foo" :: T.Text)
+                 sess <- createUserSession sessionJar Nothing ("foo" :: T.Text)
                  mRes <- readSession sessionJar (sessId sess)
                  case mRes of
                    Left _ -> Scotty.status status400