Create Sessions table
TL;DR: - Create Sessions SQL schema - Create Sessions module - Introduce UUID dependency
This commit is contained in:
parent
012296f156
commit
36a2fea686
4 changed files with 108 additions and 2 deletions
|
@ -9,6 +9,7 @@ in pkgs.mkShell {
|
|||
hpkgs.sqlite-simple
|
||||
hpkgs.warp
|
||||
hpkgs.cryptonite
|
||||
hpkgs.uuid
|
||||
]))
|
||||
];
|
||||
}
|
||||
|
|
67
src/Sessions.hs
Normal file
67
src/Sessions.hs
Normal 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"
|
29
src/Types.hs
29
src/Types.hs
|
@ -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
|
||||
|
|
13
src/init.sql
13
src/init.sql
|
@ -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;
|
||||
|
|
Loading…
Reference in a new issue