Create Sessions table

TL;DR:
- Create Sessions SQL schema
- Create Sessions module
- Introduce UUID dependency

shell.nix

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

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"

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

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
+  startDate TEXT CHECK(LENGTH(startDate) == 10) NOT NULL, -- 'YYYY-MM-DD'
-  endDate TEXT CHECK(LENGTH(endDate) == 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;