1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
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"
|
