diff --git a/shell.nix b/shell.nix index e003737f3..8c948e9cb 100644 --- a/shell.nix +++ b/shell.nix @@ -9,6 +9,7 @@ in pkgs.mkShell { hpkgs.sqlite-simple hpkgs.warp hpkgs.cryptonite + hpkgs.uuid ])) ]; } diff --git a/src/Sessions.hs b/src/Sessions.hs new file mode 100644 index 000000000..238a70b6e --- /dev/null +++ b/src/Sessions.hs @@ -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" diff --git a/src/Types.hs b/src/Types.hs index 6782b9ec3..6a474a509 100644 --- a/src/Types.hs +++ b/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 diff --git a/src/init.sql b/src/init.sql index f1109feac..1439bd338 100644 --- a/src/init.sql +++ b/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;