diff options
author | William Carroll <wpcarro@gmail.com> | 2021-01-22T10·49+0000 |
---|---|---|
committer | William Carroll <wpcarro@gmail.com> | 2021-01-22T11·00+0000 |
commit | e326b0da45a948668f523d5f715660981a9874c2 (patch) | |
tree | 34c425b23d122aa63b3a15d97b08298ee1db00c7 /assessments/tt/src/Sessions.hs | |
parent | 67e0f93b3bbc386421a276cbd5675f5ac51625ae (diff) | |
parent | ee8e75231cd9d3d4aa3ffbbfa0e3b8511712e1ee (diff) |
Add 'assessments/tt/' from commit 'ee8e75231cd9d3d4aa3ffbbfa0e3b8511712e1ee'
git-subtree-dir: assessments/tt git-subtree-mainline: 67e0f93b3bbc386421a276cbd5675f5ac51625ae git-subtree-split: ee8e75231cd9d3d4aa3ffbbfa0e3b8511712e1ee
Diffstat (limited to 'assessments/tt/src/Sessions.hs')
-rw-r--r-- | assessments/tt/src/Sessions.hs | 74 |
1 files changed, 74 insertions, 0 deletions
diff --git a/assessments/tt/src/Sessions.hs b/assessments/tt/src/Sessions.hs new file mode 100644 index 000000000000..713059a38383 --- /dev/null +++ b/assessments/tt/src/Sessions.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +-------------------------------------------------------------------------------- +module Sessions where +-------------------------------------------------------------------------------- +import Database.SQLite.Simple + +import qualified Data.Time.Clock as Clock +import qualified Types as T +import qualified System.Random as Random +-------------------------------------------------------------------------------- + +-- | Return True if `session` was created at most three hours ago. +isValid :: T.StoredSession -> IO Bool +isValid session = do + t1 <- Clock.getCurrentTime + let t0 = T.storedSessionTsCreated session in + pure $ Clock.diffUTCTime t1 t0 <= 3 * 60 * 60 + +-- | Lookup the session by UUID. +get :: FilePath -> T.SessionUUID -> IO (Maybe T.StoredSession) +get dbFile uuid = withConnection dbFile $ \conn -> do + res <- query conn "SELECT uuid,username,tsCreated FROM Sessions WHERE uuid = ?" (Only uuid) + case res of + [x] -> pure (Just x) + _ -> pure Nothing + +-- | Lookup the session stored under `username` in `dbFile`. +find :: FilePath -> T.Username -> IO (Maybe T.StoredSession) +find dbFile username = withConnection dbFile $ \conn -> do + res <- query conn "SELECT uuid,username,tsCreated FROM Sessions WHERE username = ?" (Only username) + case res of + [x] -> pure (Just x) + _ -> pure Nothing + +-- | Create a session under the `username` key in `dbFile`. +create :: FilePath -> T.Username -> IO T.SessionUUID +create dbFile username = withConnection dbFile $ \conn -> do + now <- Clock.getCurrentTime + uuid <- Random.randomIO + execute conn "INSERT INTO Sessions (uuid,username,tsCreated) VALUES (?,?,?)" + (T.SessionUUID uuid, username, now) + pure (T.SessionUUID uuid) + +-- | Reset the tsCreated field to the current time to ensure the token is valid. +refresh :: FilePath -> T.SessionUUID -> IO () +refresh dbFile uuid = withConnection dbFile $ \conn -> do + now <- Clock.getCurrentTime + execute conn "UPDATE Sessions SET tsCreated = ? WHERE uuid = ?" + (now, uuid) + pure () + +-- | Delete the session under `username` from `dbFile`. +delete :: FilePath -> T.SessionUUID -> IO () +delete dbFile uuid = withConnection dbFile $ \conn -> + execute conn "DELETE FROM Sessions WHERE uuid = ?" (Only uuid) + +-- | Find or create a session in the Sessions table. If a session exists, +-- refresh the token's validity. +findOrCreate :: FilePath -> T.Account -> IO T.SessionUUID +findOrCreate dbFile account = + let username = T.accountUsername account in do + mSession <- find dbFile username + case mSession of + Nothing -> create dbFile username + Just session -> + let uuid = T.storedSessionUUID session in do + refresh dbFile uuid + pure uuid + +-- | Return a list of all sessions in the Sessions table. +list :: FilePath -> IO [T.StoredSession] +list dbFile = withConnection dbFile $ \conn -> + query_ conn "SELECT uuid,username,tsCreated FROM Sessions" |