6ecab8c3a6
"SELECT *" in SQL may not guarantee the order in which a record's columns are
returned. For example, in my FromRow instances for Account, I make successive call
The following scenario silently and erroneously assigns:
firstName, lastName = lastName, firstName
```sql
CREATE TABLE People (
firstName TEXT NOT NULL,
lastName TEXT NOT NULL,
age INTEGER NOT NULL,
PRIMARY KEY (firstName, lastName)
)
```
```haskell
data Person = Person { firstName :: String, lastName :: String, age :: Integer }
fromRow = do
firstName <- field
lastName <- field
age <- field
pure Person{..}
getPeople :: Connection -> IO [Person]
getPeople conn = query conn "SELECT * FROM People"
```
This silently fails because both firstName and lastName are Strings, and so the
FromRow Person instance type-checks, but you should expect to receive a list of
names like "Wallace William" instead of "William Wallace".
The following won't break the type-checker, but will result in a runtime parsing
error:
```haskell
-- all code from the previous example remains the same except for:
fromRow = do
age <- field
firstName <- field
lastName <- field
```
The "SELECT *" will return records like (firstName,lastName,age), but the
FromRow instance for Person will attempt to parse firstName as
Integer.
So... what have we learned? Prefer "SELECT (firstName,lastName,age)" instead of
"SELECT *".
74 lines
2.9 KiB
Haskell
74 lines
2.9 KiB
Haskell
{-# 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 = withConnection dbFile $ \conn ->
|
|
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"
|