feat: accept household invites via shareable /invite/<code> URL

app/Main.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 {-# OPTIONS_GHC -Wno-unused-imports -Wno-missing-export-lists -Wno-name-shadowing #-}
 
@@ -20,6 +21,7 @@ import System.Environment (getArgs, lookupEnv)
 import System.FilePath (takeDirectory)
 import System.IO.Error (isDoesNotExistError)
 
+import Sis (UserId (..))
 import Sis.Database
 import Sis.Page.Activity
 import Sis.Page.Chores
@@ -28,7 +30,7 @@ import Sis.Page.Household
 import Sis.Page.Login
 import Sis.Page.Signup
 import Sis.Route
-import Sis.View.Layout (documentHead)
+import Sis.View.Layout (UserSession (..), documentHead)
 import Web.Hyperbole
 import Web.Hyperbole.Application
 import Web.Hyperbole.Effect.Response
@@ -108,6 +110,15 @@ router RDashboard = runPage Sis.Page.Dashboard.page
 router RChores = runPage Sis.Page.Chores.page
 router RHousehold = runPage Sis.Page.Household.page
 router RActivity = runPage Sis.Page.Activity.page
+router (RInvite code) = do
+    mSession <- lookupSession @UserSession
+    case mSession of
+        Nothing -> redirect (routeUri RLogin)
+        Just us -> do
+            mHousehold <- acceptInvite (UserId (usUserId us)) (unInviteCode code)
+            case mHousehold of
+                Just _ -> redirect (routeUri RDashboard)
+                Nothing -> redirect (routeUri RHousehold)
 router RSeed = do
     seed
     redirect (routeUri RDashboard)