UI: Project: Children: Display child invites, their details & status

src/Vervis/Handler/Project.hs

@@ -1,6 +1,7 @@
 {- This file is part of Vervis.
  -
- - Written in 2016, 2019, 2022, 2023 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2019, 2022, 2023, 2024
+ - by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -47,6 +48,7 @@ module Vervis.Handler.Project
 where
 
 import Control.Applicative
+import Control.Arrow ((&&&))
 import Control.Monad
 import Control.Monad.Trans.Except
 import Control.Monad.Trans.Maybe
@@ -57,7 +59,7 @@ import Data.ByteString (ByteString)
 import Data.Default.Class
 import Data.Foldable
 import Data.List
-import Data.Maybe (fromMaybe)
+import Data.Maybe
 import Data.Text (Text)
 import Data.Time.Clock
 import Data.Traversable
@@ -662,7 +664,71 @@ getProjectChildrenR projectHash = do
                 )
 
     getHtml projectID project actor children = do
+        invites <- handlerToWidget $ runDB $ do
+            sources <- E.select $ E.from $ \ (source `E.InnerJoin` holder `E.LeftOuterJoin` deleg) -> do
+                E.on $ E.just (source E.^. SourceId) E.==. deleg E.?. SourceUsSendDelegatorSource
+                E.on $ source E.^. SourceId E.==. holder E.^. SourceHolderProjectSource
+                E.where_ $
+                    holder E.^. SourceHolderProjectProject E.==. E.val projectID E.&&.
+                    E.isNothing (deleg E.?. SourceUsSendDelegatorId)
+                E.orderBy [E.asc $ source E.^. SourceId]
+                return source
+            for sources $ \ (Entity sourceID (Source role)) -> do
+                (child, accept) <- do
+                    topic <- getSourceTopic sourceID
+                    accept <-
+                        case bimap fst fst topic of
+                            Left localID -> isJust <$> getBy (UniqueSourceThemAcceptLocal localID)
+                            Right remoteID -> isJust <$> getBy (UniqueSourceThemAcceptRemote remoteID)
+                    (,accept) <$> bitraverse
+                        (\ (_, e) -> do
+                            jID <-
+                                case e of
+                                    Left j -> pure j
+                                    Right _ -> error "I'm a Project but my child is a Group"
+                            j <- getJust jID
+                            actor <- getJust $ projectActor j
+                            return (jID, actor)
+                        )
+                        (\ (_, actorID) -> getRemoteActorData actorID)
+                        topic
+                ((inviter, time), us) <- do
+                    usOrThem <-
+                        requireEitherAlt
+                            (getKeyBy $ UniqueSourceOriginUs sourceID)
+                            (getKeyBy $ UniqueSourceOriginThem sourceID)
+                            "Neither us nor them"
+                            "Both us and them"
+                    (addOrActor, us) <-
+                        case usOrThem of
+                            Left usID -> (,True) <$>
+                                requireEitherAlt
+                                    (fmap sourceUsGestureLocalAdd <$> getValBy (UniqueSourceUsGestureLocal usID))
+                                    (fmap (sourceUsGestureRemoteActor &&& sourceUsGestureRemoteAdd) <$> getValBy (UniqueSourceUsGestureRemote usID))
+                                    "Neither local not remote"
+                                    "Both local and remote"
+                            Right themID -> (,False) <$>
+                                requireEitherAlt
+                                    (fmap sourceThemGestureLocalAdd <$> getValBy (UniqueSourceThemGestureLocal themID))
+                                    (fmap (sourceThemGestureRemoteActor &&& sourceThemGestureRemoteAdd) <$> getValBy (UniqueSourceThemGestureRemote themID))
+                                    "Neither local not remote"
+                                    "Both local and remote"
+                    (,us) <$> case addOrActor of
+                        Left addID -> do
+                            OutboxItem outboxID _ time <- getJust addID
+                            Entity actorID actor <- getByJust $ UniqueActorOutbox outboxID
+                            (,time) . Left . (,actor) <$> getLocalActor actorID
+                        Right (actorID, addID) -> do
+                            RemoteActivity _ _ time <- getJust addID
+                            (,time) . Right <$> getRemoteActorData actorID
+                return (inviter, us, child, accept, time, role)
         $(widgetFile "project/children")
+        where
+        getRemoteActorData actorID = do
+            actor <- getJust actorID
+            object <- getJust $ remoteActorIdent actor
+            inztance <- getJust $ remoteObjectInstance object
+            return (inztance, object, actor)
 
 getProjectParentsR :: KeyHashid Project -> Handler TypedContent
 getProjectParentsR projectHash = do

templates/project/children.hamlet

@@ -1,6 +1,7 @@
 $# This file is part of Vervis.
 $#
-$# Written in 2016, 2019, 2022, 2023 by fr33domlover <fr33domlover@riseup.net>.
+$# Written in 2016, 2019, 2022, 2023, 2024
+$# by fr33domlover <fr33domlover@riseup.net>.
 $#
 $# ♡ Copying is an act of love. Please copy, reuse and share.
 $#
@@ -26,3 +27,30 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
       <td>#{show role}
       <td>#{showDate since}
       <td>^{projectLinkFedW child}
+
+<h2>Invites
+
+<table>
+  <tr>
+    <th>Inviter
+    <th>Via
+    <th>Invited child
+    <th>Child accepted?
+    <th>Role
+    <th>Time
+  $forall (inviter, us, child, accept, time, role) <- invites
+    <tr>
+      <td>^{actorLinkFedW inviter}
+      <td>
+        $if us
+          Us
+        $else
+          Them
+      <td>^{projectLinkFedW child}
+      <td>
+        $if accept
+          [x]
+        $else
+          [_]
+      <td>#{show role}
+      <td>#{showDate time}