WIP: backend auth/chores/households work and frontend styling

2026-07-15 21:20:57 -04:00
parent 08987d7c49
commit b4e47b652f
12 changed files with 1597 additions and 276 deletions
@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
-{- | Entry point for the Sis chore tracker server.
+{- | Entry point for the Sis server.
 Starts a Warp HTTP server, serves the JSON API and the SPA frontend.
 -}
@@ -55,21 +55,20 @@ main = do
                    <> Opt.progDesc "Sis — shared household chore tracker"
                    <> Opt.header "sis-server"
-    _db <- Database.openDatabase (optDbPath opts)
+    db <- Database.openDatabase (optDbPath opts)
    -- Install a SIGTERM handler so Docker stop works cleanly.
    _ <-
        Signals.installHandler
            Signals.sigTERM
            (Signals.Catch (putStrLn "[sis] shutting down"))
            Nothing
-    let waiApp = Sis.app (optStaticDir opts)
+    let waiApp = Sis.app (optStaticDir opts) db
    let settings =
            Warp.setPort (optPort opts) $
                Warp.setBeforeMainLoop
-                    (putStrLn $ "[sis] listening on port " ++ show (optPort opts))
+                    (putStrLn $ "[sis] listening on 0.0.0.0:" ++ show (optPort opts))
                    Warp.defaultSettings
    Warp.runSettings settings waiApp
@@ -3,13 +3,14 @@
 <head>
  <meta charset="UTF-8">
  <meta name="viewport" content="width=device-width, initial-scale=1.0">
-  <title>Sis — Chore Tracker</title>
+  <title>Sis — Household Chore Tracker</title>
  <link rel="manifest" href="/manifest.json">
  <link rel="stylesheet" href="https://unpkg.com/neobrutalismcss@latest">
  <link rel="stylesheet" href="/style.css">
  <script type="importmap">
    {
      "imports": {
-        "mithril": "https://unpkg.com/mithril@2.2.13/mithril.min.js"
+        "mithril": "https://esm.sh/mithril@2.2.13"
      }
    }
  </script>
@@ -0,0 +1,13 @@
 {
  "name": "Sis",
  "short_name": "Sis",
  "description": "Shared household chore tracker",
  "start_url": "/",
  "display": "standalone",
  "theme_color": "#fff9e6",
  "background_color": "#fff9e6",
  "icons": [
    { "src": "/icon-192.png", "sizes": "192x192", "type": "image/png" },
    { "src": "/icon-512.png", "sizes": "512x512", "type": "image/png" }
  ]
 }
@@ -1,10 +1,72 @@
 /* Sis custom styles — layered on top of Neo Brutalism */
 :root {
  --nb-red: #e74c3c;
  --nb-yellow: #f1c40f;
  --nb-green: #2ecc71;
  --nb-orange: #e67e22;
 }
 body {
  min-height: 100vh;
  background: #fff9e6;
  background-image: radial-gradient(circle, rgba(0,0,0,0.03) 1px, transparent 1px);
  background-size: 20px 20px;
 }
 #app {
  padding: 1rem;
 }
 .nb-container {
  padding: 0 1rem;
 }
 .nb-navbar {
  background: #fff;
  border-bottom: 3px solid #000;
  padding: 0.75rem 1.5rem;
  display: flex;
  justify-content: space-between;
  align-items: center;
  box-shadow: 4px 4px 0 #000;
  margin-bottom: 2rem;
 }
 .nb-navbar-start, .nb-navbar-end {
  display: flex;
  align-items: center;
  gap: 0.5rem;
 }
 .nb-modal-overlay {
  animation: fadeIn 0.15s ease;
 }
@keyframes fadeIn {
  from { opacity: 0; }
  to { opacity: 1; }
 }
 /* Responsive */
@media (max-width: 768px) {
  .nb-navbar {
    flex-direction: column;
    gap: 0.5rem;
    padding: 0.5rem;
  }
  .nb-navbar-end {
    flex-wrap: wrap;
    justify-content: center;
  }
  .nb-row {
    flex-direction: column;
  }
 }
 .nb-list-item {
  border-bottom: 1px solid rgba(0,0,0,0.1);
 }
 .nb-list-item:last-child {
  border-bottom: none;
 }
@@ -26,7 +26,6 @@ ghc-options:
  - -Wincomplete-uni-patterns
  - -Wmissing-export-lists
  - -Wmissing-home-modules
  - -Wpartial-fields
  - -Wredundant-constraints
 dependencies:
@@ -47,12 +46,18 @@ dependencies:
  - text
  - time
  - wai
  - wai-extra
  - warp
 library:
  source-dirs: src
  dependencies:
    - base64-bytestring
    - cookie
    - crypton
    - memory
    - orb
    - random
    - sqlite-simple
 executables:
@@ -33,7 +33,7 @@ IMAGE="${HAWAT_HASKELL_TOOLS_IMAGE:-ghcr.io/flipstone/haskell-tools:debian-ghc-9
 STACK_ROOT_HOST="${PROJECT_DIR}/.stack-root"
 mkdir -p "${STACK_ROOT_HOST}"
-echo "[sis] listening on http://127.0.0.1:${HOST_PORT}/"
+echo "[sis] listening on http://0.0.0.0:${HOST_PORT}/"
 exec docker run --rm -i $([ -t 0 ] && printf -- -t) \
    -v "${PROJECT_DIR}:/work" \
@@ -17,6 +17,7 @@ build-type:     Simple
 library
  exposed-modules:
      Sis
      Sis.Auth
      Sis.Database
      Sis.Server
      Sis.Types
@@ -33,27 +34,33 @@ library
      OverloadedStrings
      RecordWildCards
      TupleSections
-  ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
+  ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wredundant-constraints
  build-depends:
      aeson
    , base >=4.7 && <5
    , base64-bytestring
    , beeline-routing
    , bytestring
    , containers
    , cookie
    , crypton
    , directory
    , filepath
    , http-types
    , json-fleece-aeson
    , json-fleece-core
    , memory
    , mtl
    , optparse-applicative
    , orb
    , random
    , safe-exceptions
    , shrubbery
    , sqlite-simple
    , text
    , time
    , wai
    , wai-extra
    , warp
  default-language: Haskell2010
@@ -72,7 +79,7 @@ executable sis-server
      OverloadedStrings
      RecordWildCards
      TupleSections
-  ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
+  ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
  build-depends:
      aeson
    , base >=4.7 && <5
@@ -94,6 +101,7 @@ executable sis-server
    , time
    , unix
    , wai
    , wai-extra
    , warp
  default-language: Haskell2010
@@ -113,7 +121,7 @@ test-suite sis-server-test
      OverloadedStrings
      RecordWildCards
      TupleSections
-  ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
+  ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wredundant-constraints
  build-depends:
      aeson
    , base >=4.7 && <5
@@ -134,5 +142,6 @@ test-suite sis-server-test
    , text
    , time
    , wai
    , wai-extra
    , warp
  default-language: Haskell2010
@@ -3,5 +3,7 @@ module Sis (
    module X,
 ) where
 import Sis.Auth as X
 import Sis.Database as X
 import Sis.Server as X
 import Sis.Types as X
@@ -0,0 +1,103 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {- | Authentication and session management.
 Provides password hashing with PBKDF2, session token generation,
 and httpOnly cookie handling.
 -}
 module Sis.Auth (
    -- * Password hashing
    hashPassword,
    verifyPassword,
    -- * Session tokens
    generateToken,
    sessionCookieName,
    makeSessionCookie,
    clearSessionCookie,
 ) where
 import Crypto.Hash.Algorithms qualified as Hash
 import Crypto.KDF.PBKDF2 qualified as PBKDF2
 import Crypto.Random.Entropy (getEntropy)
 import Data.ByteArray ()
 import Data.ByteString qualified as BS
 import Data.ByteString.Base64 qualified as B64
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as TE
 import Network.HTTP.Types qualified as HTTP
 -- | Name of the session cookie.
 sessionCookieName :: T.Text
 sessionCookieName = "sis_session"
 -- | Number of PBKDF2 iterations.
 pbkdf2Iterations :: Int
 pbkdf2Iterations = 600000
 -- | Salt length in bytes.
 saltLength :: Int
 saltLength = 16
 -- | Hash a password with PBKDF2-SHA256, returning a "{salt}:{hash}" string.
 hashPassword :: T.Text -> IO T.Text
 hashPassword password = do
    salt <- getEntropy saltLength
    let pwBytes = TE.encodeUtf8 password
        hashBytes :: BS.ByteString
        hashBytes =
            PBKDF2.generate
                (PBKDF2.prfHMAC Hash.SHA256)
                (PBKDF2.Parameters pbkdf2Iterations 32)
                pwBytes
                salt
        stored = B64.encode salt <> ":" <> B64.encode hashBytes
    pure $ TE.decodeUtf8 stored
 -- | Verify a password against a "{salt}:{hash}" stored value.
 verifyPassword :: T.Text -> T.Text -> Bool
 verifyPassword password stored =
    case T.breakOn ":" stored of
        (b64Salt, rest)
            | T.null b64Salt -> False
            | T.null rest -> False
            | otherwise ->
                let b64Hash = T.drop 1 rest
                 in case (B64.decode (TE.encodeUtf8 b64Salt), B64.decode (TE.encodeUtf8 b64Hash)) of
                        (Right salt, Right expectedHash) ->
                            let pwBytes = TE.encodeUtf8 password
                                computedHash :: BS.ByteString
                                computedHash =
                                    PBKDF2.generate
                                        (PBKDF2.prfHMAC Hash.SHA256)
                                        (PBKDF2.Parameters pbkdf2Iterations 32)
                                        pwBytes
                                        salt
                             in computedHash == expectedHash
                        _ -> False
 -- | Generate a cryptographically random token suitable for session or invite codes.
 generateToken :: IO T.Text
 generateToken = do
    bytes <- getEntropy 32
    pure $ TE.decodeUtf8 $ B64.encode bytes
 -- | Create a session cookie header value.
 makeSessionCookie :: T.Text -> Bool -> HTTP.Header
 makeSessionCookie token rememberMe =
    let maxAge = if rememberMe then (30 :: Int) * 86400 else 86400
        cookieText =
            TE.encodeUtf8 sessionCookieName
                <> "="
                <> TE.encodeUtf8 token
                <> "; Path=/; HttpOnly; SameSite=Lax; Max-Age="
                <> TE.encodeUtf8 (T.pack $ show maxAge)
     in ("Set-Cookie", cookieText)
 -- | Clear the session cookie.
 clearSessionCookie :: HTTP.Header
 clearSessionCookie =
    ( "Set-Cookie"
    , TE.encodeUtf8 sessionCookieName <> "=; Path=/; HttpOnly; SameSite=Lax; Max-Age=0"
    )
@@ -1,10 +1,13 @@
 {-# LANGUAGE OverloadedStrings #-}
 {- | SQLite database support for Sis.
 Opens (and creates if missing) a SQLite database with WAL journal
-mode and foreign keys enabled.
+mode and foreign keys enabled. Runs schema migrations on startup.
 -}
 module Sis.Database (
    openDatabase,
    runMigrations,
 ) where
 import Database.SQLite.Simple qualified as SQL
@@ -22,4 +25,72 @@ openDatabase path = do
    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')))"
        ]
@@ -1,81 +1,733 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeFamilies #-}
-{- | Orb-based HTTP server for Sis.
+{- | Simple WAI-based HTTP server for Sis.
-
+Bypasses Orb's complex routing for a straightforward manual approach.
 Defines the API routes and wires them into a WAI 'Wai.Application'.
 Serves the Mithril SPA frontend from a static directory for all
 non-API routes, with SPA-routing fallback to @index.html@.
 -}
-module Sis.Server (
+module Sis.Server (app) where
    app,
    sisRouter,
    HealthCheck (..),
 ) where
 import Beeline.Routing ((/-), (/:))
 import Beeline.Routing qualified as R
 import Control.Exception.Safe qualified as Safe
-import Control.Monad.IO.Class qualified as MIO
+import Control.Monad (unless, void, when)
-import Control.Monad.Reader qualified as Reader
+import Data.Aeson qualified as A
 import Data.ByteString qualified as BS
 import Data.ByteString.Lazy qualified as BL
 import Data.Map.Strict qualified as Map
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, listToMaybe)
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as TE
-import Data.Void (Void, absurd)
+import Data.Time qualified as Time
 import Database.SQLite.Simple (Only (..))
 import Database.SQLite.Simple qualified as SQL
 import Network.HTTP.Types qualified as HTTP
 import Network.Wai qualified as Wai
 import Shrubbery qualified as S
 import System.Directory (doesFileExist)
 import System.FilePath ((</>))
 import Text.Read (readMaybe)
-import Orb qualified
+import Sis.Auth qualified as Auth
 import Sis.Types
-- | The top-level WAI application, serving both the API and the SPA frontend.
+app :: FilePath -> SQL.Connection -> Wai.Application
-app :: FilePath -> Wai.Application
+app staticDir conn request respond = do
-app staticDir =
+    let path = TE.decodeUtf8 $ Wai.rawPathInfo request
-    Orb.orbAppToWai sisOrbApp{Orb.handleNotFound = serveStaticOrSpa staticDir}
+    if "/api/" `T.isPrefixOf` path
        then handleApi conn request respond
        else serveStaticOrSpa staticDir request respond
-- | Full Orb application wiring routes to a WAI dispatcher.
+-- | Handle all API routes by dispatching on path and method.
-sisOrbApp :: Orb.OrbApp (S.Union Routes)
+handleApi :: SQL.Connection -> Wai.Application
-sisOrbApp =
+handleApi conn request respond = do
-    Orb.OrbApp
+    let segs = filter (not . T.null) $ T.splitOn "/" $ TE.decodeUtf8 $ Wai.rawPathInfo request
-        { Orb.router = sisRouter
+        method = Wai.requestMethod request
-        , Orb.dispatcher = sisDispatcher
+        getBody = Wai.strictRequestBody request
-        , Orb.handleNotFound = Orb.defaultHandleNotFound -- overridden in 'app'
+    result <- Safe.try $ routeApi conn request respond segs method getBody
-        }
+    case result of
        Left (ApiResponse resp) -> respond resp
        Right _ -> respond $ Wai.responseLBS HTTP.status500 [] "Internal server error"
-- | The route recognizer for all sis routes.
+-- | Exception carrying a pre-built WAI response for early exit.
-sisRouter :: R.RouteRecognizer (S.Union Routes)
+newtype ApiResponse = ApiResponse Wai.Response
 sisRouter =
    R.routeList $
        Orb.get (R.make HealthCheck /- "api" /- "health")
            /: R.emptyRoutes
-- | Dispatch a recognized route to its handler via the 'SisDispatchM' monad.
+instance Show ApiResponse where show _ = "ApiResponse"
-sisDispatcher :: S.Union Routes -> Wai.Application
+instance Safe.Exception ApiResponse
 sisDispatcher route request respond = do
    let env = SisDispatchEnv request respond
    let SisDispatchM action = Orb.dispatch route
    Reader.runReaderT action env
-- | The union of all route types in the application.
+-- | Throw a response to exit early.
-type Routes =
+throwResp :: HTTP.Status -> BL.ByteString -> IO a
-    '[ HealthCheck
+throwResp status body =
-     ]
+    Safe.throwIO $
        ApiResponse $
            Wai.responseLBS status [("Content-Type", "application/json")] body
-- Static file + SPA fallback
+throwJSON :: (A.ToJSON a) => HTTP.Status -> a -> IO b
 throwJSON status v = throwResp status (A.encode v)
-- | MIME type lookup by file extension.
+throwError :: HTTP.Status -> T.Text -> IO a
-mimeType :: FilePath -> Maybe BS.ByteString
+throwError status msg = throwJSON status (ErrorResponse msg Nothing)
-mimeType path = Map.lookup (takeExtensionLower path) mimeTypes
+
 throwFieldError :: HTTP.Status -> T.Text -> T.Text -> IO a
 throwFieldError status msg field = throwJSON status (ErrorResponse msg (Just field))
 -- | Parse JSON body.
 parseBody :: (A.FromJSON a) => IO BL.ByteString -> IO a
 parseBody getBody = do
    body <- getBody
    case A.decode body of
        Just v -> pure v
        Nothing -> throwError HTTP.status400 "Invalid JSON body"
 -- | Get current user from session cookie.
 getSessionUser :: SQL.Connection -> Wai.Request -> IO (Maybe User)
 getSessionUser conn req = do
    let cookies = parseCookies (Wai.requestHeaders req)
    case Map.lookup Auth.sessionCookieName cookies of
        Nothing -> pure Nothing
        Just token -> do
            now <- Time.getCurrentTime
            result <-
                SQL.query
                    conn
                    "SELECT u.id, u.display_name, u.email, u.password_hash \
                    \ FROM users u JOIN sessions s ON s.user_id = u.id \
                    \ WHERE s.token = ? AND s.expires_at > ?"
                    (token, now) ::
                    IO [(Int, T.Text, T.Text, T.Text)]
            pure $ listToMaybe [User (UserId uid) name email pwHash | (uid, name, email, pwHash) <- result]
 -- | Require authentication.
 requireAuth :: SQL.Connection -> Wai.Request -> IO User
 requireAuth conn req = do
    mUser <- getSessionUser conn req
    case mUser of
        Just u -> pure u
        Nothing -> throwError HTTP.status401 "Authentication required"
 -- | Check household membership.
 requireHouseholdRole :: SQL.Connection -> UserId -> Int -> IO T.Text
 requireHouseholdRole conn userId hid = do
    result <-
        SQL.query
            conn
            "SELECT role FROM memberships WHERE household_id = ? AND user_id = ?"
            (hid, unUserId userId) ::
            IO [Only String]
    case listToMaybe [T.pack role | Only role <- result] of
        Just r -> pure r
        Nothing -> throwError HTTP.status403 "Not a member of this household"
 -- | Simple cookie parser.
 parseCookies :: [HTTP.Header] -> Map.Map T.Text T.Text
 parseCookies headers =
    case lookup "cookie" headers of
        Just raw ->
            let pairs = T.splitOn "; " (TE.decodeUtf8 raw)
             in Map.fromList [(T.strip k, T.strip v) | kv <- pairs, let (k, v') = T.breakOn "=" kv, not (T.null k), let v = T.drop 1 v']
        Nothing -> Map.empty
 -- | Set session cookie header.
 mkSessionCookie :: T.Text -> Bool -> HTTP.Header
 mkSessionCookie token rememberMe =
    let maxAge = if rememberMe then (30 :: Int) * 86400 else 86400
     in ("Set-Cookie", TE.encodeUtf8 Auth.sessionCookieName <> "=" <> TE.encodeUtf8 token <> "; Path=/; HttpOnly; SameSite=Lax; Max-Age=" <> TE.encodeUtf8 (T.pack $ show maxAge))
 clearSessionCookie :: HTTP.Header
 clearSessionCookie = ("Set-Cookie", TE.encodeUtf8 Auth.sessionCookieName <> "=; Path=/; HttpOnly; SameSite=Lax; Max-Age=0")
 -- | Get user's households.
 getUserHouseholds :: SQL.Connection -> UserId -> IO [Household]
 getUserHouseholds conn userId = 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 (unUserId userId)) ::
            IO [(Int, T.Text, Int, Int)]
    pure [Household (HouseholdId hId) hName (UserId ownerId) count | (hId, hName, ownerId, count) <- rows]
 -- | Occurrence generation helpers.
 generateOccurrences :: SQL.Connection -> Chore -> IO ()
 generateOccurrences conn chore = do
    today <- Time.utctDay <$> Time.getCurrentTime
    let windowEnd = Time.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 -> Time.Day -> Time.Day -> Time.Day -> [Time.Day]
 generateRecurringDates period startDate fromDate toDate = go (max startDate fromDate)
  where
-    takeExtensionLower p =
+    go d | d > toDate = [] | otherwise = d : go (next period d)
-        let ext = reverse $ takeWhile (/= '.') $ reverse p
+    next PeriodDaily = Time.addDays 1; next PeriodWeekly = Time.addDays 7; next PeriodMonthly = Time.addGregorianMonthsClip 1
-         in T.toLower $ T.pack ext
+
 ----------------------------------------------------------------------
 -- Main router
 ----------------------------------------------------------------------
 newtype EmailOnly = EmailOnly T.Text
 instance A.FromJSON EmailOnly where
    parseJSON = A.withObject "EmailOnly" $ \o -> EmailOnly <$> o A..: "email"
 data ResetPasswordRequest = ResetPasswordRequest {rprToken :: T.Text, rprPassword :: T.Text}
 instance A.FromJSON ResetPasswordRequest where
    parseJSON = A.withObject "ResetPasswordRequest" $ \o ->
        ResetPasswordRequest <$> o A..: "token" <*> o A..: "password"
 routeApi :: SQL.Connection -> Wai.Request -> (Wai.Response -> IO Wai.ResponseReceived) -> [T.Text] -> HTTP.Method -> IO BL.ByteString -> IO ()
 routeApi conn req respond segs method getBody = case segs of
    -- Health
    ("api" : "health" : _) ->
        throwJSON HTTP.status200 (A.object ["status" A..= A.String "ok"])
    -- Auth
    ("api" : "auth" : "signup" : _) -> handleSignup conn getBody respond
    ("api" : "auth" : "login" : _) -> handleLogin conn getBody respond
    ("api" : "auth" : "logout" : _) -> handleLogout conn req respond
    ("api" : "auth" : "me" : _) -> handleMe conn req
    ("api" : "auth" : "forgot-password" : _) -> handleForgotPassword conn getBody
    ("api" : "auth" : "reset-password" : _) -> handleResetPassword conn getBody
    -- Households
    ["api", "households"]
        | method == HTTP.methodGet -> handleListHouseholds conn req
        | method == HTTP.methodPost -> handleCreateHousehold conn req getBody
        | otherwise -> throwError HTTP.status405 "Method not allowed"
    ("api" : "households" : hidStr : rest) ->
        case readMaybe (T.unpack hidStr) of
            Just hid -> routeHousehold conn req respond hid rest method getBody
            Nothing -> throwError HTTP.status400 "Invalid household ID"
    -- Invites (top-level)
    ["api", "invites", code] -> handleLookupInvite conn code
    ("api" : "invites" : code : "accept" : _) -> handleAcceptInvite conn req code
    -- Occurrences
    ("api" : "occurrences" : oidStr : "activity" : _) ->
        case readMaybe (T.unpack oidStr) of
            Just oid -> handleRecordActivity conn req oid getBody
            Nothing -> throwError HTTP.status400 "Invalid occurrence ID"
    -- Seed
    ("api" : "seed" : _) -> handleSeed conn
    _ -> throwError HTTP.status404 "API route not found"
 routeHousehold :: SQL.Connection -> Wai.Request -> (Wai.Response -> IO Wai.ResponseReceived) -> Int -> [T.Text] -> HTTP.Method -> IO BL.ByteString -> IO ()
 routeHousehold conn req _respond hid rest method getBody = case rest of
    [] -> case method of
        _ | method == HTTP.methodGet -> handleGetHousehold conn req hid
        _ | method == HTTP.methodPut -> handleUpdateHousehold conn req hid getBody
        _ | method == HTTP.methodDelete -> handleDeleteHousehold conn req hid
        _ -> throwError HTTP.status405 "Method not allowed"
    ["members"] -> handleListMembers conn req hid
    ["members", uidStr] ->
        case readMaybe (T.unpack uidStr) of
            Just uid -> handleRemoveMember conn req hid uid
            Nothing -> throwError HTTP.status400 "Invalid user ID"
    ["invites"] -> handleListInvites conn req hid
    ["invites", iidStr] ->
        case readMaybe (T.unpack iidStr) of
            Just iid
                | method == HTTP.methodDelete -> handleRevokeInvite conn req hid iid
                | otherwise -> handleCreateInvite conn req hid getBody
            Nothing -> throwError HTTP.status400 "Invalid invite ID"
    ["chores"] -> handleListChores conn req hid
    ["chores", cidStr] ->
        case readMaybe (T.unpack cidStr) of
            Just cid
                | method == HTTP.methodPut -> handleUpdateChore conn req hid cid getBody
                | method == HTTP.methodDelete -> handleDeleteChore conn req hid cid
                | otherwise -> handleCreateChore conn req hid getBody
            Nothing -> throwError HTTP.status400 "Invalid chore ID"
    ["dashboard"] -> handleDashboard conn req hid
    ["activity"] -> handleActivityLog conn req hid
    _ -> throwError HTTP.status404 "API route not found"
 ----------------------------------------------------------------------
 -- Auth handlers
 ----------------------------------------------------------------------
 handleSignup :: SQL.Connection -> IO BL.ByteString -> (Wai.Response -> IO Wai.ResponseReceived) -> IO ()
 handleSignup conn getBody respond = do
    req <- parseBody getBody
    when (T.length (srPassword req) < 8) $ throwFieldError HTTP.status400 "Password must be at least 8 characters" "password"
    when (srPassword req /= srConfirmPassword req) $ throwFieldError HTTP.status400 "Passwords do not match" "confirmPassword"
    unless (srAgreeTerms req) $ throwFieldError HTTP.status400 "You must agree to the terms" "agreeTerms"
    existing <- SQL.query conn "SELECT id FROM users WHERE email = ?" (Only (srEmail req)) :: IO [Only Int]
    unless (null existing) $ throwError HTTP.status409 "Email already registered"
    pwHash <- Auth.hashPassword (srPassword req)
    SQL.execute conn "INSERT INTO users (display_name, email, password_hash) VALUES (?, ?, ?)" (srDisplayName req, srEmail req, pwHash)
    uid <- SQL.lastInsertRowId conn
    let userId = UserId (fromIntegral uid)
    token <- Auth.generateToken
    expires <- Time.addUTCTime 86400 <$> Time.getCurrentTime
    SQL.execute conn "INSERT INTO sessions (token, user_id, expires_at) VALUES (?, ?, ?)" (token, unUserId userId, expires)
    let user = UserPublic userId (srDisplayName req) (srEmail req)
    void $
        respond $
            Wai.responseLBS
                HTTP.status201
                [("Content-Type", "application/json"), mkSessionCookie token False]
                (A.encode $ AuthResponse user [])
 handleLogin :: SQL.Connection -> IO BL.ByteString -> (Wai.Response -> IO Wai.ResponseReceived) -> IO ()
 handleLogin conn getBody respond = do
    req <- parseBody getBody
    result <- SQL.query conn "SELECT id, display_name, email, password_hash FROM users WHERE email = ?" (Only (lrEmail req)) :: IO [(Int, T.Text, T.Text, T.Text)]
    case result of
        [(uid, name, email, pwHash)] ->
            if Auth.verifyPassword (lrPassword req) pwHash
                then do
                    let userId = UserId uid
                    token <- Auth.generateToken
                    let maxAge = if lrRememberMe req then 30 * 86400 else 86400
                    expires <- Time.addUTCTime (fromIntegral (maxAge :: Int)) <$> Time.getCurrentTime
                    SQL.execute conn "INSERT INTO sessions (token, user_id, expires_at) VALUES (?, ?, ?)" (token, unUserId userId, expires)
                    households <- getUserHouseholds conn userId
                    let user = UserPublic userId name email
                    void $
                        respond $
                            Wai.responseLBS
                                HTTP.status200
                                [("Content-Type", "application/json"), mkSessionCookie token (lrRememberMe req)]
                                (A.encode $ AuthResponse user households)
                else throwError HTTP.status401 "Invalid email or password"
        _ -> throwError HTTP.status401 "Invalid email or password"
 handleLogout :: SQL.Connection -> Wai.Request -> (Wai.Response -> IO Wai.ResponseReceived) -> IO ()
 handleLogout conn req respond = do
    let cookies = parseCookies (Wai.requestHeaders req)
    case Map.lookup Auth.sessionCookieName cookies of
        Just token -> SQL.execute conn "DELETE FROM sessions WHERE token = ?" (Only token)
        Nothing -> pure ()
    void $
        respond $
            Wai.responseLBS
                HTTP.status200
                [("Content-Type", "application/json"), clearSessionCookie]
                (A.encode $ A.object ["status" A..= A.String "logged_out"])
 handleMe :: SQL.Connection -> Wai.Request -> IO ()
 handleMe conn req = do
    mUser <- getSessionUser conn req
    case mUser of
        Nothing -> throwError HTTP.status401 "Not authenticated"
        Just (User uid name email _) -> do
            households <- getUserHouseholds conn uid
            let user = UserPublic uid name email
            throwJSON HTTP.status200 $ AuthResponse user households
 handleForgotPassword :: SQL.Connection -> IO BL.ByteString -> IO ()
 handleForgotPassword conn getBody = do
    req <- parseBody getBody
    let EmailOnly email = req
    result <- SQL.query conn "SELECT id FROM users WHERE email = ?" (Only email) :: IO [Only Int]
    case result of
        [Only uid] -> do
            token <- Auth.generateToken
            expires <- Time.addUTCTime 3600 <$> Time.getCurrentTime
            SQL.execute conn "INSERT INTO reset_tokens (user_id, token, expires_at) VALUES (?, ?, ?)" (uid, token, expires)
        _ -> pure ()
    throwJSON HTTP.status200 (A.object ["status" A..= A.String "reset_sent"])
 handleResetPassword :: SQL.Connection -> IO BL.ByteString -> IO ()
 handleResetPassword conn getBody = do
    req <- parseBody getBody
    when (T.length (rprPassword req) < 8) $ throwError HTTP.status400 "Password must be at least 8 characters"
    now <- Time.getCurrentTime
    result <- SQL.query conn "SELECT user_id FROM reset_tokens WHERE token = ? AND used = 0 AND expires_at > ?" (rprToken req, now) :: IO [Only Int]
    case result of
        [Only uid] -> do
            pwHash <- Auth.hashPassword (rprPassword req)
            SQL.execute conn "UPDATE users SET password_hash = ? WHERE id = ?" (pwHash, uid)
            SQL.execute conn "UPDATE reset_tokens SET used = 1 WHERE token = ?" (Only (rprToken req))
            throwJSON HTTP.status200 (A.object ["status" A..= A.String "password_reset"])
        _ -> throwError HTTP.status400 "Invalid or expired reset token"
 ----------------------------------------------------------------------
 -- Household handlers
 ----------------------------------------------------------------------
 handleCreateHousehold :: SQL.Connection -> Wai.Request -> IO BL.ByteString -> IO ()
 handleCreateHousehold conn req getBody = do
    user <- requireAuth conn req
    chr <- parseBody getBody
    SQL.execute conn "INSERT INTO households (name) VALUES (?)" (Only (chrName chr))
    hId <- SQL.lastInsertRowId conn
    let hid = HouseholdId (fromIntegral hId)
    SQL.execute conn "INSERT INTO memberships (household_id, user_id, role) VALUES (?, ?, ?)" (unHouseholdId hid, unUserId (userId user), "owner" :: String)
    throwJSON HTTP.status201 $ Household hid (chrName chr) (userId user) 1
 handleListHouseholds :: SQL.Connection -> Wai.Request -> IO ()
 handleListHouseholds conn req = do
    user <- requireAuth conn req
    hs <- getUserHouseholds conn (userId user)
    throwJSON HTTP.status200 hs
 handleGetHousehold :: SQL.Connection -> Wai.Request -> Int -> IO ()
 handleGetHousehold conn req hid = do
    user <- requireAuth conn req
    _ <- requireHouseholdRole conn (userId user) hid
    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 = ?"
            (unUserId (userId user), hid) ::
            IO [(Int, T.Text, Int, Int)]
    case result of
        [(hId, hName, ownerId, count)] -> throwJSON HTTP.status200 $ Household (HouseholdId hId) hName (UserId ownerId) count
        _ -> throwError HTTP.status404 "Household not found"
 handleUpdateHousehold :: SQL.Connection -> Wai.Request -> Int -> IO BL.ByteString -> IO ()
 handleUpdateHousehold conn req hid getBody = do
    user <- requireAuth conn req
    role <- requireHouseholdRole conn (userId user) hid
    unless (role == "owner") $ throwError HTTP.status403 "Only the owner can rename the household"
    chr <- parseBody getBody
    SQL.execute conn "UPDATE households SET name = ? WHERE id = ?" (chrName chr, hid)
    result <-
        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, T.Text, Int, Int)]
    case result of
        [(hId, hName, ownerId, count)] -> throwJSON HTTP.status200 $ Household (HouseholdId hId) hName (UserId ownerId) count
        _ -> throwError HTTP.status404 "Household not found"
 handleDeleteHousehold :: SQL.Connection -> Wai.Request -> Int -> IO ()
 handleDeleteHousehold conn req hid = do
    user <- requireAuth conn req
    role <- requireHouseholdRole conn (userId user) hid
    unless (role == "owner") $ throwError HTTP.status403 "Only the owner can delete the household"
    SQL.execute conn "DELETE FROM households WHERE id = ?" (Only hid)
    throwJSON HTTP.status200 (A.object ["status" A..= A.String "deleted"])
 handleListMembers :: SQL.Connection -> Wai.Request -> Int -> IO ()
 handleListMembers conn req hid = do
    user <- requireAuth conn req
    _ <- requireHouseholdRole conn (userId user) hid
    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) ::
            IO [(Int, T.Text, T.Text, String)]
    throwJSON HTTP.status200 [Membership (UserId uid) dname email (if role == "owner" then OwnerRole else MemberRole) | (uid, dname, email, role) <- members]
 handleRemoveMember :: SQL.Connection -> Wai.Request -> Int -> Int -> IO ()
 handleRemoveMember conn req hid targetUid = do
    user <- requireAuth conn req
    role <- requireHouseholdRole conn (userId user) hid
    unless (role == "owner") $ throwError HTTP.status403 "Only the owner can remove members"
    SQL.execute conn "DELETE FROM memberships WHERE household_id = ? AND user_id = ?" (hid, targetUid)
    throwJSON HTTP.status200 (A.object ["status" A..= A.String "removed"])
 ----------------------------------------------------------------------
 -- Invite handlers
 ----------------------------------------------------------------------
 handleCreateInvite :: SQL.Connection -> Wai.Request -> Int -> IO BL.ByteString -> IO ()
 handleCreateInvite conn req hid getBody = do
    user <- requireAuth conn req
    role <- requireHouseholdRole conn (userId user) hid
    unless (role == "owner") $ throwError HTTP.status403 "Only the owner can invite members"
    cir <- parseBody getBody
    case cirEmail cir of
        Just em -> do
            existing <-
                SQL.query
                    conn
                    "SELECT 1 FROM users u JOIN memberships m ON m.user_id = u.id WHERE u.email = ? AND m.household_id = ?"
                    (em, hid) ::
                    IO [Only Int]
            unless (null existing) $ throwError HTTP.status409 "User is already a member"
        Nothing -> pure ()
    code <- Auth.generateToken
    now <- Time.getCurrentTime
    SQL.execute conn "INSERT INTO invites (household_id, code, email, created_at) VALUES (?, ?, ?, ?)" (hid, code, cirEmail cir, now)
    iid <- SQL.lastInsertRowId conn
    throwJSON HTTP.status201 $ Invite (InviteId (fromIntegral iid)) (HouseholdId hid) code (cirEmail cir) InvitePending now
 handleListInvites :: SQL.Connection -> Wai.Request -> Int -> IO ()
 handleListInvites conn req hid = do
    user <- requireAuth conn req
    _ <- requireHouseholdRole conn (userId user) hid
    invites <-
        SQL.query
            conn
            "SELECT id, household_id, code, email, status, created_at FROM invites WHERE household_id = ?"
            (Only hid) ::
            IO [(Int, Int, T.Text, Maybe T.Text, T.Text, Time.UTCTime)]
    throwJSON HTTP.status200 [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
 handleRevokeInvite :: SQL.Connection -> Wai.Request -> Int -> Int -> IO ()
 handleRevokeInvite conn req hid iid = do
    user <- requireAuth conn req
    role <- requireHouseholdRole conn (userId user) hid
    unless (role == "owner") $ throwError HTTP.status403 "Only the owner can revoke invites"
    SQL.execute conn "UPDATE invites SET status = 'revoked' WHERE id = ? AND household_id = ?" (iid, hid)
    throwJSON HTTP.status200 (A.object ["status" A..= A.String "revoked"])
 handleLookupInvite :: SQL.Connection -> T.Text -> IO ()
 handleLookupInvite conn code = do
    result <-
        SQL.query
            conn
            "SELECT id, household_id, code, email, status, created_at FROM invites WHERE code = ? AND status = 'pending'"
            (Only code) ::
            IO [(Int, Int, T.Text, Maybe T.Text, T.Text, Time.UTCTime)]
    case result of
        [(iid, hhid, c, email, _, createdAt)] -> throwJSON HTTP.status200 $ Invite (InviteId iid) (HouseholdId hhid) c email InvitePending createdAt
        _ -> throwError HTTP.status404 "Invite not found or already used"
 handleAcceptInvite :: SQL.Connection -> Wai.Request -> T.Text -> IO ()
 handleAcceptInvite conn req code = do
    user <- requireAuth conn req
    result <- SQL.query conn "SELECT id, household_id FROM invites WHERE code = ? AND status = 'pending'" (Only code) :: IO [(Int, Int)]
    case result of
        [(iid, hid)] -> do
            existing <- SQL.query conn "SELECT 1 FROM memberships WHERE household_id = ? AND user_id = ?" (hid, unUserId (userId user)) :: IO [Only Int]
            unless (null existing) $ throwError HTTP.status409 "Already a member"
            SQL.execute conn "INSERT INTO memberships (household_id, user_id, role) VALUES (?, ?, ?)" (hid, unUserId (userId user), "member" :: String)
            SQL.execute conn "UPDATE invites SET status = 'accepted' WHERE id = ?" (Only iid)
            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, T.Text, Int, Int)]
            case hResult of
                [(hId, hName, ownerId, count)] -> throwJSON HTTP.status200 $ Household (HouseholdId hId) hName (UserId ownerId) count
                _ -> throwError HTTP.status404 "Household not found"
        _ -> throwError HTTP.status404 "Invite not found"
 ----------------------------------------------------------------------
 -- Chore handlers
 ----------------------------------------------------------------------
 handleListChores :: SQL.Connection -> Wai.Request -> Int -> IO ()
 handleListChores conn req hid = do
    user <- requireAuth conn req
    _ <- requireHouseholdRole conn (userId user) hid
    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, T.Text, String, Maybe Int, T.Text, Int, Time.UTCTime)]
    throwJSON
        HTTP.status200
        [ Chore (ChoreId cid) (HouseholdId hId) cname (mkAssignee atype auid) (mkSchedule sData) (nud /= 0) createdAt
        | (cid, hId, cname, atype, auid, sData, nud, createdAt) <- chores
        ]
  where
    mkAssignee "user" (Just uid) = AssigneeUser (UserId uid); mkAssignee _ _ = AssigneeAnyone
    mkSchedule sData = fromMaybe ScheduleSometime (A.decodeStrict (TE.encodeUtf8 sData))
 handleCreateChore :: SQL.Connection -> Wai.Request -> Int -> IO BL.ByteString -> IO ()
 handleCreateChore conn req hid getBody = do
    user <- requireAuth conn req
    _ <- requireHouseholdRole conn (userId user) hid
    ccr <- parseBody getBody
    now <- Time.getCurrentTime
    let (aType, aUid) = case ccrAssignee ccr of AssigneeUser (UserId uid) -> ("user" :: String, Just uid); AssigneeAnyone -> ("anyone", Nothing)
        sType = case ccrSchedule ccr of ScheduleOneOff{} -> "one_off" :: String; ScheduleRecurring{} -> "recurring"; ScheduleSometime -> "sometime"
        sData = TE.decodeUtf8 $ BL.toStrict $ A.encode (ccrSchedule ccr)
    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, ccrName ccr, aType, aUid, sType, sData, if ccrNotifyOnDue ccr then 1 :: Int else 0, now)
    cId <- SQL.lastInsertRowId conn
    let chore = Chore (ChoreId (fromIntegral cId)) (HouseholdId hid) (ccrName ccr) (ccrAssignee ccr) (ccrSchedule ccr) (ccrNotifyOnDue ccr) now
    generateOccurrences conn chore
    throwJSON HTTP.status201 chore
 handleUpdateChore :: SQL.Connection -> Wai.Request -> Int -> Int -> IO BL.ByteString -> IO ()
 handleUpdateChore conn req hid cid getBody = do
    user <- requireAuth conn req
    _ <- requireHouseholdRole conn (userId user) hid
    ucr <- parseBody getBody
    now <- Time.getCurrentTime
    let (aType, aUid) = case ucrAssignee ucr of AssigneeUser (UserId uid) -> ("user" :: String, Just uid); AssigneeAnyone -> ("anyone", Nothing)
        sType = case ucrSchedule ucr of ScheduleOneOff{} -> "one_off" :: String; ScheduleRecurring{} -> "recurring"; ScheduleSometime -> "sometime"
        sData = TE.decodeUtf8 $ BL.toStrict $ A.encode (ucrSchedule ucr)
    SQL.execute
        conn
        "UPDATE chores SET name=?, assignee_type=?, assignee_user_id=?, schedule_type=?, schedule_data=?, notify_on_due=? WHERE id=? AND household_id=?"
        (ucrName ucr, aType, aUid, sType, sData, if ucrNotifyOnDue ucr 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) (ucrName ucr) (ucrAssignee ucr) (ucrSchedule ucr) (ucrNotifyOnDue ucr) now
    generateOccurrences conn chore
    throwJSON HTTP.status200 chore
 handleDeleteChore :: SQL.Connection -> Wai.Request -> Int -> Int -> IO ()
 handleDeleteChore conn req hid cid = do
    user <- requireAuth conn req
    _ <- requireHouseholdRole conn (userId user) hid
    SQL.execute conn "DELETE FROM chores WHERE id = ? AND household_id = ?" (cid, hid)
    throwJSON HTTP.status200 (A.object ["status" A..= A.String "deleted"])
 ----------------------------------------------------------------------
 -- Dashboard
 ----------------------------------------------------------------------
 handleDashboard :: SQL.Connection -> Wai.Request -> Int -> IO ()
 handleDashboard conn req hid = do
    user <- requireAuth conn req
    _ <- requireHouseholdRole conn (userId user) hid
    today <- Time.utctDay <$> Time.getCurrentTime
    let todayStr = show 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) ::
            IO [Only Int]
    [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) ::
            IO [Only Int]
    [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, show (Time.addDays (-7) today)) ::
            IO [Only Int]
    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, Time.Day, T.Text, T.Text, Maybe T.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, T.Text, Maybe T.Text, Int, Time.UTCTime, T.Text, T.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
            ]
    throwJSON HTTP.status200 $ Dashboard stats dueItems compItems
  where
    mkOcc "due" = OccDue; mkOcc "overdue" = OccOverdue; mkOcc "completed" = OccCompleted; mkOcc _ = OccSkipped
    mkAct "completed" = ActivityCompleted; mkAct _ = ActivitySkipped
 ----------------------------------------------------------------------
 -- Activity
 ----------------------------------------------------------------------
 handleRecordActivity :: SQL.Connection -> Wai.Request -> Int -> IO BL.ByteString -> IO ()
 handleRecordActivity conn req oid getBody = do
    user <- requireAuth conn req
    rar <- parseBody getBody
    now <- Time.getCurrentTime
    occResult <-
        SQL.query
            conn
            "SELECT o.chore_id, c.household_id FROM occurrences o JOIN chores c ON c.id = o.chore_id WHERE o.id = ?"
            (Only oid) ::
            IO [(Int, Int)]
    case occResult of
        [(_, hid)] -> do
            _ <- requireHouseholdRole conn (userId user) hid
            let actStatus = case rarStatus rar of ActivityCompleted -> "completed" :: String; ActivitySkipped -> "skipped"
            SQL.execute
                conn
                "INSERT INTO activities (occurrence_id, user_id, status, note, notify_household, recorded_at) VALUES (?,?,?,?,?,?)"
                (oid, unUserId (userId user), actStatus, rarNote rar, if rarNotifyHousehold rar then 1 :: Int else 0, now)
            let occStatus = case rarStatus rar of ActivityCompleted -> "completed" :: String; ActivitySkipped -> "skipped"
            SQL.execute conn "UPDATE occurrences SET status = ? WHERE id = ?" (occStatus, oid)
            actId <- SQL.lastInsertRowId conn
            throwJSON HTTP.status201 $ Activity (ActivityId (fromIntegral actId)) (OccurrenceId oid) (userId user) (rarStatus rar) (rarNote rar) (rarNotifyHousehold rar) now
        _ -> throwError HTTP.status404 "Occurrence not found"
 handleActivityLog :: SQL.Connection -> Wai.Request -> Int -> IO ()
 handleActivityLog conn req hid = do
    user <- requireAuth conn req
    _ <- requireHouseholdRole conn (userId user) hid
    let qs = Wai.queryString req
    {- HLINT ignore "Use join" -}
    let page = maybe 1 (read . T.unpack . TE.decodeUtf8) (lookup "page" qs >>= id)
    let perPage = maybe 20 (read . T.unpack . TE.decodeUtf8) (lookup "perPage" qs >>= id)
    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) ::
            IO [Only Int]
    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, T.Text, Maybe T.Text, Int, Time.UTCTime, T.Text, T.Text, Time.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
            ]
    throwJSON HTTP.status200 $ ActivityLogPage logEntries page perPage totalCount
  where
    mkAct "completed" = ActivityCompleted; mkAct _ = ActivitySkipped
 ----------------------------------------------------------------------
 -- Seed
 ----------------------------------------------------------------------
 handleSeed :: SQL.Connection -> IO ()
 handleSeed conn = do
    let demoPassword = "password123"
    pwHash <- Auth.hashPassword 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 = TE.decodeUtf8 $ BL.toStrict $ A.encode (ScheduleRecurring PeriodDaily (read "2026-07-15") (Just "08:00:00") Nothing Nothing)
    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 = TE.decodeUtf8 $ BL.toStrict $ A.encode (ScheduleRecurring PeriodWeekly (read "2026-07-13") (Just "10:00:00") (Just [1, 4]) Nothing)
    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 = TE.decodeUtf8 $ BL.toStrict $ A.encode ScheduleSometime
    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 <- Time.utctDay <$> Time.getCurrentTime
    let windowEnd = Time.addDays 90 today
    let dates1 = generateRecurringDates PeriodDaily (read "2026-07-15") today windowEnd
    mapM_ (SQL.execute conn "INSERT OR IGNORE INTO occurrences (chore_id, due_date) VALUES (1, ?)" . Only) (take 90 dates1)
    let dates2 = generateRecurringDates PeriodWeekly (read "2026-07-13") today windowEnd
    mapM_ (SQL.execute conn "INSERT OR IGNORE INTO occurrences (chore_id, due_date) VALUES (2, ?)" . Only) (take 90 dates2)
    SQL.execute_ conn "INSERT OR IGNORE INTO occurrences (chore_id, due_date) VALUES (3, '9999-12-31')"
    throwJSON HTTP.status200 (A.object ["status" A..= A.String "seeded"])
 ----------------------------------------------------------------------
 -- Static file serving
 ----------------------------------------------------------------------
 mimeType :: FilePath -> Maybe BS.ByteString
 mimeType fp = Map.lookup ext mimeTypes
  where
    ext = T.toLower $ T.pack $ reverse $ takeWhile (/= '.') $ reverse fp
 mimeTypes :: Map.Map T.Text BS.ByteString
 mimeTypes =
@@ -85,130 +737,34 @@ mimeTypes =
        , ("js", "application/javascript")
        , ("json", "application/json")
        , ("png", "image/png")
        , ("jpg", "image/jpeg")
        , ("svg", "image/svg+xml")
        , ("ico", "image/x-icon")
-        , ("woff2", "font/woff2")
+        , ("manifest", "application/manifest+json")
        ]
 {- | Serve a static file from @staticDir@.
 For paths without a file extension (SPA client-side routes), serves
@index.html@ instead so the SPA can handle routing.
 Returns 'True' if a file was served, 'False' if nothing matched.
 -}
 serveStaticOrSpa :: FilePath -> Wai.Application
 serveStaticOrSpa staticDir request respond = do
-    let path = T.unpack $ TE.decodeUtf8 $ Wai.rawPathInfo request
+    let path = TE.decodeUtf8 $ Wai.rawPathInfo request
-    -- Drop leading slash for filesystem lookup.
+    let fp = staticDir </> dropWhile (== '/') (T.unpack path)
-    let relPath = case path of
+    exists <- doesFileExist fp
-            '/' : rest -> rest
+    let hasExt = '.' `elem` reverse (takeWhile (/= '/') (reverse (T.unpack path)))
            other -> other
    let candidate =
            if null relPath || not (hasExtension relPath)
                then "index.html"
                else relPath
    let filePath = staticDir </> candidate
    exists <- doesFileExist filePath
    if exists
        then do
-            let mime = fromMaybe "application/octet-stream" (mimeType candidate)
+            content <- BS.readFile fp
-            respond $ Wai.responseFile HTTP.status200 [("Content-Type", mime)] filePath Nothing
+            let ct = fromMaybe "application/octet-stream" $ mimeType fp
            respond $ Wai.responseLBS HTTP.status200 [("Content-Type", ct)] (BL.fromStrict content)
        else
-            respond notFoundResponse
+            if not hasExt
-
+                then do
-hasExtension :: FilePath -> Bool
+                    let indexPath = staticDir </> "index.html"
-hasExtension = elem '.' . takeFileName
+                    idxExists <- doesFileExist indexPath
-
+                    if idxExists
-takeFileName :: FilePath -> FilePath
+                        then do
-takeFileName = reverse . takeWhile (/= '/') . reverse
+                            content <- BS.readFile indexPath
                            respond $ Wai.responseLBS HTTP.status200 [("Content-Type", "text/html")] (BL.fromStrict content)
                        else respond notFoundResponse
                else respond notFoundResponse
 notFoundResponse :: Wai.Response
-notFoundResponse =
+notFoundResponse = Wai.responseLBS HTTP.status404 [("Content-Type", "text/plain")] "Not Found"
    Wai.responseLBS HTTP.status404 [("Content-Type", "text/plain")] "Not Found"
 -- Internal WAI dispatch monad
 data SisDispatchEnv = SisDispatchEnv
    { sisRequest :: Wai.Request
    , sisRespond :: Wai.Response -> IO Wai.ResponseReceived
    }
 newtype SisDispatchM a
    = SisDispatchM (Reader.ReaderT SisDispatchEnv IO a)
    deriving
        ( Functor
        , Applicative
        , Monad
        , MIO.MonadIO
        , Safe.MonadThrow
        , Safe.MonadCatch
        )
 instance Orb.HasRequest SisDispatchM where
    request = SisDispatchM (Reader.asks sisRequest)
 instance Orb.HasRespond SisDispatchM where
    respond = SisDispatchM (Reader.asks sisRespond)
 instance Orb.HasLogger SisDispatchM where
    log = MIO.liftIO . putStrLn . Safe.displayException
 -- Health check route
 {- | GET \/api\/health
 Returns a simple health-check response.
 -}
 data HealthCheck = HealthCheck
 instance Orb.HasHandler HealthCheck where
    type HandlerResponses HealthCheck = HealthCheckResponses
    type HandlerPermissionAction HealthCheck = NoPermissions
    type HandlerMonad HealthCheck = SisDispatchM
    routeHandler = healthCheckHandler
 type HealthCheckResponses =
    '[ Orb.Response200 Orb.SuccessMessage
     , Orb.Response500 Orb.InternalServerError
     ]
 healthCheckHandler :: Orb.Handler HealthCheck
 healthCheckHandler =
    Orb.Handler
        { Orb.handlerId = "healthCheck"
        , Orb.requestBody = Orb.EmptyRequestBody
        , Orb.requestQuery = Orb.EmptyRequestQuery
        , Orb.requestHeaders = Orb.EmptyRequestHeaders
        , Orb.handlerResponseBodies =
            Orb.responseBodies
                . Orb.addResponseSchema200 Orb.successMessageSchema
                . Orb.addResponseSchema500 Orb.internalServerErrorSchema
                $ Orb.noResponseBodies
        , Orb.mkPermissionAction =
            const NoPermissions
        , Orb.handleRequest =
            \_request () -> Orb.return200 (Orb.SuccessMessage "ok")
        }
 -- NoPermissions — all routes are public for now.
 data NoPermissions = NoPermissions
 instance Orb.PermissionAction NoPermissions where
    type PermissionActionMonad NoPermissions = SisDispatchM
    type PermissionActionError NoPermissions = NoError
    type PermissionActionResult NoPermissions = ()
    checkPermissionAction _ =
        pure (Right ())
 newtype NoError = NoError Void
 instance Orb.PermissionError NoError where
    type PermissionErrorConstraints NoError _tags = ()
    type PermissionErrorMonad NoError = SisDispatchM
    returnPermissionError (NoError v) =
        absurd v
@@ -1,127 +1,627 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {- | Core domain types for Sis.
-Sis tracks tasks (chores, responsibilities) that are shared among
+Covers users, households, memberships, invites, chores with
-members of a household or group. Any user can complete a task, and
+schedules, occurrences, and activity records.
 completion is visible to all.
 -}
 module Sis.Types (
-    -- * Task
+    -- * IDs
-    Task (..),
+    UserId (..),
-    TaskId,
+    HouseholdId (..),
-    TaskName,
+    ChoreId (..),
-    TaskStatus (..),
+    OccurrenceId (..),
-
+    ActivityId (..),
-    -- * User
+    InviteId (..),
    UserPublic (..),
    User (..),
-    UserId,
+    SignupRequest (..),
-    UserName,
+    LoginRequest (..),
-    -- * Task completion
+    -- * Household
-    TaskCompletion (..),
+    Household (..),
    Membership (..),
    MemberRole (..),
    Invite (..),
    InviteStatus (..),
    CreateHouseholdRequest (..),
    CreateInviteRequest (..),
    -- * Chore
    Chore (..),
    ChoreAssignee (..),
    Schedule (..),
    SchedulePeriod (..),
    CreateChoreRequest (..),
    UpdateChoreRequest (..),
    -- * Occurrence
    Occurrence (..),
    OccurrenceStatus (..),
    -- * Activity
    Activity (..),
    ActivityStatus (..),
    RecordActivityRequest (..),
    -- * Dashboard
    Dashboard (..),
    DashboardStats (..),
    DueItem (..),
    CompletedItem (..),
    -- * Activity log
    ActivityLogEntry (..),
    ActivityLogPage (..),
    -- * Auth responses
    AuthResponse (..),
    -- * Error
    ErrorResponse (..),
    -- * Seed
    SeedRequest (..),
 ) where
 import Data.Aeson qualified as A
 import Data.Text (Text)
-import Data.Time (UTCTime)
+import Data.Time (Day, LocalTime, UTCTime)
-- | Unique identifier for a task.
+----------------------------------------------------------------------
-type TaskId = Int
+-- IDs
 ----------------------------------------------------------------------
-- | Human-readable task name.
+newtype UserId = UserId {unUserId :: Int}
-type TaskName = Text
+    deriving newtype (Show, Eq, Read, A.ToJSON, A.FromJSON, A.ToJSONKey, A.FromJSONKey)
-- | Whether a task is pending or done.
+newtype HouseholdId = HouseholdId {unHouseholdId :: Int}
-data TaskStatus
+    deriving newtype (Show, Eq, Read, A.ToJSON, A.FromJSON, A.ToJSONKey, A.FromJSONKey)
    = TaskPending
    | TaskDone
    deriving stock (Show, Eq)
-- | A chore or responsibility that needs to be completed.
+newtype ChoreId = ChoreId {unChoreId :: Int}
-data Task = Task
+    deriving newtype (Show, Eq, Read, A.ToJSON, A.FromJSON)
    { taskId :: TaskId
    , taskName :: TaskName
    , taskStatus :: TaskStatus
    , taskAssignedTo :: Maybe UserId
    , taskLastCompleted :: Maybe UTCTime
    }
    deriving stock (Show, Eq)
-- | Unique identifier for a user.
+newtype OccurrenceId = OccurrenceId {unOccurrenceId :: Int}
-type UserId = Int
+    deriving newtype (Show, Eq, Read, A.ToJSON, A.FromJSON)
-- | Display name for a user.
+newtype ActivityId = ActivityId {unActivityId :: Int}
-type UserName = Text
+    deriving newtype (Show, Eq, Read, A.ToJSON, A.FromJSON)
 newtype InviteId = InviteId {unInviteId :: Int}
    deriving newtype (Show, Eq, Read, A.ToJSON, A.FromJSON)
 ----------------------------------------------------------------------
 -- User
 ----------------------------------------------------------------------
 -- | A user who can complete tasks.
 data User = User
    { userId :: UserId
-    , userName :: UserName
+    , userDisplayName :: Text
    , userEmail :: Text
    , userPasswordHash :: Text
    }
    deriving stock (Show, Eq)
-- | Records when a user completed a task.
+-- | Public user info (never includes password hash)
-data TaskCompletion = TaskCompletion
+data UserPublic = UserPublic
-    { completionTaskId :: TaskId
+    { upId :: UserId
-    , completionUserId :: UserId
+    , upDisplayName :: Text
-    , completionTime :: UTCTime
+    , upEmail :: Text
    }
    deriving stock (Show, Eq)
-- JSON instances
+instance A.ToJSON UserPublic where
-
+    toJSON u =
 instance A.ToJSON TaskStatus where
    toJSON TaskPending = A.String "pending"
    toJSON TaskDone = A.String "done"
 instance A.FromJSON TaskStatus where
    parseJSON = A.withText "TaskStatus" $ \case
        "pending" -> pure TaskPending
        "done" -> pure TaskDone
        other -> fail $ "Unknown TaskStatus: " <> show other
 instance A.ToJSON Task where
    toJSON Task{..} =
        A.object
-            [ "id" A..= taskId
+            [ "id" A..= upId u
-            , "name" A..= taskName
+            , "displayName" A..= upDisplayName u
-            , "status" A..= taskStatus
+            , "email" A..= upEmail u
            , "assignedTo" A..= taskAssignedTo
            , "lastCompleted" A..= taskLastCompleted
            ]
-instance A.FromJSON Task where
+data SignupRequest = SignupRequest
-    parseJSON = A.withObject "Task" $ \o ->
+    { srDisplayName :: Text
-        Task
+    , srEmail :: Text
-            <$> o A..: "id"
+    , srPassword :: Text
-            <*> o A..: "name"
+    , srConfirmPassword :: Text
-            <*> o A..: "status"
+    , srAgreeTerms :: Bool
-            <*> o A..: "assignedTo"
+    }
-            <*> o A..: "lastCompleted"
+    deriving stock (Show, Eq)
-instance A.ToJSON User where
+instance A.FromJSON SignupRequest where
-    toJSON User{..} =
+    parseJSON = A.withObject "SignupRequest" $ \o ->
        SignupRequest
            <$> o A..: "displayName"
            <*> o A..: "email"
            <*> o A..: "password"
            <*> o A..: "confirmPassword"
            <*> o A..: "agreeTerms"
 data LoginRequest = LoginRequest
    { lrEmail :: Text
    , lrPassword :: Text
    , lrRememberMe :: Bool
    }
    deriving stock (Show, Eq)
 instance A.FromJSON LoginRequest where
    parseJSON = A.withObject "LoginRequest" $ \o ->
        LoginRequest
            <$> o A..: "email"
            <*> o A..: "password"
            <*> o A..: "rememberMe"
 data AuthResponse = AuthResponse
    { arUser :: UserPublic
    , arHouseholds :: [Household]
    }
    deriving stock (Show, Eq)
 instance A.ToJSON AuthResponse where
    toJSON r =
        A.object
-            [ "id" A..= userId
+            [ "user" A..= arUser r
-            , "name" A..= userName
+            , "households" A..= arHouseholds r
            ]
-instance A.FromJSON User where
+----------------------------------------------------------------------
-    parseJSON = A.withObject "User" $ \o ->
+-- Household
-        User
+----------------------------------------------------------------------
            <$> o A..: "id"
            <*> o A..: "name"
-instance A.ToJSON TaskCompletion where
+data MemberRole = OwnerRole | MemberRole
-    toJSON TaskCompletion{..} =
+    deriving stock (Show, Eq)
 instance A.ToJSON MemberRole where
    toJSON OwnerRole = A.String "owner"
    toJSON MemberRole = A.String "member"
 instance A.FromJSON MemberRole where
    parseJSON = A.withText "MemberRole" $ \case
        "owner" -> pure OwnerRole
        "member" -> pure MemberRole
        other -> fail $ "Unknown MemberRole: " <> show other
 data Household = Household
    { householdId :: HouseholdId
    , householdName :: Text
    , householdOwner :: UserId
    , householdMemberCount :: Int
    }
    deriving stock (Show, Eq)
 instance A.ToJSON Household where
    toJSON h =
        A.object
-            [ "taskId" A..= completionTaskId
+            [ "id" A..= householdId h
-            , "userId" A..= completionUserId
+            , "name" A..= householdName h
-            , "time" A..= completionTime
+            , "owner" A..= householdOwner h
            , "memberCount" A..= householdMemberCount h
            ]
-instance A.FromJSON TaskCompletion where
+data Membership = Membership
-    parseJSON = A.withObject "TaskCompletion" $ \o ->
+    { membershipUserId :: UserId
-        TaskCompletion
+    , membershipDisplayName :: Text
-            <$> o A..: "taskId"
+    , membershipEmail :: Text
-            <*> o A..: "userId"
+    , membershipRole :: MemberRole
-            <*> o A..: "time"
+    }
    deriving stock (Show, Eq)
 instance A.ToJSON Membership where
    toJSON m =
        A.object
            [ "userId" A..= membershipUserId m
            , "displayName" A..= membershipDisplayName m
            , "email" A..= membershipEmail m
            , "role" A..= membershipRole m
            ]
 data InviteStatus = InvitePending | InviteAccepted | InviteRevoked
    deriving stock (Show, Eq)
 instance A.ToJSON InviteStatus where
    toJSON InvitePending = A.String "pending"
    toJSON InviteAccepted = A.String "accepted"
    toJSON InviteRevoked = A.String "revoked"
 instance A.FromJSON InviteStatus where
    parseJSON = A.withText "InviteStatus" $ \case
        "pending" -> pure InvitePending
        "accepted" -> pure InviteAccepted
        "revoked" -> pure InviteRevoked
        other -> fail $ "Unknown InviteStatus: " <> show other
 data Invite = Invite
    { inviteId :: InviteId
    , inviteHouseholdId :: HouseholdId
    , inviteCode :: Text
    , inviteEmail :: Maybe Text
    , inviteStatus :: InviteStatus
    , inviteCreatedAt :: UTCTime
    }
    deriving stock (Show, Eq)
 instance A.ToJSON Invite where
    toJSON i =
        A.object
            [ "id" A..= inviteId i
            , "code" A..= inviteCode i
            , "email" A..= inviteEmail i
            , "status" A..= inviteStatus i
            , "createdAt" A..= inviteCreatedAt i
            ]
 newtype CreateHouseholdRequest = CreateHouseholdRequest
    { chrName :: Text
    }
    deriving stock (Show, Eq)
 instance A.FromJSON CreateHouseholdRequest where
    parseJSON = A.withObject "CreateHouseholdRequest" $ \o ->
        CreateHouseholdRequest <$> o A..: "name"
 newtype CreateInviteRequest = CreateInviteRequest
    { cirEmail :: Maybe Text
    }
    deriving stock (Show, Eq)
 instance A.FromJSON CreateInviteRequest where
    parseJSON = A.withObject "CreateInviteRequest" $ \o ->
        CreateInviteRequest <$> o A..: "email"
 ----------------------------------------------------------------------
 -- Chore
 ----------------------------------------------------------------------
 data ChoreAssignee
    = AssigneeUser UserId
    | AssigneeAnyone
    deriving stock (Show, Eq)
 instance A.ToJSON ChoreAssignee where
    toJSON (AssigneeUser uid) = A.object ["type" A..= A.String "user", "userId" A..= uid]
    toJSON AssigneeAnyone = A.object ["type" A..= A.String "anyone"]
 instance A.FromJSON ChoreAssignee where
    parseJSON = A.withObject "ChoreAssignee" $ \o -> do
        ty <- o A..: "type"
        case (ty :: Text) of
            "user" -> AssigneeUser <$> o A..: "userId"
            "anyone" -> pure AssigneeAnyone
            other -> fail $ "Unknown ChoreAssignee type: " <> show other
 data SchedulePeriod = PeriodDaily | PeriodWeekly | PeriodMonthly
    deriving stock (Show, Eq)
 instance A.ToJSON SchedulePeriod where
    toJSON PeriodDaily = A.String "daily"
    toJSON PeriodWeekly = A.String "weekly"
    toJSON PeriodMonthly = A.String "monthly"
 instance A.FromJSON SchedulePeriod where
    parseJSON = A.withText "SchedulePeriod" $ \case
        "daily" -> pure PeriodDaily
        "weekly" -> pure PeriodWeekly
        "monthly" -> pure PeriodMonthly
        other -> fail $ "Unknown SchedulePeriod: " <> show other
 data Schedule
    = ScheduleOneOff {soDate :: Day, soTime :: Maybe LocalTime}
    | ScheduleRecurring
        { srPeriod :: SchedulePeriod
        , srStartDate :: Day
        , srTimeOfDay :: Maybe Text
        , srDaysOfWeek :: Maybe [Int]
        , srDaysOfMonth :: Maybe [Int]
        }
    | ScheduleSometime
    deriving stock (Show, Eq)
 instance A.ToJSON Schedule where
    toJSON (ScheduleOneOff date mtime) =
        A.object
            [ "type" A..= A.String "one_off"
            , "date" A..= date
            , "time" A..= mtime
            ]
    toJSON (ScheduleRecurring period start tod dows doms) =
        A.object
            [ "type" A..= A.String "recurring"
            , "period" A..= period
            , "startDate" A..= start
            , "timeOfDay" A..= tod
            , "daysOfWeek" A..= dows
            , "daysOfMonth" A..= doms
            ]
    toJSON ScheduleSometime =
        A.object ["type" A..= A.String "sometime"]
 instance A.FromJSON Schedule where
    parseJSON = A.withObject "Schedule" $ \o -> do
        ty <- o A..: "type"
        case (ty :: Text) of
            "one_off" ->
                ScheduleOneOff
                    <$> o A..: "date"
                    <*> o A..: "time"
            "recurring" ->
                ScheduleRecurring
                    <$> o A..: "period"
                    <*> o A..: "startDate"
                    <*> o A..: "timeOfDay"
                    <*> o A..: "daysOfWeek"
                    <*> o A..: "daysOfMonth"
            "sometime" -> pure ScheduleSometime
            other -> fail $ "Unknown Schedule type: " <> show other
 data Chore = Chore
    { choreId :: ChoreId
    , choreHouseholdId :: HouseholdId
    , choreName :: Text
    , choreAssignee :: ChoreAssignee
    , choreSchedule :: Schedule
    , choreNotifyOnDue :: Bool
    , choreCreatedAt :: UTCTime
    }
    deriving stock (Show, Eq)
 instance A.ToJSON Chore where
    toJSON c =
        A.object
            [ "id" A..= choreId c
            , "householdId" A..= choreHouseholdId c
            , "name" A..= choreName c
            , "assignee" A..= choreAssignee c
            , "schedule" A..= choreSchedule c
            , "notifyOnDue" A..= choreNotifyOnDue c
            , "createdAt" A..= choreCreatedAt c
            ]
 data CreateChoreRequest = CreateChoreRequest
    { ccrName :: Text
    , ccrAssignee :: ChoreAssignee
    , ccrSchedule :: Schedule
    , ccrNotifyOnDue :: Bool
    }
    deriving stock (Show, Eq)
 instance A.FromJSON CreateChoreRequest where
    parseJSON = A.withObject "CreateChoreRequest" $ \o ->
        CreateChoreRequest
            <$> o A..: "name"
            <*> o A..: "assignee"
            <*> o A..: "schedule"
            <*> o A..: "notifyOnDue"
 data UpdateChoreRequest = UpdateChoreRequest
    { ucrName :: Text
    , ucrAssignee :: ChoreAssignee
    , ucrSchedule :: Schedule
    , ucrNotifyOnDue :: Bool
    }
    deriving stock (Show, Eq)
 instance A.FromJSON UpdateChoreRequest where
    parseJSON = A.withObject "UpdateChoreRequest" $ \o ->
        UpdateChoreRequest
            <$> o A..: "name"
            <*> o A..: "assignee"
            <*> o A..: "schedule"
            <*> o A..: "notifyOnDue"
 ----------------------------------------------------------------------
 -- Occurrence
 ----------------------------------------------------------------------
 data OccurrenceStatus = OccDue | OccOverdue | OccCompleted | OccSkipped
    deriving stock (Show, Eq)
 instance A.ToJSON OccurrenceStatus where
    toJSON OccDue = A.String "due"
    toJSON OccOverdue = A.String "overdue"
    toJSON OccCompleted = A.String "completed"
    toJSON OccSkipped = A.String "skipped"
 data Occurrence = Occurrence
    { occurrenceId :: OccurrenceId
    , occurrenceChoreId :: ChoreId
    , occurrenceDate :: Day
    , occurrenceStatus :: OccurrenceStatus
    }
    deriving stock (Show, Eq)
 instance A.ToJSON Occurrence where
    toJSON o =
        A.object
            [ "id" A..= occurrenceId o
            , "choreId" A..= occurrenceChoreId o
            , "date" A..= occurrenceDate o
            , "status" A..= occurrenceStatus o
            ]
 ----------------------------------------------------------------------
 -- Activity
 ----------------------------------------------------------------------
 data ActivityStatus = ActivityCompleted | ActivitySkipped
    deriving stock (Show, Eq)
 instance A.ToJSON ActivityStatus where
    toJSON ActivityCompleted = A.String "completed"
    toJSON ActivitySkipped = A.String "skipped"
 instance A.FromJSON ActivityStatus where
    parseJSON = A.withText "ActivityStatus" $ \case
        "completed" -> pure ActivityCompleted
        "skipped" -> pure ActivitySkipped
        other -> fail $ "Unknown ActivityStatus: " <> show other
 data Activity = Activity
    { activityId :: ActivityId
    , activityOccurrenceId :: OccurrenceId
    , activityUserId :: UserId
    , activityStatus :: ActivityStatus
    , activityNote :: Maybe Text
    , activityNotifyHousehold :: Bool
    , activityRecordedAt :: UTCTime
    }
    deriving stock (Show, Eq)
 instance A.ToJSON Activity where
    toJSON a =
        A.object
            [ "id" A..= activityId a
            , "occurrenceId" A..= activityOccurrenceId a
            , "userId" A..= activityUserId a
            , "status" A..= activityStatus a
            , "note" A..= activityNote a
            , "notifyHousehold" A..= activityNotifyHousehold a
            , "recordedAt" A..= activityRecordedAt a
            ]
 data RecordActivityRequest = RecordActivityRequest
    { rarStatus :: ActivityStatus
    , rarNote :: Maybe Text
    , rarNotifyHousehold :: Bool
    }
    deriving stock (Show, Eq)
 instance A.FromJSON RecordActivityRequest where
    parseJSON = A.withObject "RecordActivityRequest" $ \o ->
        RecordActivityRequest
            <$> o A..: "status"
            <*> o A..: "note"
            <*> o A..: "notifyHousehold"
 ----------------------------------------------------------------------
 -- Dashboard
 ----------------------------------------------------------------------
 data DashboardStats = DashboardStats
    { dsOverdue :: Int
    , dsDueToday :: Int
    , dsDoneThisWeek :: Int
    }
    deriving stock (Show, Eq)
 instance A.ToJSON DashboardStats where
    toJSON s =
        A.object
            [ "overdue" A..= dsOverdue s
            , "dueToday" A..= dsDueToday s
            , "doneThisWeek" A..= dsDoneThisWeek s
            ]
 -- | An occurrence with chore and assignee info attached for display
 data DueItem = DueItem
    { diOccurrence :: Occurrence
    , diChoreName :: Text
    , diAssigneeName :: Maybe Text
    , diIsOverdue :: Bool
    }
    deriving stock (Show, Eq)
 instance A.ToJSON DueItem where
    toJSON d =
        A.object
            [ "occurrence" A..= diOccurrence d
            , "choreName" A..= diChoreName d
            , "assigneeName" A..= diAssigneeName d
            , "isOverdue" A..= diIsOverdue d
            ]
 -- | A completed activity with user info for display
 data CompletedItem = CompletedItem
    { ciActivity :: Activity
    , ciUserName :: Text
    , ciChoreName :: Text
    }
    deriving stock (Show, Eq)
 instance A.ToJSON CompletedItem where
    toJSON c =
        A.object
            [ "activity" A..= ciActivity c
            , "userName" A..= ciUserName c
            , "choreName" A..= ciChoreName c
            ]
 data Dashboard = Dashboard
    { dashStats :: DashboardStats
    , dashDueItems :: [DueItem]
    , dashCompletedItems :: [CompletedItem]
    }
    deriving stock (Show, Eq)
 instance A.ToJSON Dashboard where
    toJSON d =
        A.object
            [ "stats" A..= dashStats d
            , "dueItems" A..= dashDueItems d
            , "completedItems" A..= dashCompletedItems d
            ]
 ----------------------------------------------------------------------
 -- Activity Log
 ----------------------------------------------------------------------
 data ActivityLogEntry = ActivityLogEntry
    { aleActivity :: Activity
    , aleUserName :: Text
    , aleUserEmail :: Text
    , aleChoreName :: Text
    , aleOccurrenceDate :: Day
    }
    deriving stock (Show, Eq)
 instance A.ToJSON ActivityLogEntry where
    toJSON e =
        A.object
            [ "activity" A..= aleActivity e
            , "userName" A..= aleUserName e
            , "userEmail" A..= aleUserEmail e
            , "choreName" A..= aleChoreName e
            , "occurrenceDate" A..= aleOccurrenceDate e
            ]
 data ActivityLogPage = ActivityLogPage
    { alpEntries :: [ActivityLogEntry]
    , alpPage :: Int
    , alpPerPage :: Int
    , alpTotal :: Int
    }
    deriving stock (Show, Eq)
 instance A.ToJSON ActivityLogPage where
    toJSON p =
        A.object
            [ "entries" A..= alpEntries p
            , "page" A..= alpPage p
            , "perPage" A..= alpPerPage p
            , "total" A..= alpTotal p
            ]
 ----------------------------------------------------------------------
 -- Error
 ----------------------------------------------------------------------
 data ErrorResponse = ErrorResponse
    { errorMessage :: Text
    , errorField :: Maybe Text
    }
    deriving stock (Show, Eq)
 instance A.ToJSON ErrorResponse where
    toJSON e =
        A.object
            [ "error" A..= errorMessage e
            , "field" A..= errorField e
            ]
 ----------------------------------------------------------------------
 -- Seed
 ----------------------------------------------------------------------
 data SeedRequest = SeedRequest
    deriving stock (Show, Eq)
 instance A.FromJSON SeedRequest where
    parseJSON _ = pure SeedRequest