jbrechtel/sis
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
e8036bab114b840df3cc2791d67c0bd17db87836
sis/src/Sis/Database.hs
T

524 lines
26 KiB
Haskell
Raw Blame History

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
-- | SQLite database support for Sis using the effectful effect system.
module Sis.Database (
-- * Effect
DB (..),
runDB,
openDatabase,
runMigrations,
-- * DB operations (convenience wrappers)
findUserByEmail,
createUser,
getUser,
getUserHouseholds,
getHousehold,
createHousehold,
getMembers,
getChores,
createChore,
updateChore,
deleteChore,
getDashboard,
recordActivity,
getActivityLog,
createInvite,
getInvites,
revokeInvite,
acceptInvite,
seed,
) where
import Control.Monad (when)
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time (Day, UTCTime, addDays, getCurrentTime, utctDay)
import Data.Time qualified as Time
import Data.Time.Calendar (addGregorianMonthsClip)
import Database.SQLite.Simple (Only (..))
import Database.SQLite.Simple qualified as SQL
import Effectful
import Effectful.Dispatch.Dynamic
import System.Directory (createDirectoryIfMissing)
import System.FilePath (takeDirectory)
import Text.Read (readMaybe)
import Crypto.Random.Entropy (getEntropy)
import Data.ByteString.Base64 qualified as B64
import Data.Text.Encoding qualified as TE
import Sis.Auth (hashPassword)
import Sis.Types
----------------------------------------------------------------------
-- Effect definition
----------------------------------------------------------------------
data DB :: Effect where
FindUserByEmail :: Text -> DB m (Maybe User)
CreateUser :: Text -> Text -> Text -> DB m UserId
GetUser :: UserId -> DB m (Maybe User)
GetUserHouseholds :: UserId -> DB m [Household]
GetHousehold :: UserId -> Int -> DB m (Maybe Household)
CreateHousehold :: UserId -> Text -> DB m Household
GetMembers :: Int -> DB m [Membership]
GetChores :: Int -> DB m [Chore]
CreateChore :: Int -> Text -> ChoreAssignee -> Schedule -> Bool -> DB m Chore
UpdateChore :: Int -> Int -> Text -> ChoreAssignee -> Schedule -> Bool -> DB m Chore
DeleteChore :: Int -> DB m ()
GetDashboard :: Int -> Day -> DB m Dashboard
GenerateOccurrences :: Chore -> DB m ()
RecordActivity :: Int -> UserId -> ActivityStatus -> Maybe Text -> Bool -> DB m Activity
GetActivityLog :: Int -> Int -> Int -> DB m ActivityLogPage
CreateInvite :: Int -> Maybe Text -> DB m Invite
GetInvites :: Int -> DB m [Invite]
RevokeInvite :: Int -> DB m ()
AcceptInvite :: UserId -> Text -> DB m Household
Seed :: DB m ()
type instance DispatchOf DB = 'Dynamic
----------------------------------------------------------------------
-- Handler
----------------------------------------------------------------------
runDB :: (IOE :> es) => SQL.Connection -> Eff (DB : es) a -> Eff es a
runDB conn = interpret $ \_ -> \case
FindUserByEmail email -> liftIO $ do
result <-
SQL.query
conn
"SELECT id, display_name, email, password_hash FROM users WHERE email = ?"
(Only email)
pure $ listToMaybe [User (UserId uid) dname em pwHash | (uid, dname, em, pwHash) <- result]
CreateUser dname email pwHash -> liftIO $ do
SQL.execute
conn
"INSERT INTO users (display_name, email, password_hash) VALUES (?, ?, ?)"
(dname, email, pwHash)
uid <- SQL.lastInsertRowId conn
pure $ UserId (fromIntegral uid)
GetUser (UserId uid) -> liftIO $ do
result <-
SQL.query
conn
"SELECT id, display_name, email, password_hash FROM users WHERE id = ?"
(Only uid)
pure $ listToMaybe [User (UserId uid') dname em pwHash | (uid', dname, em, pwHash) <- result]
GetUserHouseholds (UserId uid) -> liftIO $ do
rows <-
SQL.query
conn
"SELECT h.id, h.name, m2.user_id, \
\ (SELECT COUNT(*) FROM memberships WHERE household_id = h.id) \
\ FROM households h JOIN memberships m ON m.household_id = h.id AND m.user_id = ? \
\ JOIN memberships m2 ON m2.household_id = h.id AND m2.role = 'owner'"
(Only uid)
pure [Household (HouseholdId hId) hName (UserId ownerId) count | (hId, hName, ownerId, count) <- rows]
GetHousehold (UserId uid) hid -> liftIO $ do
result <-
SQL.query
conn
"SELECT h.id, h.name, m2.user_id, (SELECT COUNT(*) FROM memberships WHERE household_id = h.id) \
\ FROM households h JOIN memberships m ON m.household_id = h.id AND m.user_id = ? \
\ JOIN memberships m2 ON m2.household_id = h.id AND m2.role = 'owner' WHERE h.id = ?"
(uid, hid)
pure $ listToMaybe [Household (HouseholdId hId) hName (UserId ownerId) count | (hId, hName, ownerId, count) <- result]
CreateHousehold (UserId uid) name -> liftIO $ do
SQL.execute conn "INSERT INTO households (name) VALUES (?)" (Only name)
hId <- SQL.lastInsertRowId conn
let hid = HouseholdId (fromIntegral hId)
SQL.execute
conn
"INSERT INTO memberships (household_id, user_id, role) VALUES (?, ?, ?)"
(unHouseholdId hid, uid, "owner" :: String)
pure $ Household hid name (UserId uid) 1
GetMembers hid -> liftIO $ do
members <-
SQL.query
conn
"SELECT u.id, u.display_name, u.email, m.role \
\ FROM memberships m JOIN users u ON u.id = m.user_id WHERE m.household_id = ?"
(Only hid)
pure
[ Membership (UserId uid) dname email (if role == ("owner" :: String) then OwnerRole else MemberRole)
| (uid, dname, email, role) <- members
]
GetChores hid -> liftIO $ do
chores <-
SQL.query
conn
"SELECT id, household_id, name, assignee_type, assignee_user_id, schedule_data, notify_on_due, created_at \
\ FROM chores WHERE household_id = ?"
(Only hid) ::
IO [(Int, Int, Text, String, Maybe Int, Text, Int, UTCTime)]
pure
[ Chore
{ choreId = ChoreId cid
, choreHouseholdId = HouseholdId hId
, choreName = cname
, choreAssignee = mkAssignee atype auid
, choreSchedule = mkSchedule sData
, choreNotifyOnDue = nud /= 0
, choreCreatedAt = createdAt
}
| (cid, hId, cname, atype, auid, sData, nud, createdAt) <- chores
]
where
mkAssignee "user" (Just uid) = AssigneeUser (UserId uid)
mkAssignee _ _ = AssigneeAnyone
mkSchedule sData = fromMaybe ScheduleSometime (readMaybe (T.unpack sData))
CreateChore hid name assignee schedule notify -> liftIO $ do
now <- Time.getCurrentTime
let (aType, aUid) = case assignee of AssigneeUser (UserId uid) -> ("user" :: String, Just uid); AssigneeAnyone -> ("anyone", Nothing)
sType = case schedule of ScheduleOneOff{} -> "one_off" :: String; ScheduleRecurring{} -> "recurring"; ScheduleSometime -> "sometime"
sData = show schedule
SQL.execute
conn
"INSERT INTO chores (household_id, name, assignee_type, assignee_user_id, schedule_type, schedule_data, notify_on_due, created_at) \
\ VALUES (?,?,?,?,?,?,?,?)"
(hid, name, aType, aUid, sType, sData, if notify then 1 :: Int else 0, now)
cId <- SQL.lastInsertRowId conn
let chore = Chore (ChoreId (fromIntegral cId)) (HouseholdId hid) name assignee schedule notify now
generateOccurrencesIO conn chore
pure chore
UpdateChore cid hid name assignee schedule notify -> liftIO $ do
now <- Time.getCurrentTime
let (aType, aUid) = case assignee of AssigneeUser (UserId uid) -> ("user" :: String, Just uid); AssigneeAnyone -> ("anyone", Nothing)
sType = case schedule of ScheduleOneOff{} -> "one_off" :: String; ScheduleRecurring{} -> "recurring"; ScheduleSometime -> "sometime"
sData = show schedule
SQL.execute
conn
"UPDATE chores SET name=?, assignee_type=?, assignee_user_id=?, schedule_type=?, schedule_data=?, notify_on_due=? WHERE id=? AND household_id=?"
(name, aType, aUid, sType, sData, if notify then 1 :: Int else 0, cid, hid)
SQL.execute conn "DELETE FROM occurrences WHERE chore_id = ? AND status IN ('due', 'overdue')" (Only cid)
let chore = Chore (ChoreId cid) (HouseholdId hid) name assignee schedule notify now
generateOccurrencesIO conn chore
pure chore
DeleteChore cid -> liftIO $ do
SQL.execute conn "DELETE FROM chores WHERE id = ?" (Only cid)
GetDashboard hid today -> liftIO $ do
let todayStr = show today
let weekAgo = show (addDays (-7) today)
[Only overdueCount] <-
SQL.query
conn
"SELECT COUNT(*) FROM occurrences o JOIN chores c ON c.id = o.chore_id \
\ WHERE c.household_id = ? AND o.due_date < ? AND o.status IN ('due', 'overdue')"
(hid, todayStr)
[Only dueTodayCount] <-
SQL.query
conn
"SELECT COUNT(*) FROM occurrences o JOIN chores c ON c.id = o.chore_id \
\ WHERE c.household_id = ? AND o.due_date = ? AND o.status = 'due'"
(hid, todayStr)
[Only doneThisWeek] <-
SQL.query
conn
"SELECT COUNT(*) FROM activities a JOIN occurrences o ON o.id = a.occurrence_id JOIN chores c ON c.id = o.chore_id \
\ WHERE c.household_id = ? AND a.recorded_at >= ?"
(hid, weekAgo)
let stats = DashboardStats overdueCount dueTodayCount doneThisWeek
dueRows <-
SQL.query
conn
"SELECT o.id, o.chore_id, o.due_date, o.status, c.name, u.display_name \
\ FROM occurrences o JOIN chores c ON c.id = o.chore_id LEFT JOIN users u ON u.id = c.assignee_user_id \
\ WHERE c.household_id = ? AND o.due_date <= ? AND o.status IN ('due', 'overdue') ORDER BY o.due_date LIMIT 50"
(hid, todayStr) ::
IO [(Int, Int, Day, Text, Text, Maybe Text)]
let dueItems = [DueItem (Occurrence (OccurrenceId oid) (ChoreId cid) d (mkOcc st)) cn uname (d < today) | (oid, cid, d, st, cn, uname) <- dueRows]
compRows <-
SQL.query
conn
"SELECT a.id, a.occurrence_id, a.user_id, a.status, a.note, a.notify_household, a.recorded_at, u.display_name, c.name \
\ FROM activities a JOIN occurrences o ON o.id = a.occurrence_id JOIN chores c ON c.id = o.chore_id JOIN users u ON u.id = a.user_id \
\ WHERE c.household_id = ? AND a.recorded_at >= ? ORDER BY a.recorded_at DESC LIMIT 50"
(hid, show today) ::
IO [(Int, Int, Int, Text, Maybe Text, Int, UTCTime, Text, Text)]
let compItems = [CompletedItem (Activity (ActivityId aid) (OccurrenceId oid) (UserId uid) (mkAct st) note (nh /= 0) recAt) uname cn | (aid, oid, uid, st, note, nh, recAt, uname, cn) <- compRows]
pure $ Dashboard stats dueItems compItems
where
mkOcc "due" = OccDue; mkOcc "overdue" = OccOverdue; mkOcc _ = OccCompleted
mkAct "completed" = ActivityCompleted; mkAct _ = ActivitySkipped
GenerateOccurrences chore -> liftIO $ generateOccurrencesIO conn chore
RecordActivity oid (UserId uid) status note notify -> liftIO $ do
now <- Time.getCurrentTime
let actStatus = case status of ActivityCompleted -> "completed" :: String; ActivitySkipped -> "skipped"
SQL.execute
conn
"INSERT INTO activities (occurrence_id, user_id, status, note, notify_household, recorded_at) VALUES (?,?,?,?,?,?)"
(oid, uid, actStatus, note, if notify then 1 :: Int else 0, now)
let occStatus = case status of ActivityCompleted -> "completed" :: String; ActivitySkipped -> "skipped"
SQL.execute conn "UPDATE occurrences SET status = ? WHERE id = ?" (occStatus, oid)
actId <- SQL.lastInsertRowId conn
pure $ Activity (ActivityId (fromIntegral actId)) (OccurrenceId oid) (UserId uid) status note notify now
GetActivityLog hid page perPage -> liftIO $ do
let offset = (page - 1) * perPage
[Only totalCount] <-
SQL.query
conn
"SELECT COUNT(*) FROM activities a JOIN occurrences o ON o.id = a.occurrence_id JOIN chores c ON c.id = o.chore_id WHERE c.household_id = ?"
(Only hid)
entries <-
SQL.query
conn
"SELECT a.id, a.occurrence_id, a.user_id, a.status, a.note, a.notify_household, a.recorded_at, u.display_name, c.name, o.due_date \
\ FROM activities a JOIN occurrences o ON o.id = a.occurrence_id JOIN chores c ON c.id = o.chore_id JOIN users u ON u.id = a.user_id \
\ WHERE c.household_id = ? ORDER BY a.recorded_at DESC LIMIT ? OFFSET ?"
(hid, perPage, offset) ::
IO [(Int, Int, Int, Text, Maybe Text, Int, UTCTime, Text, Text, Day)]
let logEntries = [ActivityLogEntry (Activity (ActivityId aid) (OccurrenceId oid) (UserId uid) (mkAct st) note (nh /= 0) recAt) uname "" cn d | (aid, oid, uid, st, note, nh, recAt, uname, cn, d) <- entries]
pure $ ActivityLogPage logEntries page perPage totalCount
where
mkAct "completed" = ActivityCompleted; mkAct _ = ActivitySkipped
CreateInvite hid email -> liftIO $ do
code <- generateTokenIO
now <- Time.getCurrentTime
SQL.execute
conn
"INSERT INTO invites (household_id, code, email, created_at) VALUES (?, ?, ?, ?)"
(hid, code, email, now)
iid <- SQL.lastInsertRowId conn
pure $ Invite (InviteId (fromIntegral iid)) (HouseholdId hid) code email InvitePending now
GetInvites hid -> liftIO $ do
invites <-
SQL.query
conn
"SELECT id, household_id, code, email, status, created_at FROM invites WHERE household_id = ?"
(Only hid) ::
IO [(Int, Int, Text, Maybe Text, Text, UTCTime)]
pure [Invite (InviteId iid) (HouseholdId hhid) code email (mkStatus st) createdAt | (iid, hhid, code, email, st, createdAt) <- invites]
where
mkStatus "pending" = InvitePending; mkStatus "accepted" = InviteAccepted; mkStatus _ = InviteRevoked
RevokeInvite iid -> liftIO $ do
SQL.execute conn "UPDATE invites SET status = 'revoked' WHERE id = ?" (Only iid)
AcceptInvite (UserId uid) code -> liftIO $ do
result <-
SQL.query
conn
"SELECT id, household_id FROM invites WHERE code = ? AND status = 'pending'"
(Only code) ::
IO [(Int, Int)]
case result of
[(_, hid)] -> do
SQL.execute
conn
"INSERT OR IGNORE INTO memberships (household_id, user_id, role) VALUES (?, ?, ?)"
(hid, uid, "member" :: String)
SQL.execute conn "UPDATE invites SET status = 'accepted' WHERE code = ?" (Only code)
hResult <-
SQL.query
conn
"SELECT h.id, h.name, m.user_id, (SELECT COUNT(*) FROM memberships WHERE household_id = h.id) \
\ FROM households h JOIN memberships m ON m.household_id = h.id AND m.role = 'owner' WHERE h.id = ?"
(Only hid) ::
IO [(Int, Text, Int, Int)]
case listToMaybe [Household (HouseholdId hId) hName (UserId ownerId) count | (hId, hName, ownerId, count) <- hResult] of
Just h -> pure h
Nothing -> error "Household not found after accept"
_ -> error "Invite not found"
Seed -> liftIO $ do
let demoPassword = "password123"
pwHash <- hashPasswordIO demoPassword
SQL.execute conn "INSERT OR IGNORE INTO users (id, display_name, email, password_hash) VALUES (1, 'Alice', 'alice@demo.com', ?)" (Only pwHash)
SQL.execute conn "INSERT OR IGNORE INTO users (id, display_name, email, password_hash) VALUES (2, 'Bob', 'bob@demo.com', ?)" (Only pwHash)
SQL.execute conn "INSERT OR IGNORE INTO users (id, display_name, email, password_hash) VALUES (3, 'Charlie', 'charlie@demo.com', ?)" (Only pwHash)
SQL.execute_ conn "INSERT OR IGNORE INTO households (id, name) VALUES (1, 'Demo House')"
SQL.execute_ conn "INSERT OR IGNORE INTO memberships (household_id, user_id, role) VALUES (1, 1, 'owner')"
SQL.execute_ conn "INSERT OR IGNORE INTO memberships (household_id, user_id, role) VALUES (1, 2, 'member')"
SQL.execute_ conn "INSERT OR IGNORE INTO memberships (household_id, user_id, role) VALUES (1, 3, 'member')"
let sData1 = show (ScheduleRecurring PeriodDaily (read "2026-07-15") (Just "08:00:00") Nothing Nothing :: Schedule)
SQL.execute conn "INSERT OR IGNORE INTO chores (id, household_id, name, assignee_type, schedule_type, schedule_data, notify_on_due) VALUES (1, 1, 'Take out trash', 'anyone', 'recurring', ?, 1)" (Only sData1)
let sData2 = show (ScheduleRecurring PeriodWeekly (read "2026-07-13") (Just "10:00:00") (Just [1, 4]) Nothing :: Schedule)
SQL.execute conn "INSERT OR IGNORE INTO chores (id, household_id, name, assignee_type, assignee_user_id, schedule_type, schedule_data, notify_on_due) VALUES (2, 1, 'Vacuum living room', 'user', 2, 'recurring', ?, 0)" (Only sData2)
let sData3 = show (ScheduleSometime :: Schedule)
SQL.execute conn "INSERT OR IGNORE INTO chores (id, household_id, name, assignee_type, schedule_type, schedule_data, notify_on_due) VALUES (3, 1, 'Clean the garage', 'anyone', 'sometime', ?, 0)" (Only sData3)
today <- utctDay <$> getCurrentTime
let windowEnd = addDays 90 today
let dates1 = take 90 $ generateRecurringDates PeriodDaily (read "2026-07-15") today windowEnd
mapM_ (SQL.execute conn "INSERT OR IGNORE INTO occurrences (chore_id, due_date) VALUES (1, ?)" . Only) dates1
let dates2 = take 90 $ generateRecurringDates PeriodWeekly (read "2026-07-13") today windowEnd
mapM_ (SQL.execute conn "INSERT OR IGNORE INTO occurrences (chore_id, due_date) VALUES (2, ?)" . Only) dates2
SQL.execute_ conn "INSERT OR IGNORE INTO occurrences (chore_id, due_date) VALUES (3, '9999-12-31')"
----------------------------------------------------------------------
-- Helpers
----------------------------------------------------------------------
generateOccurrencesIO :: SQL.Connection -> Chore -> IO ()
generateOccurrencesIO conn' chore = do
today <- utctDay <$> getCurrentTime
let windowEnd = addDays 90 today
case choreSchedule chore of
ScheduleOneOff date _ ->
when (date >= today && date <= windowEnd) $
SQL.execute conn' "INSERT OR IGNORE INTO occurrences (chore_id, due_date) VALUES (?, ?)" (unChoreId (choreId chore), date)
ScheduleRecurring period startDate _ _ _ -> do
let dates = generateRecurringDates period startDate today windowEnd
mapM_ (\d -> SQL.execute conn' "INSERT OR IGNORE INTO occurrences (chore_id, due_date) VALUES (?, ?)" (unChoreId (choreId chore), d)) dates
ScheduleSometime ->
SQL.execute conn' "INSERT OR IGNORE INTO occurrences (chore_id, due_date) VALUES (?, '9999-12-31')" (Only (unChoreId (choreId chore)))
generateRecurringDates :: SchedulePeriod -> Day -> Day -> Day -> [Day]
generateRecurringDates period startDate fromDate toDate = go (max startDate fromDate)
where
go d | d > toDate = [] | otherwise = d : go (next period d)
next PeriodDaily = addDays 1; next PeriodWeekly = addDays 7; next PeriodMonthly = addGregorianMonthsClip 1
hashPasswordIO :: Text -> IO Text
hashPasswordIO = hashPassword
generateTokenIO :: IO Text
generateTokenIO = do
bytes <- getEntropy 32
pure $ TE.decodeUtf8 $ B64.encode bytes
----------------------------------------------------------------------
-- Database open helper
----------------------------------------------------------------------
-- | Open (or create) a SQLite database at the given path.
openDatabase :: FilePath -> IO SQL.Connection
openDatabase path = do
createDirectoryIfMissing True (takeDirectory path)
conn <- SQL.open path
SQL.execute_ conn "PRAGMA journal_mode=WAL"
SQL.execute_ conn "PRAGMA foreign_keys=ON"
runMigrations conn
pure conn
-- | Create all tables if they don't exist.
runMigrations :: SQL.Connection -> IO ()
runMigrations conn' =
mapM_
(SQL.execute_ conn')
[ "CREATE TABLE IF NOT EXISTS users (\
\ id INTEGER PRIMARY KEY AUTOINCREMENT,\
\ display_name TEXT NOT NULL,\
\ email TEXT NOT NULL UNIQUE,\
\ password_hash TEXT NOT NULL,\
\ created_at TEXT NOT NULL DEFAULT (datetime('now')))"
, "CREATE TABLE IF NOT EXISTS sessions (\
\ id INTEGER PRIMARY KEY AUTOINCREMENT,\
\ token TEXT NOT NULL UNIQUE,\
\ user_id INTEGER NOT NULL REFERENCES users(id) ON DELETE CASCADE,\
\ expires_at TEXT NOT NULL,\
\ created_at TEXT NOT NULL DEFAULT (datetime('now')))"
, "CREATE TABLE IF NOT EXISTS households (\
\ id INTEGER PRIMARY KEY AUTOINCREMENT,\
\ name TEXT NOT NULL,\
\ created_at TEXT NOT NULL DEFAULT (datetime('now')))"
, "CREATE TABLE IF NOT EXISTS memberships (\
\ id INTEGER PRIMARY KEY AUTOINCREMENT,\
\ household_id INTEGER NOT NULL REFERENCES households(id) ON DELETE CASCADE,\
\ user_id INTEGER NOT NULL REFERENCES users(id) ON DELETE CASCADE,\
\ role TEXT NOT NULL CHECK (role IN ('owner', 'member')),\
\ UNIQUE (household_id, user_id))"
, "CREATE TABLE IF NOT EXISTS invites (\
\ id INTEGER PRIMARY KEY AUTOINCREMENT,\
\ household_id INTEGER NOT NULL REFERENCES households(id) ON DELETE CASCADE,\
\ code TEXT NOT NULL UNIQUE,\
\ email TEXT,\
\ status TEXT NOT NULL DEFAULT 'pending' CHECK (status IN ('pending', 'accepted', 'revoked')),\
\ created_at TEXT NOT NULL DEFAULT (datetime('now')))"
, "CREATE TABLE IF NOT EXISTS chores (\
\ id INTEGER PRIMARY KEY AUTOINCREMENT,\
\ household_id INTEGER NOT NULL REFERENCES households(id) ON DELETE CASCADE,\
\ name TEXT NOT NULL,\
\ assignee_type TEXT NOT NULL DEFAULT 'anyone' CHECK (assignee_type IN ('user', 'anyone')),\
\ assignee_user_id INTEGER REFERENCES users(id) ON DELETE SET NULL,\
\ schedule_type TEXT NOT NULL CHECK (schedule_type IN ('one_off', 'recurring', 'sometime')),\
\ schedule_data TEXT NOT NULL,\
\ notify_on_due INTEGER NOT NULL DEFAULT 0,\
\ created_at TEXT NOT NULL DEFAULT (datetime('now')))"
, "CREATE TABLE IF NOT EXISTS occurrences (\
\ id INTEGER PRIMARY KEY AUTOINCREMENT,\
\ chore_id INTEGER NOT NULL REFERENCES chores(id) ON DELETE CASCADE,\
\ due_date TEXT NOT NULL,\
\ status TEXT NOT NULL DEFAULT 'due' CHECK (status IN ('due', 'overdue', 'completed', 'skipped')),\
\ UNIQUE (chore_id, due_date))"
, "CREATE TABLE IF NOT EXISTS activities (\
\ id INTEGER PRIMARY KEY AUTOINCREMENT,\
\ occurrence_id INTEGER NOT NULL REFERENCES occurrences(id) ON DELETE CASCADE,\
\ user_id INTEGER NOT NULL REFERENCES users(id) ON DELETE CASCADE,\
\ status TEXT NOT NULL CHECK (status IN ('completed', 'skipped')),\
\ note TEXT,\
\ notify_household INTEGER NOT NULL DEFAULT 0,\
\ recorded_at TEXT NOT NULL DEFAULT (datetime('now')))"
, "CREATE TABLE IF NOT EXISTS reset_tokens (\
\ id INTEGER PRIMARY KEY AUTOINCREMENT,\
\ user_id INTEGER NOT NULL REFERENCES users(id) ON DELETE CASCADE,\
\ token TEXT NOT NULL UNIQUE,\
\ used INTEGER NOT NULL DEFAULT 0,\
\ expires_at TEXT NOT NULL,\
\ created_at TEXT NOT NULL DEFAULT (datetime('now')))"
]
----------------------------------------------------------------------
-- Convenience wrappers (send through the DB effect)
----------------------------------------------------------------------
findUserByEmail :: (DB :> es) => Text -> Eff es (Maybe User)
findUserByEmail = send . FindUserByEmail
createUser :: (DB :> es) => Text -> Text -> Text -> Eff es UserId
createUser d e p = send (CreateUser d e p)
getUser :: (DB :> es) => UserId -> Eff es (Maybe User)
getUser = send . GetUser
getUserHouseholds :: (DB :> es) => UserId -> Eff es [Household]
getUserHouseholds = send . GetUserHouseholds
getHousehold :: (DB :> es) => UserId -> Int -> Eff es (Maybe Household)
getHousehold u = send . GetHousehold u
createHousehold :: (DB :> es) => UserId -> Text -> Eff es Household
createHousehold u = send . CreateHousehold u
getMembers :: (DB :> es) => Int -> Eff es [Membership]
getMembers = send . GetMembers
getChores :: (DB :> es) => Int -> Eff es [Chore]
getChores = send . GetChores
createChore :: (DB :> es) => Int -> Text -> ChoreAssignee -> Schedule -> Bool -> Eff es Chore
createChore h n a s b = send (CreateChore h n a s b)
updateChore :: (DB :> es) => Int -> Int -> Text -> ChoreAssignee -> Schedule -> Bool -> Eff es Chore
updateChore c h n a s b = send (UpdateChore c h n a s b)
deleteChore :: (DB :> es) => Int -> Eff es ()
deleteChore = send . DeleteChore
getDashboard :: (DB :> es) => Int -> Day -> Eff es Dashboard
getDashboard h = send . GetDashboard h
recordActivity :: (DB :> es) => Int -> UserId -> ActivityStatus -> Maybe Text -> Bool -> Eff es Activity
recordActivity o u s n b = send (RecordActivity o u s n b)
getActivityLog :: (DB :> es) => Int -> Int -> Int -> Eff es ActivityLogPage
getActivityLog h p pp = send (GetActivityLog h p pp)
createInvite :: (DB :> es) => Int -> Maybe Text -> Eff es Invite
createInvite h = send . CreateInvite h
getInvites :: (DB :> es) => Int -> Eff es [Invite]
getInvites = send . GetInvites
revokeInvite :: (DB :> es) => Int -> Eff es ()
revokeInvite = send . RevokeInvite
acceptInvite :: (DB :> es) => UserId -> Text -> Eff es Household
acceptInvite u = send . AcceptInvite u
seed :: (DB :> es) => Eff es ()
seed = send Seed
Reference in New Issue View Git Blame Copy Permalink