refactor: strip Aeson from Types, remove Server.hs, fix Sis.hs exports, update deps

- Removed all Aeson instances from Types.hs
- Deleted Server.hs (Orb/WAI routing)
- Added Hyperbole form types (LoginForm, SignupForm, etc.)
- Removed Server from Sis.hs and cabal file
- Updated stack.yaml for Hyperbole dependency resolution
- Added local hyperbole copy with GHC 9.10 compat patches
- Types.hs, Database.hs, Auth.hs compile successfully

.gitignore

@@ -12,3 +12,5 @@ __pycache__
 .superpowers/
 node_modules/
 frontend/dist/
+hyperbole-local/
+hyperbole-local/

sis-server.cabal

@@ -19,7 +19,6 @@ library
       Sis
       Sis.Auth
       Sis.Database
-      Sis.Server
       Sis.Types
   other-modules:
       Paths_sis_server

src/Sis.hs

@@ -5,5 +5,4 @@ module Sis (
 
 import Sis.Auth as X
 import Sis.Database as X
-import Sis.Server as X
 import Sis.Types as X

src/Sis/Server.hs

@@ -1,770 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-{- | Simple WAI-based HTTP server for Sis.
-Bypasses Orb's complex routing for a straightforward manual approach.
--}
-module Sis.Server (app) where
-
-import Control.Exception.Safe qualified as Safe
-import Control.Monad (unless, void, when)
-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, listToMaybe)
-import Data.Text qualified as T
-import Data.Text.Encoding qualified as TE
-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 System.Directory (doesFileExist)
-import System.FilePath ((</>))
-import Text.Read (readMaybe)
-
-import Sis.Auth qualified as Auth
-import Sis.Types
-
-app :: FilePath -> SQL.Connection -> Wai.Application
-app staticDir conn request respond = do
-    let path = TE.decodeUtf8 $ Wai.rawPathInfo request
-    if "/api/" `T.isPrefixOf` path
-        then handleApi conn request respond
-        else serveStaticOrSpa staticDir request respond
-
--- | Handle all API routes by dispatching on path and method.
-handleApi :: SQL.Connection -> Wai.Application
-handleApi conn request respond = do
-    let segs = filter (not . T.null) $ T.splitOn "/" $ TE.decodeUtf8 $ Wai.rawPathInfo request
-        method = Wai.requestMethod request
-        getBody = Wai.strictRequestBody request
-    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"
-
--- | Exception carrying a pre-built WAI response for early exit.
-newtype ApiResponse = ApiResponse Wai.Response
-
-instance Show ApiResponse where show _ = "ApiResponse"
-instance Safe.Exception ApiResponse
-
--- | Throw a response to exit early.
-throwResp :: HTTP.Status -> BL.ByteString -> IO a
-throwResp status body =
-    Safe.throwIO $
-        ApiResponse $
-            Wai.responseLBS status [("Content-Type", "application/json")] body
-
-throwJSON :: (A.ToJSON a) => HTTP.Status -> a -> IO b
-throwJSON status v = throwResp status (A.encode v)
-
-throwError :: HTTP.Status -> T.Text -> IO a
-throwError status msg = throwJSON status (ErrorResponse msg Nothing)
-
-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
-    go d | d > toDate = [] | otherwise = d : go (next period d)
-    next PeriodDaily = Time.addDays 1; next PeriodWeekly = Time.addDays 7; next PeriodMonthly = Time.addGregorianMonthsClip 1
-
-----------------------------------------------------------------------
--- 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 =
-    Map.fromList
-        [ ("html", "text/html")
-        , ("css", "text/css")
-        , ("js", "application/javascript")
-        , ("json", "application/json")
-        , ("png", "image/png")
-        , ("jpg", "image/jpeg")
-        , ("svg", "image/svg+xml")
-        , ("ico", "image/x-icon")
-        , ("manifest", "application/manifest+json")
-        ]
-
-serveStaticOrSpa :: FilePath -> Wai.Application
-serveStaticOrSpa staticDir request respond = do
-    let path = TE.decodeUtf8 $ Wai.rawPathInfo request
-    let fp = staticDir </> dropWhile (== '/') (T.unpack path)
-    exists <- doesFileExist fp
-    let hasExt = '.' `elem` reverse (takeWhile (/= '/') (reverse (T.unpack path)))
-    if exists
-        then do
-            content <- BS.readFile fp
-            let ct = fromMaybe "application/octet-stream" $ mimeType fp
-            respond $ Wai.responseLBS HTTP.status200 [("Content-Type", ct)] (BL.fromStrict content)
-        else
-            if not hasExt
-                then do
-                    let indexPath = staticDir </> "index.html"
-                    idxExists <- doesFileExist indexPath
-                    if idxExists
-                        then do
-                            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 = Wai.responseLBS HTTP.status404 [("Content-Type", "text/plain")] "Not Found"

src/Sis/Types.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 {- | Core domain types for Sis.
@@ -13,10 +15,7 @@ module Sis.Types (
     OccurrenceId (..),
     ActivityId (..),
     InviteId (..),
-    UserPublic (..),
     User (..),
-    SignupRequest (..),
-    LoginRequest (..),
 
     -- * Household
     Household (..),
@@ -24,16 +23,12 @@ module Sis.Types (
     MemberRole (..),
     Invite (..),
     InviteStatus (..),
-    CreateHouseholdRequest (..),
-    CreateInviteRequest (..),
 
     -- * Chore
     Chore (..),
     ChoreAssignee (..),
     Schedule (..),
     SchedulePeriod (..),
-    CreateChoreRequest (..),
-    UpdateChoreRequest (..),
 
     -- * Occurrence
     Occurrence (..),
@@ -42,7 +37,6 @@ module Sis.Types (
     -- * Activity
     Activity (..),
     ActivityStatus (..),
-    RecordActivityRequest (..),
 
     -- * Dashboard
     Dashboard (..),
@@ -54,41 +48,40 @@ module Sis.Types (
     ActivityLogEntry (..),
     ActivityLogPage (..),
 
-    -- * Auth responses
+    -- * Form types for Hyperbole
-    AuthResponse (..),
+    LoginForm (..),
-
+    SignupForm (..),
-    -- * Error
+    ChoreFormData (..),
-    ErrorResponse (..),
+    ActivityFormData (..),
-
+    HouseholdFormData (..),
-    -- * Seed
-    SeedRequest (..),
 ) where
 
-import Data.Aeson qualified as A
 import Data.Text (Text)
 import Data.Time (Day, LocalTime, UTCTime)
+import GHC.Generics (Generic)
+import Web.Hyperbole.HyperView.Forms (FromForm)
 
 ----------------------------------------------------------------------
 -- IDs
 ----------------------------------------------------------------------
 
 newtype UserId = UserId {unUserId :: Int}
-    deriving newtype (Show, Eq, Read, A.ToJSON, A.FromJSON, A.ToJSONKey, A.FromJSONKey)
+    deriving newtype (Show, Eq, Read)
 
 newtype HouseholdId = HouseholdId {unHouseholdId :: Int}
-    deriving newtype (Show, Eq, Read, A.ToJSON, A.FromJSON, A.ToJSONKey, A.FromJSONKey)
+    deriving newtype (Show, Eq, Read)
 
 newtype ChoreId = ChoreId {unChoreId :: Int}
-    deriving newtype (Show, Eq, Read, A.ToJSON, A.FromJSON)
+    deriving newtype (Show, Eq, Read)
 
 newtype OccurrenceId = OccurrenceId {unOccurrenceId :: Int}
-    deriving newtype (Show, Eq, Read, A.ToJSON, A.FromJSON)
+    deriving newtype (Show, Eq, Read)
 
 newtype ActivityId = ActivityId {unActivityId :: Int}
-    deriving newtype (Show, Eq, Read, A.ToJSON, A.FromJSON)
+    deriving newtype (Show, Eq, Read)
 
 newtype InviteId = InviteId {unInviteId :: Int}
-    deriving newtype (Show, Eq, Read, A.ToJSON, A.FromJSON)
+    deriving newtype (Show, Eq, Read)
 
 ----------------------------------------------------------------------
 -- User
@@ -102,67 +95,6 @@ data User = User
     }
     deriving stock (Show, Eq)
 
--- | Public user info (never includes password hash)
-data UserPublic = UserPublic
-    { upId :: UserId
-    , upDisplayName :: Text
-    , upEmail :: Text
-    }
-    deriving stock (Show, Eq)
-
-instance A.ToJSON UserPublic where
-    toJSON u =
-        A.object
-            [ "id" A..= upId u
-            , "displayName" A..= upDisplayName u
-            , "email" A..= upEmail u
-            ]
-
-data SignupRequest = SignupRequest
-    { srDisplayName :: Text
-    , srEmail :: Text
-    , srPassword :: Text
-    , srConfirmPassword :: Text
-    , srAgreeTerms :: Bool
-    }
-    deriving stock (Show, Eq)
-
-instance A.FromJSON SignupRequest where
-    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
-            [ "user" A..= arUser r
-            , "households" A..= arHouseholds r
-            ]
-
 ----------------------------------------------------------------------
 -- Household
 ----------------------------------------------------------------------
@@ -170,16 +102,6 @@ instance A.ToJSON AuthResponse where
 data MemberRole = OwnerRole | MemberRole
     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
@@ -188,15 +110,6 @@ data Household = Household
     }
     deriving stock (Show, Eq)
 
-instance A.ToJSON Household where
-    toJSON h =
-        A.object
-            [ "id" A..= householdId h
-            , "name" A..= householdName h
-            , "owner" A..= householdOwner h
-            , "memberCount" A..= householdMemberCount h
-            ]
-
 data Membership = Membership
     { membershipUserId :: UserId
     , membershipDisplayName :: Text
@@ -205,30 +118,9 @@ data Membership = Membership
     }
     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
@@ -239,34 +131,6 @@ data Invite = Invite
     }
     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
 ----------------------------------------------------------------------
@@ -276,32 +140,8 @@ data ChoreAssignee
     | 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)
+    deriving stock (Show, Eq, Read)
-
-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}
@@ -313,44 +153,7 @@ data Schedule
         , srDaysOfMonth :: Maybe [Int]
         }
     | ScheduleSometime
-    deriving stock (Show, Eq)
+    deriving stock (Show, Eq, Read)
-
-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
@@ -363,50 +166,6 @@ data Chore = Chore
     }
     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
 ----------------------------------------------------------------------
@@ -414,12 +173,6 @@ instance A.FromJSON UpdateChoreRequest where
 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
@@ -428,15 +181,6 @@ data Occurrence = Occurrence
     }
     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
 ----------------------------------------------------------------------
@@ -444,16 +188,6 @@ instance A.ToJSON Occurrence where
 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
@@ -465,32 +199,6 @@ data Activity = Activity
     }
     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
 ----------------------------------------------------------------------
@@ -502,15 +210,6 @@ data DashboardStats = DashboardStats
     }
     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
@@ -519,16 +218,6 @@ data DueItem = DueItem
     }
     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
@@ -536,14 +225,6 @@ data CompletedItem = CompletedItem
     }
     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]
@@ -551,14 +232,6 @@ data Dashboard = Dashboard
     }
     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
 ----------------------------------------------------------------------
@@ -572,16 +245,6 @@ data ActivityLogEntry = ActivityLogEntry
     }
     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
@@ -590,38 +253,45 @@ data ActivityLogPage = ActivityLogPage
     }
     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
+-- Hyperbole Form Types
 ----------------------------------------------------------------------
 
-data ErrorResponse = ErrorResponse
+data LoginForm = LoginForm
-    { errorMessage :: Text
+    { lfEmail :: Text
-    , errorField :: Maybe Text
+    , lfPassword :: Text
+    , lfRemember :: Bool
     }
-    deriving stock (Show, Eq)
+    deriving (Show, Eq, Generic, FromForm)
 
-instance A.ToJSON ErrorResponse where
+data SignupForm = SignupForm
-    toJSON e =
+    { sfDisplayName :: Text
-        A.object
+    , sfEmail :: Text
-            [ "error" A..= errorMessage e
+    , sfPassword :: Text
-            , "field" A..= errorField e
+    , sfConfirm :: Text
-            ]
+    , sfAgree :: Bool
+    }
+    deriving (Show, Eq, Generic, FromForm)
 
-----------------------------------------------------------------------
+data ChoreFormData = ChoreFormData
--- Seed
+    { cfdName :: Text
-----------------------------------------------------------------------
+    , cfdScheduleType :: Text
+    , cfdStartDate :: Text
+    , cfdTimeOfDay :: Maybe Text
+    , cfdPeriod :: Text
+    , cfdAssignee :: Text
+    , cfdNotify :: Bool
+    }
+    deriving (Show, Eq, Generic, FromForm)
 
-data SeedRequest = SeedRequest
+data ActivityFormData = ActivityFormData
-    deriving stock (Show, Eq)
+    { afdStatus :: Text
+    , afdNote :: Maybe Text
+    , afdNotify :: Bool
+    }
+    deriving (Show, Eq, Generic, FromForm)
 
-instance A.FromJSON SeedRequest where
+data HouseholdFormData = HouseholdFormData
-    parseJSON _ = pure SeedRequest
+    { hfdName :: Text
+    }
+    deriving (Show, Eq, Generic, FromForm)

stack.yaml

@@ -2,16 +2,15 @@ resolver: lts-24.38
 
 packages:
   - .
+  - hyperbole-local
 
 extra-deps:
-  - hyperbole-0.7.1
   - atomic-css-0.2.0
   - data-default-0.8.0.2
   - effectful-2.4.0.0
   - effectful-core-2.4.0.0
   - string-conversions-0.4.0.1
-  - aeson-2.1.2.1
+  - attoparsec-aeson-2.2.2.0
-  - attoparsec-aeson-2.1.0.0
   - string-interpolate-0.3.4.0
 
 allow-newer: true

stack.yaml.lock

@@ -5,104 +5,54 @@
 
 packages:
 - completed:
-    name: beeline-params
+    hackage: atomic-css-0.2.0@sha256:7a546465724689e55c9b9cad64da7c361f2de728430f994a73f906985b164c09,3106
     pantry-tree:
-      sha256: 44791687ad987b596ff02fd1776386bef293a27e097c7c589a3bb76a9a81f200
+      sha256: 0f13530abe495d48d977abe09747749dc7d3911629c5a8107e067f4446bfea25
-      size: 1210
+      size: 1931
-    sha256: 93fff6138e28d8989741b4fc8622096d2211dad35f1d113a341d89d0d3235d8f
-    size: 36315
-    subdir: beeline-params
-    url: https://github.com/flipstone/beeline/archive/e31206f52fec7e96c15de9a2bab9ef1876db137b.tar.gz
-    version: 0.3.0.0
   original:
-    subdir: beeline-params
+    hackage: atomic-css-0.2.0
-    url: https://github.com/flipstone/beeline/archive/e31206f52fec7e96c15de9a2bab9ef1876db137b.tar.gz
 - completed:
-    name: beeline-routing
+    hackage: data-default-0.8.0.2@sha256:d4a8c9ed574a43315262666c75efe1080e3913a653844d2a9ff36051a6211bee,1110
     pantry-tree:
-      sha256: 555ab8a55094ffa801fa8ee8e8fc9b11ec21c08cff29e5dc152ae7f171fa3ccd
+      sha256: 6f42bc6c080c5e1cb7894b03b2d1494a05b9056dcef477965205e9448d8889f8
-      size: 1119
+      size: 382
-    sha256: 93fff6138e28d8989741b4fc8622096d2211dad35f1d113a341d89d0d3235d8f
-    size: 36315
-    subdir: beeline-routing
-    url: https://github.com/flipstone/beeline/archive/e31206f52fec7e96c15de9a2bab9ef1876db137b.tar.gz
-    version: 0.3.0.2
   original:
-    subdir: beeline-routing
+    hackage: data-default-0.8.0.2
-    url: https://github.com/flipstone/beeline/archive/e31206f52fec7e96c15de9a2bab9ef1876db137b.tar.gz
 - completed:
-    name: shrubbery
+    hackage: effectful-2.4.0.0@sha256:a821150318cda9c9c8d17230de8b3c6df47d3be9aba6aeb9faaf28a80bf374c5,7670
     pantry-tree:
-      sha256: d16c6b171d9b360098760d2c2269ded8eaae823ed9aa5c7a36598673e83fb9e3
+      sha256: 2debfdcf5f46f02ce8c9f4cbed19496bf92dcfbd198eb319a0c0269af0db425f
-      size: 2834
+      size: 3409
-    sha256: 8bb3b52a8f9cb3f6edc5ee0c4584c81187b05966d59d718a247a6707479e2e33
-    size: 30344
-    url: https://github.com/flipstone/shrubbery/archive/a064ede07e01b753a6eb310fc24d9fd8da1ad826.tar.gz
-    version: 0.2.3.1
   original:
-    url: https://github.com/flipstone/shrubbery/archive/a064ede07e01b753a6eb310fc24d9fd8da1ad826.tar.gz
+    hackage: effectful-2.4.0.0
 - completed:
-    name: json-fleece-aeson
+    hackage: effectful-core-2.4.0.0@sha256:fd799704b5a8bc3a7b7709a5ffa33584602b98e5f3b8b1e9c770816dd9f8ccc3,4395
     pantry-tree:
-      sha256: 1519042c7af52c169b4543d0de5639d344f3ea8652461fdc8d85f26b0d318f5a
+      sha256: 49af204868918943e05f709f9cf9c5c93c60f5614a0ee1d31cd29f678bf960ce
-      size: 628
+      size: 2473
-    sha256: 534fdb939c428db16fc6c07d3fe1c709ebc0b5b43c490f89639d6093ea12d8f3
-    size: 3095867
-    subdir: json-fleece-aeson
-    url: https://github.com/flipstone/json-fleece/archive/77813eac694f937b6e013230825f03aba224f866.tar.gz
-    version: 0.5.1.0
   original:
-    subdir: json-fleece-aeson
+    hackage: effectful-core-2.4.0.0
-    url: https://github.com/flipstone/json-fleece/archive/77813eac694f937b6e013230825f03aba224f866.tar.gz
 - completed:
-    name: json-fleece-core
+    hackage: string-conversions-0.4.0.1@sha256:9af49d61d1dcbc8b90b66f1b6580996b7927f745273edb59141ad6744aef7cbc,1693
     pantry-tree:
-      sha256: 87d6a45a9b470843d28d1c2927b8f12ad4f687d987bad630e04ead9e824ee0a9
+      sha256: 95b5bc46689b408ad3c898388bc55fe36612451d521c6cdd5beeb93a033d4848
-      size: 491
+      size: 442
-    sha256: 534fdb939c428db16fc6c07d3fe1c709ebc0b5b43c490f89639d6093ea12d8f3
-    size: 3095867
-    subdir: json-fleece-core
-    url: https://github.com/flipstone/json-fleece/archive/77813eac694f937b6e013230825f03aba224f866.tar.gz
-    version: 0.12.0.0
   original:
-    subdir: json-fleece-core
+    hackage: string-conversions-0.4.0.1
-    url: https://github.com/flipstone/json-fleece/archive/77813eac694f937b6e013230825f03aba224f866.tar.gz
 - completed:
-    name: bounded-text
+    hackage: attoparsec-aeson-2.2.2.0@sha256:08948f45b892c5758d2c42e22fe2fbd41a4f6dc395fb0a43c2bf458a1f295736,1664
     pantry-tree:
-      sha256: e98540b1877ae4709420472f83e8fd04b987eaeb914df72bb33b0bbe55debac2
+      sha256: da131689cab810d63fefbca44bb40aa96be6ab5981e11308eef73b57edfe26c6
-      size: 2162
+      size: 404
-    sha256: 29c500737d8e481fe2e3325fe643a9cafc565ffd06b754bf14219f579d927f5d
-    size: 11885
-    url: https://github.com/flipstone/bounded-text/archive/3ef94eeda5402857423284d0c4e021a8c8032498.tar.gz
-    version: 0.1.2.0
   original:
-    url: https://github.com/flipstone/bounded-text/archive/3ef94eeda5402857423284d0c4e021a8c8032498.tar.gz
+    hackage: attoparsec-aeson-2.2.2.0
 - completed:
-    name: orb
+    hackage: string-interpolate-0.3.4.0@sha256:b58f8d4f2d591878b3e632dc36b210582d41e72f5e6484a2e42a647a57b85a18,4274
     pantry-tree:
-      sha256: 8888da81f391b551df85ce50b9f8ec7349dcf87b3a062780cf71d915c8c7e0e1
+      sha256: 73130fdccd3de97e38971a0dc002fd303fc83db3019ccebf739fe4bc45735822
-      size: 6804
+      size: 1248
-    sha256: 47bc481b103d86fe38bd0b94d09d88f242e657073108018a2e4652e695636f0f
-    size: 1194518
-    url: https://github.com/flipstone/orb/archive/74cceef9d0db9ac3ef1856613e7605750c8c0a2a.tar.gz
-    version: 0.7.1.0
   original:
-    url: https://github.com/flipstone/orb/archive/74cceef9d0db9ac3ef1856613e7605750c8c0a2a.tar.gz
+    hackage: string-interpolate-0.3.4.0
-- completed:
-    hackage: template-haskell-lift-0.1.0.0@sha256:f6cd3ee45b0c68480c400bfca9f08f39e8e87a5eb823f206dbe06ab1923a4f1c,1136
-    pantry-tree:
-      sha256: 56ab994094c839bebb643ce5fc58dfae6269517ebe91f380e259adaf1def08bf
-      size: 243
-  original:
-    hackage: template-haskell-lift-0.1.0.0
-- completed:
-    hackage: template-haskell-quasiquoter-0.1.0.0@sha256:71027c432c0fb1a293d0f2b1d46dd5be42b9703b7c4b2233ea8076bfc6f84aae,1181
-    pantry-tree:
-      sha256: f9f5177a522cc273c001dd5bd749e4f7ed841910c6136711b9b9825bc0bc9c56
-      size: 257
-  original:
-    hackage: template-haskell-quasiquoter-0.1.0.0
 snapshots:
 - completed:
     sha256: abc790b571e0c70e929db74b329e3c18d7e76a6e173e8bdf94f1ba20770d4c24