Create Sessions table

TL;DR:
- Create Sessions SQL schema
- Create Sessions module
- Introduce UUID dependency
This commit is contained in:
William Carroll 2020-07-28 18:40:17 +01:00
parent 012296f156
commit 36a2fea686
4 changed files with 108 additions and 2 deletions

View file

@ -9,6 +9,7 @@ in pkgs.mkShell {
hpkgs.sqlite-simple
hpkgs.warp
hpkgs.cryptonite
hpkgs.uuid
]))
];
}

67
src/Sessions.hs Normal file
View file

@ -0,0 +1,67 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
--------------------------------------------------------------------------------
module Sessions where
--------------------------------------------------------------------------------
import Data.Function ((&))
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 stored under `username` in `dbFile`.
find :: FilePath -> T.Username -> IO (Maybe T.StoredSession)
find dbFile username = withConnection dbFile $ \conn -> do
res <- query conn "SELECT * 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.Username -> IO ()
delete dbFile username = withConnection dbFile $ \conn ->
execute conn "DELETE FROM Sessions WHERE username = ?" (Only username)
-- | 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 * FROM Sessions"

View file

@ -17,9 +17,11 @@ import GHC.Generics
import Crypto.Random.Types (MonadRandom)
import qualified Crypto.KDF.BCrypt as BC
import qualified Data.Time.Clock as Clock
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as TE
import qualified Data.UUID as UUID
--------------------------------------------------------------------------------
-- TODO(wpcarro): Properly handle NULL for columns like profilePicture.
@ -340,3 +342,30 @@ createAccountRequestFields request =
, createAccountRequestEmail request
, createAccountRequestRole request
)
newtype SessionUUID = SessionUUID UUID.UUID
deriving (Eq, Show, Generic)
instance FromField SessionUUID where
fromField field =
case fieldData field of
(SQLText x) ->
case UUID.fromText x of
Nothing -> returnError ConversionFailed field ""
Just x -> Ok $ SessionUUID x
_ -> returnError ConversionFailed field ""
instance ToField SessionUUID where
toField (SessionUUID uuid) =
uuid |> UUID.toText |> SQLText
data StoredSession = StoredSession
{ storedSessionUUID :: SessionUUID
, storedSessionUsername :: Username
, storedSessionTsCreated :: Clock.UTCTime
} deriving (Eq, Show, Generic)
instance FromRow StoredSession where
fromRow = StoredSession <$> field
<*> field
<*> field

View file

@ -8,6 +8,7 @@ BEGIN TRANSACTION;
DROP TABLE IF EXISTS Accounts;
DROP TABLE IF EXISTS Trips;
DROP TABLE IF EXISTS Sessions;
CREATE TABLE Accounts (
-- TODO(wpcarro): Add CHECK(..) constraint
@ -22,11 +23,19 @@ CREATE TABLE Accounts (
CREATE TABLE Trips (
username TEXT NOT NULL,
destination TEXT CHECK(LENGTH(destination) > 0) NOT NULL,
startDate TEXT CHECK(LENGTH(startDate) == 10) NOT NULL, -- YYYY-MM-DD
endDate TEXT CHECK(LENGTH(endDate) == 10) NOT NULL, -- YYYY-MM-DD
startDate TEXT CHECK(LENGTH(startDate) == 10) NOT NULL, -- 'YYYY-MM-DD'
endDate TEXT CHECK(LENGTH(endDate) == 10) NOT NULL, -- 'YYYY-MM-DD'
comment TEXT NOT NULL,
PRIMARY KEY (username, destination, startDate),
FOREIGN KEY (username) REFERENCES Accounts ON DELETE CASCADE
);
CREATE TABLE Sessions (
uuid TEXT CHECK(LENGTH(uuid) == 36) NOT NULL,
username TEXT NOT NULL UNIQUE,
tsCreated TEXT CHECK(LENGTH(tsCreated) == 33) NOT NULL, -- 'YYYY-MM-DD HH:MM:SS'
PRIMARY KEY (uuid),
FOREIGN KEY (username) REFERENCES Accounts ON DELETE CASCADE
);
COMMIT;