From 99684e962ef4f6236a4e835497fc78fc7f7bb59d Mon Sep 17 00:00:00 2001 From: tusharad Date: Sat, 4 Jan 2025 13:49:23 +0530 Subject: [PATCH] Added ActionM versions of session functions --- Web/Scotty.hs | 43 ++++++++++++++++++++++++++++++++++-------- Web/Scotty/Session.hs | 33 ++++++++++++++++++-------------- changelog.md | 2 +- examples/session.hs | 4 ++-- test/Web/ScottySpec.hs | 2 +- 5 files changed, 58 insertions(+), 26 deletions(-) diff --git a/Web/Scotty.hs b/Web/Scotty.hs index 45ea4f7..2786415 100644 --- a/Web/Scotty.hs +++ b/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 diff --git a/Web/Scotty/Session.hs b/Web/Scotty/Session.hs index 7c718cc..82fb9ed 100644 --- a/Web/Scotty/Session.hs +++ b/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 diff --git a/changelog.md b/changelog.md index c203314..1dba44c 100644 --- a/changelog.md +++ b/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). diff --git a/examples/session.hs b/examples/session.hs index 035a28c..45a0205 100644 --- a/examples/session.hs +++ b/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." \ No newline at end of file + text "Logged out successfully." diff --git a/test/Web/ScottySpec.hs b/test/Web/ScottySpec.hs index 18da6b8..0068eff 100644 --- a/test/Web/ScottySpec.hs +++ b/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