Merge remote-tracking branch 'upstream/main'

migrations/565_2023-12-09_collab_permit.model

@@ -0,0 +1,300 @@
+Repo
+Deck
+Loom
+Project
+Group
+RemoteActor
+RemoteActivity
+Inbox
+FollowerSet
+
+Outbox
+
+OutboxItem
+    outbox    OutboxId
+    activity  PersistJSONObject
+    published UTCTime
+
+Actor
+    name      Text
+    desc      Text
+    createdAt UTCTime
+    inbox     InboxId
+    outbox    OutboxId
+    followers FollowerSetId
+    justCreatedBy ActorId Maybe
+
+    UniqueActorInbox     inbox
+    UniqueActorOutbox    outbox
+    UniqueActorFollowers followers
+
+Person
+    username            Username
+    login               Text
+    passphraseHash      ByteString
+    email               EmailAddress
+    verified            Bool
+    verifiedKey         Text
+    verifiedKeyCreated  UTCTime
+    resetPassKey        Text
+    resetPassKeyCreated UTCTime
+    actor               ActorId
+--  reviewFollow        Bool
+
+    UniquePersonUsername username
+    UniquePersonLogin    login
+    UniquePersonEmail    email
+    UniquePersonActor    actor
+
+Collab
+    role Role
+
+CollabFulfillsLocalTopicCreation
+    collab CollabId
+
+    UniqueCollabFulfillsLocalTopicCreation collab
+
+CollabFulfillsInvite
+    collab CollabId
+    accept OutboxItemId
+
+    UniqueCollabFulfillsInvite       collab
+    UniqueCollabFulfillsInviteAccept accept
+
+CollabInviterLocal
+    collab CollabFulfillsInviteId
+    invite OutboxItemId
+
+    UniqueCollabInviterLocal       collab
+    UniqueCollabInviterLocalInvite invite
+
+CollabInviterRemote
+    collab CollabFulfillsInviteId
+    actor  RemoteActorId
+    invite RemoteActivityId
+
+    UniqueCollabInviterRemote       collab
+    UniqueCollabInviterRemoteInvite invite
+
+CollabFulfillsJoin
+    collab CollabId
+
+    UniqueCollabFulfillsJoin collab
+
+CollabApproverLocal
+    collab CollabFulfillsJoinId
+    accept OutboxItemId
+
+    UniqueCollabApproverLocal       collab
+    UniqueCollabApproverLocalAccept accept
+
+CollabApproverRemote
+    collab CollabFulfillsJoinId
+    actor  RemoteActorId
+    accept RemoteActivityId
+
+    UniqueCollabApproverRemote       collab
+    UniqueCollabApproverRemoteAccept accept
+
+CollabRecipLocalJoin
+    collab   CollabRecipLocalId
+    fulfills CollabFulfillsJoinId
+    join     OutboxItemId
+
+    UniqueCollabRecipLocalJoinCollab   collab
+    UniqueCollabRecipLocalJoinFulfills fulfills
+    UniqueCollabRecipLocalJoinJoin     join
+
+CollabTopicRepo
+    collab CollabId
+    repo   RepoId
+
+    UniqueCollabTopicRepo collab
+
+CollabTopicDeck
+    collab CollabId
+    deck   DeckId
+
+    UniqueCollabTopicDeck collab
+
+CollabTopicLoom
+    collab CollabId
+    loom   LoomId
+
+    UniqueCollabTopicLoom collab
+
+CollabTopicProject
+    collab  CollabId
+    project ProjectId
+
+    UniqueCollabTopicProject collab
+
+CollabTopicGroup
+    collab CollabId
+    group  GroupId
+
+    UniqueCollabTopicGroup collab
+
+CollabRecipLocal
+    collab CollabId
+    person PersonId
+
+    UniqueCollabRecipLocal collab
+
+CollabRecipLocalAccept
+    collab CollabRecipLocalId
+    invite CollabFulfillsInviteId
+    accept OutboxItemId
+
+    UniqueCollabRecipLocalAcceptCollab collab
+    UniqueCollabRecipLocalAcceptInvite invite
+    UniqueCollabRecipLocalAcceptAccept accept
+
+CollabEnable
+    collab CollabId
+    grant  OutboxItemId
+
+    UniqueCollabEnable      collab
+    UniqueCollabEnableGrant grant
+
+CollabDelegLocal
+    enable CollabEnableId
+    recip  CollabRecipLocalId
+    grant  OutboxItemId
+
+    UniqueCollabDelegLocal      enable
+    UniqueCollabDelegLocalRecip recip
+    UniqueCollabDelegLocalGrant grant
+
+Permit
+    person PersonId
+    role   Role
+
+PermitTopicLocal
+    permit PermitId
+
+    UniquePermitTopicLocal permit
+
+PermitTopicRepo
+    permit PermitTopicLocalId
+    repo   RepoId
+
+    UniquePermitTopicRepo permit
+
+PermitTopicDeck
+    permit PermitTopicLocalId
+    deck   DeckId
+
+    UniquePermitTopicDeck permit
+
+PermitTopicLoom
+    permit PermitTopicLocalId
+    loom   LoomId
+
+    UniquePermitTopicLoom permit
+
+PermitTopicProject
+    permit  PermitTopicLocalId
+    project ProjectId
+
+    UniquePermitTopicProject permit
+
+PermitTopicGroup
+    permit PermitTopicLocalId
+    group  GroupId
+
+    UniquePermitTopicGroup permit
+
+PermitTopicRemote
+    permit PermitId
+    actor  RemoteActorId
+
+    UniquePermitTopicRemote permit
+
+PermitFulfillsTopicCreation
+    permit PermitId
+
+    UniquePermitFulfillsTopicCreation permit
+
+PermitFulfillsInvite
+    permit PermitId
+
+    UniquePermitFulfillsInvite permit
+
+PermitFulfillsJoin
+    permit PermitId
+
+    UniquePermitFulfillsJoin permit
+
+PermitPersonGesture
+    permit   PermitId
+    activity OutboxItemId
+
+    UniquePermitPersonGesture         permit
+    UniquePermitPersonGestureActivity activity
+
+PermitTopicGestureLocal
+    fulfills PermitFulfillsInviteId
+    invite   OutboxItemId
+
+    UniquePermitTopicGestureLocal       fulfills
+    UniquePermitTopicGestureLocalInvite invite
+
+PermitTopicGestureRemote
+    fulfills PermitFulfillsInviteId
+    actor    RemoteActorId
+    invite   RemoteActivityId
+
+    UniquePermitTopicGestureRemote       fulfills
+    UniquePermitTopicGestureRemoteInvite invite
+
+PermitTopicAcceptLocal
+    fulfills PermitFulfillsInviteId
+    topic    PermitTopicLocalId
+    accept   OutboxItemId
+
+    UniquePermitTopicAcceptLocal       fulfills
+    UniquePermitTopicAcceptLocalTopic  topic
+    UniquePermitTopicAcceptLocalAccept accept
+
+PermitTopicEnableLocal
+    permit PermitPersonGestureId
+    topic  PermitTopicLocalId
+    grant  OutboxItemId
+
+    UniquePermitTopicEnableLocal      permit
+    UniquePermitTopicEnableLocalTopic topic
+    UniquePermitTopicEnableLocalGrant grant
+
+PermitPersonSendDelegator
+    permit PermitPersonGestureId
+    grant  OutboxItemId
+
+    UniquePermitPersonSendDelegator      permit
+    UniquePermitPersonSendDelegatorGrant grant
+
+PermitTopicExtendLocal
+    permit PermitPersonSendDelegatorId
+    topic  PermitTopicEnableLocalId
+    grant  OutboxItemId
+
+    UniquePermitTopicExtendLocalGrant grant
+
+Component
+    project ProjectId
+    role    Role
+
+ComponentEnable
+    component ComponentId
+    grant     OutboxItemId
+
+    UniqueComponentEnable      component
+    UniqueComponentEnableGrant grant
+
+ComponentFurtherLocal
+    component ComponentEnableId
+    collab    CollabDelegLocalId
+    grant     OutboxItemId
+
+    UniqueComponentFurtherLocal      component collab
+    UniqueComponentFurtherLocalGrant grant

migrations/570_2023-12-09_source_dest.model

@@ -0,0 +1,359 @@
+------------------------------------------------------------------------------
+-- Inheritance - Receiver tracking her givers
+-- (Project tracking its children)
+-- (Team tracking its parents)
+------------------------------------------------------------------------------
+
+Source
+    role Role
+
+SourceHolderProject
+    source  SourceId
+    project ProjectId
+
+    UniqueSourceHolderProject source
+
+SourceHolderGroup
+    source SourceId
+    group  GroupId
+
+    UniqueSourceHolderGroup source
+
+-------------------------------- Source topic --------------------------------
+
+SourceTopicLocal
+    source SourceId
+
+    UniqueSourceTopicLocal source
+
+SourceTopicProject
+    holder SourceHolderProjectId
+    topic  SourceTopicLocalId
+    child  ProjectId
+
+    UniqueSourceTopicProject      holder
+    UniqueSourceTopicProjectTopic topic
+
+SourceTopicGroup
+    holder SourceHolderGroupId
+    topic  SourceTopicLocalId
+    parent GroupId
+
+    UniqueSourceTopicGroup      holder
+    UniqueSourceTopicGroupTopic topic
+
+SourceTopicRemote
+    source SourceId
+    topic  RemoteActorId
+
+    UniqueSourceTopicRemote source
+
+-------------------------------- Source flow ---------------------------------
+
+SourceOriginUs
+    source SourceId
+
+    UniqueSourceOriginUs source
+
+SourceOriginThem
+    source SourceId
+
+    UniqueSourceOriginThem source
+
+-- Our collaborator's gesture
+--
+-- OriginUs: The Add that started the sequence
+-- OriginThem: N/A (they send their Accept but we don't record it)
+
+SourceUsGestureLocal
+    us  SourceOriginUsId
+    add OutboxItemId
+
+    UniqueSourceUsGestureLocal    us
+    UniqueSourceUsGestureLocalAdd add
+
+SourceUsGestureRemote
+    us    SourceOriginUsId
+    actor RemoteActorId
+    add   RemoteActivityId
+
+    UniqueSourceUsGestureRemote    us
+    UniqueSourceUsGestureRemoteAdd add
+
+-- Our accept
+--
+-- OriginUs: I checked the Add and sending my Accept
+-- OriginThem: N/A
+
+SourceUsAccept
+    us    SourceOriginUsId
+    accept OutboxItemId
+
+    UniqueSourceUsAccept       us
+    UniqueSourceUsAcceptAccept accept
+
+-- Their collaborator's gesture
+--
+-- OriginUs: N/A (they send it but we don't record it)
+-- OriginThem: The Add that started the sequence
+
+SourceThemGestureLocal
+    them SourceOriginThemId
+    add  OutboxItemId
+
+    UniqueSourceThemGestureLocal    them
+    UniqueSourceThemGestureLocalAdd add
+
+SourceThemGestureRemote
+    them  SourceOriginThemId
+    actor RemoteActorId
+    add   RemoteActivityId
+
+    UniqueSourceThemGestureRemote    them
+    UniqueSourceThemGestureRemoteAdd add
+
+-- Their accept
+--
+-- OriginUs: Seeing our accept and their collaborator's accept, they send their
+--           own accept
+-- OriginThem: Checking the Add, they send their Accept
+
+SourceThemAcceptLocal
+    topic  SourceTopicLocalId
+    accept OutboxItemId
+
+    UniqueSourceThemAcceptLocal       topic
+    UniqueSourceThemAcceptLocalAccept accept
+
+SourceThemAcceptRemote
+    topic  SourceTopicRemoteId
+    accept RemoteActivityId
+
+    UniqueSourceThemAcceptRemote       topic
+    UniqueSourceThemAcceptRemoteAccept accept
+
+-------------------------------- Source enable -------------------------------
+
+-- Witnesses that, seeing their approval and our collaborator's gesture, I've
+-- sent then a delegator-Grant and now officially considering them a source of
+-- us
+SourceUsSendDelegator
+    source SourceId
+    grant  OutboxItemId
+
+    UniqueSourceUsSendDelegator      source
+    UniqueSourceUsSendDelegatorGrant grant
+
+-- Witnesses that, using the delegator-Grant, they sent us a start-Grant or
+-- extension-Grant to delegate further
+
+SourceThemDelegateLocal
+    source SourceThemAcceptLocalId
+    grant  OutboxItemId
+
+    UniqueSourceThemDelegateLocal      source
+    UniqueSourceThemDelegateLocalGrant grant
+
+SourceThemDelegateRemote
+    source SourceThemAcceptRemoteId
+    grant  RemoteActivityId
+
+    UniqueSourceThemDelegateRemote      source
+    UniqueSourceThemDelegateRemoteGrant grant
+
+-- Witnesses that, seeing the delegation from them, I've sent an
+-- extension-Grant to a Dest of mine
+
+SourceUsGatherLocal
+    deleg SourceUsSendDelegatorId
+    dest  DestThemSendDelegatorLocalId
+    grant OutboxItemId
+
+    UniqueSourceUsGatherLocal grant
+
+SourceUsGatherRemote
+    deleg SourceUsSendDelegatorId
+    dest  DestThemSendDelegatorRemoteId
+    grant RemoteActivityId
+
+    UniqueSourceUsGatherRemote grant
+
+-- Witnesses that, seeing the delegation from them, I've sent a leaf-Grant to a
+-- direct-collaborator of mine
+
+SourceUsLeafLocal
+    deleg  SourceUsSendDelegatorId
+    collab CollabDelegLocalId
+    grant  OutboxItemId
+
+    UniqueSourceUsLeafLocal grant
+
+SourceUsLeafRemote
+    deleg  SourceUsSendDelegatorId
+    collab CollabDelegRemoteId
+    grant  RemoteActivityId
+
+    UniqueSourceUsLeafRemote grant
+
+------------------------------------------------------------------------------
+-- Inheritance - Giver tracking her receivers
+-- (Project tracking its parents)
+-- (Team tracking its children)
+------------------------------------------------------------------------------
+
+Dest
+    role Role
+
+DestHolderProject
+    dest    DestId
+    project ProjectId
+
+    UniqueDestHolderProject dest
+
+DestHolderGroup
+    dest  DestId
+    group GroupId
+
+    UniqueDestHolderGroup dest
+
+---------------------------------- Dest topic --------------------------------
+
+DestTopicLocal
+    dest DestId
+
+    UniqueDestTopicLocal dest
+
+DestTopicProject
+    holder DestHolderProjectId
+    topic  DestTopicLocalId
+    parent ProjectId
+
+    UniqueDestTopicProject      holder
+    UniqueDestTopicProjectTopic topic
+
+DestTopicGroup
+    holder DestHolderGroupId
+    topic  DestTopicLocalId
+    child  GroupId
+
+    UniqueDestTopicGroup      holder
+    UniqueDestTopicGroupTopic topic
+
+DestTopicRemote
+    dest  DestId
+    topic RemoteActorId
+
+    UniqueDestTopicRemote dest
+
+---------------------------------- Dest flow ---------------------------------
+
+DestOriginUs
+    dest DestId
+
+    UniqueDestOriginUs dest
+
+DestOriginThem
+    dest DestId
+
+    UniqueDestOriginThem dest
+
+-- Our collaborator's gesture
+--
+-- OriginUs: The Add that started the sequence
+-- OriginThem: Seeing the Add and their Accept, my collaborator has sent her
+--             Accept
+
+DestUsGestureLocal
+    dest     DestId
+    activity OutboxItemId
+
+    UniqueDestUsGestureLocal         dest
+    UniqueDestUsGestureLocalActivity activity
+
+DestUsGestureRemote
+    dest     DestId
+    actor    RemoteActorId
+    activity RemoteActivityId
+
+    UniqueDestUsGestureRemote         dest
+    UniqueDestUsGestureRemoteActivity activity
+
+-- Our accept
+--
+-- OriginUs: Checking my collaborator's Add, I sent my Accept
+-- OriginThem: Seeing the Add, their Accept and my collaborator's Accept, I
+--             sent my Accept
+
+DestUsAccept
+    dest DestId
+    accept OutboxItemId
+
+    UniqueDestUsAccept       dest
+    UniqueDestUsAcceptAccept accept
+
+-- Their collaborator's gesture
+--
+-- OriginUs: N/A (they send it but we don't record it)
+-- OriginThem: The Add that started the sequence
+
+DestThemGestureLocal
+    them DestOriginThemId
+    add  OutboxItemId
+
+    UniqueDestThemGestureLocal    them
+    UniqueDestThemGestureLocalAdd add
+
+DestThemGestureRemote
+    them  DestOriginThemId
+    actor RemoteActorId
+    add   RemoteActivityId
+
+    UniqueDestThemGestureRemote    them
+    UniqueDestThemGestureRemoteAdd add
+
+-- Their accept
+--
+-- OriginUs: N/A
+-- OriginThem: Seeing their collaborator's Add, they sent an Accept
+
+DestThemAcceptLocal
+    them   DestOriginThemId
+    topic  DestTopicLocalId
+    accept OutboxItemId
+
+    UniqueDestThemAcceptLocal       them
+    UniqueDestThemAcceptLocalTopic  topic
+    UniqueDestThemAcceptLocalAccept accept
+
+DestThemAcceptRemote
+    them   DestOriginThemId
+    topic  DestTopicRemoteId
+    accept RemoteActivityId
+
+    UniqueDestThemAcceptRemote       them
+    UniqueDestThemAcceptRemoteTopic  topic
+    UniqueDestThemAcceptRemoteAccept accept
+
+---------------------------------- Dest enable -------------------------------
+
+-- Witnesses that, seeing our approval and their collaborator's gesture,
+-- they've sent us a delegator-Grant, and we now officially consider them a
+-- dest of us
+
+DestThemSendDelegatorLocal
+    dest  DestUsAcceptId
+    topic DestTopicLocalId
+    grant OutboxItemId
+
+    UniqueDestThemSendDelegatorLocal      dest
+    UniqueDestThemSendDelegatorLocalTopic topic
+    UniqueDestThemSendDelegatorLocalGrant grant
+
+DestThemSendDelegatorRemote
+    dest  DestUsAcceptId
+    topic DestTopicRemoteId
+    grant RemoteActivityId
+
+    UniqueDestThemSendDelegatorRemote      dest
+    UniqueDestThemSendDelegatorRemoteTopic topic
+    UniqueDestThemSendDelegatorRemoteGrant grant

src/Vervis/Actor.hs

@@ -80,6 +80,8 @@ module Vervis.Actor
     , sendToLocalActors
 
     , actorIsAddressed
+
+    , localActorType
     )
 where
 
@@ -714,3 +716,12 @@ actorIsAddressed recips = isJust . verify
     verify (LocalActorProject j) = do
         routes <- lookup j $ recipProjects recips
         guard $ routeProject routes
+
+localActorType :: LocalActorBy f -> AP.ActorType
+localActorType = \case
+    LocalActorPerson _ -> AP.ActorTypePerson
+    LocalActorRepo _ -> AP.ActorTypeRepo
+    LocalActorDeck _ -> AP.ActorTypeTicketTracker
+    LocalActorLoom _ -> AP.ActorTypePatchTracker
+    LocalActorProject _ -> AP.ActorTypeProject
+    LocalActorGroup _ -> AP.ActorTypeTeam

src/Vervis/Actor/Common.hs

@@ -1379,6 +1379,8 @@ topicRemove grabActor topicResource topicField topicCollabField now topicKey (Ve
         lift $ for maybeRemoveDB $ \ _removeDB -> do
 
             -- Delete the whole Collab record
+            deleteBy $ UniqueCollabDelegLocal enableID
+            deleteBy $ UniqueCollabDelegRemote enableID
             delete enableID
             case recipID of
                 Left (E.Value l) -> do
@@ -1853,8 +1855,7 @@ componentGrant grabActor topicComponent now recipKey (Verse authorIdMsig body) g
             (Right u, Right (ra, _, _)) | remoteAuthorURI ra == u -> pure ()
             _ -> throwE "Author and resource aren't the same project actor"
         case recipient of
-            Left (GrantRecipComponent' c)
+            Left la | topicResource recipKey == la -> pure ()
-                | topicComponent recipKey == c -> pure ()
             _ -> throwE "Grant recipient isn't me"
         for_ mstart $ \ start ->
             unless (start < now) $ throwE "Start time is in the future"

src/Vervis/Actor/Group.hs

@@ -78,6 +78,292 @@ import Vervis.Persist.Collab
 import Vervis.Persist.Discussion
 import Vervis.Ticket
 
+-- Meaning: An actor accepted something
+-- Behavior:
+--     * Check if I know the activity that's being Accepted:
+--         * Is it an Invite to be a collaborator in me?
+--             * Verify the Accept is by the Invite target
+--         * Is it a Join to be a collaborator in me?
+--             * Verify the Accept is authorized
+--         * If it's none of these, respond with error
+--
+--     * Verify the Collab isn't enabled yet
+--
+--     * Insert the Accept to my inbox
+--
+--     * Record the Accept and enable the Collab in DB
+--
+--     * Forward the Accept to my followers
+--
+--     * Possibly send a Grant:
+--         * For Invite-collab mode:
+--             * Regular collaborator-Grant
+--             * To: Accepter (i.e. Invite target)
+--             * CC: Invite sender, Accepter's followers, my followers
+--         * For Join-as-collab mode:
+--             * Regular collaborator-Grant
+--             * To: Join sender
+--             * CC: Accept sender, Join sender's followers, my followers
+groupAccept
+    :: UTCTime
+    -> GroupId
+    -> Verse
+    -> AP.Accept URIMode
+    -> ActE (Text, Act (), Next)
+groupAccept now groupID (Verse authorIdMsig body) accept = do
+
+    -- Check input
+    acceptee <- parseAccept accept
+
+    -- Verify that the capability URI, if specified, is one of:
+    --   * Outbox item URI of a local actor, i.e. a local activity
+    --   * A remote URI
+    maybeCap <-
+        traverse
+            (nameExceptT "Accept capability" . parseActivityURI')
+            (AP.activityCapability $ actbActivity body)
+
+    maybeNew <- withDBExcept $ do
+
+        -- Grab me from DB
+        (recipActorID, recipActor) <- lift $ do
+            recip <- getJust groupID
+            let actorID = groupActor recip
+            (actorID,) <$> getJust actorID
+
+        -- Find the accepted activity in our DB
+        accepteeDB <- do
+            a <- getActivity acceptee
+            fromMaybeE a "Can't find acceptee in DB"
+
+        -- See if the accepted activity is an Invite or Join where my collabs
+        -- URI is the resource, grabbing the Collab record from our DB,
+        (collabID, fulfills, inviterOrJoiner) <- do
+            let adapt = maybe (Right Nothing) (either Left (Right . Just))
+            maybeCollab <-
+                ExceptT $ fmap adapt $ runMaybeT $
+                    runExceptT (tryInviteCollab accepteeDB) <|>
+                    runExceptT (tryJoinCollab accepteeDB)
+            fromMaybeE
+                maybeCollab
+                "Accepted activity isn't an Invite/Join I'm aware of"
+
+        collab <- bitraverse
+
+            -- If accepting an Invite, find the Collab recipient and verify
+            -- it's the sender of the Accept
+            (\ fulfillsID -> do
+                recip <-
+                    lift $
+                    requireEitherAlt
+                        (getBy $ UniqueCollabRecipLocal collabID)
+                        (getBy $ UniqueCollabRecipRemote collabID)
+                        "Found Collab with no recip"
+                        "Found Collab with multiple recips"
+                case (recip, authorIdMsig) of
+                    (Left (Entity crlid crl), Left (LocalActorPerson personID, _, _))
+                        | collabRecipLocalPerson crl == personID ->
+                            return (fulfillsID, Left crlid)
+                    (Right (Entity crrid crr), Right (author, _, _))
+                        | collabRecipRemoteActor crr == remoteAuthorId author ->
+                            return (fulfillsID, Right crrid)
+                    _ -> throwE "Accepting an Invite whose recipient is someone else"
+            )
+
+            -- If accepting a Join, verify accepter has permission
+            (\ fulfillsID -> do
+                capID <- fromMaybeE maybeCap "No capability provided"
+                capability <-
+                    case capID of
+                        Left (capActor, _, capItem) -> return (capActor, capItem)
+                        Right _ -> throwE "Capability is a remote URI, i.e. not authored by the local resource"
+                verifyCapability'
+                    capability
+                    authorIdMsig
+                    (LocalActorGroup groupID)
+                    AP.RoleAdmin
+                return fulfillsID
+            )
+
+            fulfills
+
+        -- In collab mode, verify the Collab isn't already validated
+        maybeEnabled <- lift $ getBy $ UniqueCollabEnable collabID
+        verifyNothingE maybeEnabled "I already sent a Grant for this Invite/Join"
+
+        maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
+        for maybeAcceptDB $ \ acceptDB -> do
+
+            (grantID, enableID) <- do
+
+                -- In collab mode, record the Accept and enable the Collab
+                case (collab, acceptDB) of
+                    (Left (fulfillsID, Left recipID), Left (_, _, acceptID)) -> do
+                        maybeAccept <- lift $ insertUnique $ CollabRecipLocalAccept recipID fulfillsID acceptID
+                        unless (isNothing maybeAccept) $
+                            throwE "This Invite already has an Accept by recip"
+                    (Left (fulfillsID, Right recipID), Right (_, _, acceptID)) -> do
+                        maybeAccept <- lift $ insertUnique $ CollabRecipRemoteAccept recipID fulfillsID acceptID
+                        unless (isJust maybeAccept) $
+                            throwE "This Invite already has an Accept by recip"
+                    (Right fulfillsID, Left (_, _, acceptID)) -> do
+                        maybeAccept <- lift $ insertUnique $ CollabApproverLocal fulfillsID acceptID
+                        unless (isJust maybeAccept) $
+                            throwE "This Join already has an Accept"
+                    (Right fulfillsID, Right (author, _, acceptID)) -> do
+                        maybeAccept <- lift $ insertUnique $ CollabApproverRemote fulfillsID (remoteAuthorId author) acceptID
+                        unless (isJust maybeAccept) $
+                            throwE "This Join already has an Accept"
+                    _ -> error "groupAccept impossible"
+                grantID <- lift $ insertEmptyOutboxItem' (actorOutbox recipActor) now
+                enableID <- lift $ insert $ CollabEnable collabID grantID
+                return (grantID, enableID)
+
+            -- Prepare forwarding of Accept to my followers
+            let recipByID = LocalActorGroup groupID
+            recipByHash <- hashLocalActor recipByID
+            let sieve = makeRecipientSet [] [localActorFollowers recipByHash]
+
+            maybeGrant <- lift $ do
+
+                    -- In collab mode, prepare a regular Grant
+                    let isInvite = isLeft collab
+                    grant@(actionGrant, _, _, _) <- do
+                        Collab role <- getJust collabID
+                        prepareCollabGrant isInvite inviterOrJoiner role
+                    let recipByKey = LocalActorGroup groupID
+                    _luGrant <- updateOutboxItem' recipByKey grantID actionGrant
+                    return $ Just (grantID, grant)
+
+            return (recipActorID, sieve, maybeGrant)
+
+    case maybeNew of
+        Nothing -> done "I already have this activity in my inbox"
+        Just (recipActorID, sieve, maybeGrant) -> do
+            let recipByID = LocalActorGroup groupID
+            forwardActivity authorIdMsig body recipByID recipActorID sieve
+            lift $ for_ maybeGrant $ \ (grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant)) ->
+                sendActivity
+                    recipByID recipActorID localRecipsGrant
+                    remoteRecipsGrant fwdHostsGrant grantID actionGrant
+            done "Forwarded the Accept and maybe published a Grant"
+
+    where
+
+    verifyCollabTopic collabID = do
+        topic <- lift $ getCollabTopic collabID
+        unless (LocalActorGroup groupID == topic) $
+            throwE "Accept object is an Invite/Join for some other resource"
+
+    verifyInviteCollabTopic fulfillsID = do
+        collabID <- lift $ collabFulfillsInviteCollab <$> getJust fulfillsID
+        verifyCollabTopic collabID
+        return collabID
+
+    verifyJoinCollabTopic fulfillsID = do
+        collabID <- lift $ collabFulfillsJoinCollab <$> getJust fulfillsID
+        verifyCollabTopic collabID
+        return collabID
+
+    tryInviteCollab (Left (actorByKey, _actorEntity, itemID)) = do
+        fulfillsID <-
+            lift $ collabInviterLocalCollab <$>
+                MaybeT (getValBy $ UniqueCollabInviterLocalInvite itemID)
+        collabID <-
+            ExceptT $ lift $ runExceptT $ verifyInviteCollabTopic fulfillsID
+        return (collabID, Left fulfillsID, Left actorByKey)
+    tryInviteCollab (Right remoteActivityID) = do
+        CollabInviterRemote fulfillsID actorID _ <-
+            lift $ MaybeT $ getValBy $
+                UniqueCollabInviterRemoteInvite remoteActivityID
+        collabID <-
+            ExceptT $ lift $ runExceptT $ verifyInviteCollabTopic fulfillsID
+        sender <- lift $ lift $ do
+            actor <- getJust actorID
+            (,remoteActorFollowers actor) <$> getRemoteActorURI actor
+        return (collabID, Left fulfillsID, Right sender)
+
+    tryJoinCollab (Left (actorByKey, _actorEntity, itemID)) = do
+        fulfillsID <-
+            lift $ collabRecipLocalJoinFulfills <$>
+                MaybeT (getValBy $ UniqueCollabRecipLocalJoinJoin itemID)
+        collabID <-
+            ExceptT $ lift $ runExceptT $ verifyJoinCollabTopic fulfillsID
+        return (collabID, Right fulfillsID, Left actorByKey)
+    tryJoinCollab (Right remoteActivityID) = do
+        CollabRecipRemoteJoin recipID fulfillsID _ <-
+            lift $ MaybeT $ getValBy $
+                UniqueCollabRecipRemoteJoinJoin remoteActivityID
+        collabID <-
+            ExceptT $ lift $ runExceptT $ verifyJoinCollabTopic fulfillsID
+        joiner <- lift $ lift $ do
+            remoteActorID <- collabRecipRemoteActor <$> getJust recipID
+            actor <- getJust remoteActorID
+            (,remoteActorFollowers actor) <$> getRemoteActorURI actor
+        return (collabID, Right fulfillsID, Right joiner)
+
+    prepareCollabGrant isInvite sender role = do
+        encodeRouteHome <- getEncodeRouteHome
+        encodeRouteLocal <- getEncodeRouteLocal
+
+        audAccepter <- makeAudSenderWithFollowers authorIdMsig
+        audApprover <- lift $ makeAudSenderOnly authorIdMsig
+        recipHash <- encodeKeyHashid groupID
+        let topicByHash = LocalActorGroup recipHash
+
+        senderHash <- bitraverse hashLocalActor pure sender
+
+        uAccepter <- lift $ getActorURI authorIdMsig
+
+        let audience =
+                if isInvite
+                    then
+                        let audInviter =
+                                case senderHash of
+                                    Left actor -> AudLocal [actor] []
+                                    Right (ObjURI h lu, _followers) ->
+                                        AudRemote h [lu] []
+                            audTopic = AudLocal [] [localActorFollowers topicByHash]
+                        in  [audInviter, audAccepter, audTopic]
+                    else
+                        let audJoiner =
+                                case senderHash of
+                                    Left actor -> AudLocal [actor] [localActorFollowers actor]
+                                    Right (ObjURI h lu, followers) ->
+                                        AudRemote h [lu] (maybeToList followers)
+                            audTopic = AudLocal [] [localActorFollowers topicByHash]
+                        in  [audJoiner, audApprover, audTopic]
+
+            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
+                collectAudience audience
+
+            recips = map encodeRouteHome audLocal ++ audRemote
+            action = AP.Action
+                { AP.actionCapability = Nothing
+                , AP.actionSummary    = Nothing
+                , AP.actionAudience   = AP.Audience recips [] [] [] [] []
+                , AP.actionFulfills   = [AP.acceptObject accept]
+                , AP.actionSpecific   = AP.GrantActivity AP.Grant
+                    { AP.grantObject    = AP.RXRole role
+                    , AP.grantContext   =
+                        encodeRouteHome $ renderLocalActor topicByHash
+                    , AP.grantTarget    =
+                        if isInvite
+                            then uAccepter
+                            else case senderHash of
+                                Left actor ->
+                                    encodeRouteHome $ renderLocalActor actor
+                                Right (ObjURI h lu, _) -> ObjURI h lu
+                    , AP.grantResult    = Nothing
+                    , AP.grantStart     = Just now
+                    , AP.grantEnd       = Nothing
+                    , AP.grantAllows    = AP.Invoke
+                    , AP.grantDelegates = Nothing
+                    }
+                }
+
+        return (action, recipientSet, remoteActors, fwdHosts)
+
 -- Meaning: Someone has created a group with my ID URI
 -- Behavior:
 --     * Verify I'm in a just-been-created state
@@ -143,6 +429,426 @@ groupFollow now recipGroupID verse follow = do
         (\ _ -> pure [])
         now recipGroupID verse follow
 
+-- Meaning: An actor is granting access-to-some-resource to another actor
+-- Behavior:
+--      * Option 1 - Collaborator sending me a delegator-Grant - Verify that:
+--          * The sender is a collaborator of mine, A
+--          * The Grant's context is A
+--          * The Grant's target is me
+--          * The Grant's usage is invoke & role is delegate
+--          * The Grant doesn't specify 'delegates'
+--          * The activity is authorized via a valid direct-Grant I had sent
+--            to A
+--      * Verify I don't yet have a delegator-Grant from A
+--      * Insert the Grant to my inbox
+--      * Record the delegator-Grant in the Collab record in DB
+--      * Forward the Grant to my followers
+--
+--      * If not 1, raise an error
+groupGrant
+    :: UTCTime
+    -> GroupId
+    -> Verse
+    -> AP.Grant URIMode
+    -> ActE (Text, Act (), Next)
+groupGrant now groupID (Verse authorIdMsig body) grant = do
+
+    -- Check capability
+    capability <- do
+
+        -- Verify that a capability is provided
+        uCap <- do
+            let muCap = AP.activityCapability $ actbActivity body
+            fromMaybeE muCap "No capability provided"
+
+        -- Verify the capability URI is one of:
+        --   * Outbox item URI of a local actor, i.e. a local activity
+        --   * A remote URI
+        cap <- nameExceptT "Invite capability" $ parseActivityURI' uCap
+
+        -- Verify the capability is local
+        case cap of
+            Left (actorByKey, _, outboxItemID) ->
+                return (actorByKey, outboxItemID)
+            _ -> throwE "Capability is remote i.e. definitely not by me"
+
+    -- Check grant
+    collab <- checkDelegator grant
+
+    handleCollab capability collab
+
+    where
+
+    checkDelegator g = do
+        (role, resource, recipient, _mresult, mstart, mend, usage, mdeleg) <-
+            parseGrant' g
+        case role of
+            AP.RXRole _ -> throwE "Role isn't delegator"
+            AP.RXDelegator -> pure ()
+        collab <-
+            bitraverse
+                (\case
+                    LocalActorPerson p -> pure p
+                    _ -> throwE "Local resource isn't a Person, therefore not a collaborator of mine"
+                )
+                pure
+                resource
+        case (collab, authorIdMsig) of
+            (Left c, Left (a, _, _)) | LocalActorPerson c == a -> pure ()
+            (Right u, Right (ra, _, _)) | remoteAuthorURI ra == u -> pure ()
+            _ -> throwE "Author and context aren't the same actor"
+        case recipient of
+            Left (LocalActorGroup g) | g == groupID -> pure ()
+            _ -> throwE "Target isn't me"
+        for_ mstart $ \ start ->
+            unless (start < now) $ throwE "Start time is in the future"
+        for_ mend $ \ _ ->
+            throwE "End time is specified"
+        unless (usage == AP.Invoke) $
+            throwE "Usage isn't Invoke"
+        for_ mdeleg $ \ _ ->
+            throwE "'delegates' is specified"
+        return collab
+
+    handleCollab capability collab = do
+
+        maybeNew <- withDBExcept $ do
+
+            -- Grab me from DB
+            (recipActorID, recipActor) <- lift $ do
+                recip <- getJust groupID
+                let actorID = groupActor recip
+                (actorID,) <$> getJust actorID
+
+            -- Find the Collab record from the capability
+            Entity enableID (CollabEnable collabID _) <- do
+                unless (fst capability == LocalActorGroup groupID) $
+                    throwE "Capability isn't mine"
+                m <- lift $ getBy $ UniqueCollabEnableGrant $ snd capability
+                fromMaybeE m "I don't have a Collab with this capability"
+            Collab role <- lift $ getJust collabID
+            topic <- lift $ getCollabTopic collabID
+            unless (topic == LocalActorGroup groupID) $
+                throwE "Found a Collab for this direct-Grant but it's not mine"
+            recip <- lift $ getCollabRecip collabID
+            recipForCheck <-
+                lift $
+                bitraverse
+                    (pure . collabRecipLocalPerson . entityVal)
+                    (getRemoteActorURI <=< getJust . collabRecipRemoteActor . entityVal)
+                    recip
+            unless (recipForCheck == collab) $
+                throwE "Capability's collaborator and Grant author aren't the same actor"
+
+            -- Verify I don't yet have a delegator-Grant from the collaborator
+            maybeDeleg <-
+                lift $ case bimap entityKey entityKey recip of
+                    Left localID -> (() <$) <$> getBy (UniqueCollabDelegLocalRecip localID)
+                    Right remoteID -> (() <$) <$> getBy (UniqueCollabDelegRemoteRecip remoteID)
+            verifyNothingE maybeDeleg "I already have a delegator-Grant from this collaborator"
+
+            maybeGrantDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
+            for maybeGrantDB $ \ grantDB -> do
+
+                -- Record the delegator-Grant in the Collab record
+                lift $ case (grantDB, bimap entityKey entityKey recip) of
+                    (Left (grantActor, _, grantID), Left localID) ->
+                        insert_ $ CollabDelegLocal enableID localID grantID
+                    (Right (_, _, grantID), Right remoteID) ->
+                        insert_ $ CollabDelegRemote enableID remoteID grantID
+                    _ -> error "groupGrant impossible 2"
+
+                -- Prepare forwarding of Accept to my followers
+                groupHash <- encodeKeyHashid groupID
+                let sieve = makeRecipientSet [] [LocalStageGroupFollowers groupHash]
+
+                -- For each parent group of mine, prepare a
+                -- delegation-extension Grant
+                extensions <- lift $ pure []
+
+                return (recipActorID, sieve, extensions)
+
+        case maybeNew of
+            Nothing -> done "I already have this activity in my inbox"
+            Just (recipActorID, sieve, extensions) -> do
+                let recipByID = LocalActorGroup groupID
+                forwardActivity authorIdMsig body recipByID recipActorID sieve
+                lift $ for_ extensions $
+                    \ (extID, (actionExt, localRecipsExt, remoteRecipsExt, fwdHostsExt)) ->
+                        sendActivity
+                            recipByID recipActorID localRecipsExt
+                            remoteRecipsExt fwdHostsExt extID actionExt
+                done "Forwarded the delegator-Grant, updated DB"
+
+-- Meaning: An actor A invited actor B to a resource
+-- Behavior:
+--      * Verify the resource is my collabs list
+--      * If resource is collabs and B is local, verify it's a Person
+--      * Verify A isn't inviting themselves
+--      * Verify A is authorized by me to invite collabs to me
+--
+--      * Verify B doesn't already have an invite/join/grant for me
+--
+--      * Insert the Invite to my inbox
+--
+--      * Insert a Collab record to DB
+--
+--      * Forward the Invite to my followers
+--      * Send Accept to A, B, my-followers
+groupInvite
+    :: UTCTime
+    -> GroupId
+    -> Verse
+    -> AP.Invite URIMode
+    -> ActE (Text, Act (), Next)
+groupInvite now groupID (Verse authorIdMsig body) invite = do
+
+    -- Check capability
+    capability <- do
+
+        -- Verify that a capability is provided
+        uCap <- do
+            let muCap = AP.activityCapability $ actbActivity body
+            fromMaybeE muCap "No capability provided"
+
+        -- Verify the capability URI is one of:
+        --   * Outbox item URI of a local actor, i.e. a local activity
+        --   * A remote URI
+        cap <- nameExceptT "Invite capability" $ parseActivityURI' uCap
+
+        -- Verify the capability is local
+        case cap of
+            Left (actorByKey, _, outboxItemID) ->
+                return (actorByKey, outboxItemID)
+            _ -> throwE "Capability is remote i.e. definitely not by me"
+
+    -- Check invite
+    (role, invited) <- do
+        let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig
+        (role, resourceOrComps, recipientOrComp) <- parseInvite author invite
+        mode <-
+            case resourceOrComps of
+                Left (Left (LocalActorGroup j)) | j == groupID ->
+                    bitraverse
+                        (\case
+                            Left r -> pure r
+                            Right _ -> throwE "Not accepting local component actors as collabs"
+                        )
+                        pure
+                        recipientOrComp
+                _ -> throwE "Invite topic isn't my collabs URI"
+        return (role, mode)
+
+    -- If target is local, find it in our DB
+    -- If target is remote, HTTP GET it, verify it's an actor, and store in
+    -- our DB (if it's already there, no need for HTTP)
+    --
+    -- NOTE: This is a blocking HTTP GET done right here in the Invite handler,
+    -- which is NOT a good idea. Ideally, it would be done async, and the
+    -- handler result (approve/disapprove the Invite) would be sent later in a
+    -- separate (e.g. Accept) activity. But for the PoC level, the current
+    -- situation will hopefully do.
+    invitedDB <-
+        bitraverse
+            (withDBExcept . flip getGrantRecip "Invitee not found in DB")
+            getRemoteActorFromURI
+            invited
+
+    maybeNew <- withDBExcept $ do
+
+        -- Grab me from DB
+        (topicActorID, topicActor) <- lift $ do
+            recip <- getJust groupID
+            let actorID = groupActor recip
+            (actorID,) <$> getJust actorID
+
+        -- Verify the specified capability gives relevant access
+        verifyCapability'
+            capability authorIdMsig (LocalActorGroup groupID) AP.RoleAdmin
+
+        -- Verify that target doesn't already have a Collab for me
+        existingCollabIDs <- lift $ getExistingCollabs invitedDB
+        case existingCollabIDs of
+            [] -> pure ()
+            [_] -> throwE "I already have a Collab for the target"
+            _ -> error "Multiple collabs found for target"
+
+        maybeInviteDB <- lift $ insertToInbox now authorIdMsig body (actorInbox topicActor) False
+        lift $ for maybeInviteDB $ \ inviteDB -> do
+
+            -- Insert Collab or Component record to DB
+            acceptID <- insertEmptyOutboxItem' (actorOutbox topicActor) now
+            insertCollab role invitedDB inviteDB acceptID
+
+            -- Prepare forwarding Invite to my followers
+            sieve <- do
+                groupHash <- encodeKeyHashid groupID
+                return $ makeRecipientSet [] [LocalStageGroupFollowers groupHash]
+
+            -- Prepare an Accept activity and insert to my outbox
+            accept@(actionAccept, _, _, _) <- prepareAccept invitedDB
+            _luAccept <- updateOutboxItem' (LocalActorGroup groupID) acceptID actionAccept
+
+            return (topicActorID, sieve, acceptID, accept)
+
+    case maybeNew of
+        Nothing -> done "I already have this activity in my inbox"
+        Just (groupActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
+            forwardActivity
+                authorIdMsig body (LocalActorGroup groupID) groupActorID sieve
+            lift $ sendActivity
+                (LocalActorGroup groupID) groupActorID localRecipsAccept
+                remoteRecipsAccept fwdHostsAccept acceptID actionAccept
+            done "Recorded and forwarded the Invite, sent an Accept"
+
+    where
+
+    getRemoteActorFromURI (ObjURI h lu) = do
+        instanceID <-
+            lift $ withDB $ either entityKey id <$> insertBy' (Instance h)
+        result <-
+            ExceptT $ first (T.pack . displayException) <$>
+                fetchRemoteActor' instanceID h lu
+        case result of
+            Left Nothing -> throwE "Target @id mismatch"
+            Left (Just err) -> throwE $ T.pack $ displayException err
+            Right Nothing -> throwE "Target isn't an actor"
+            Right (Just actor) -> return $ entityKey actor
+
+    getExistingCollabs (Left (GrantRecipPerson (Entity personID _))) =
+        E.select $ E.from $ \ (topic `E.InnerJoin` recipl) -> do
+            E.on $
+                topic E.^. CollabTopicGroupCollab E.==.
+                recipl E.^. CollabRecipLocalCollab
+            E.where_ $
+                topic E.^. CollabTopicGroupGroup E.==. E.val groupID E.&&.
+                recipl E.^. CollabRecipLocalPerson E.==. E.val personID
+            return $ recipl E.^. CollabRecipLocalCollab
+    getExistingCollabs (Right remoteActorID) =
+        E.select $ E.from $ \ (topic `E.InnerJoin` recipr) -> do
+            E.on $
+                topic E.^. CollabTopicGroupCollab E.==.
+                recipr E.^. CollabRecipRemoteCollab
+            E.where_ $
+                topic E.^. CollabTopicGroupGroup E.==. E.val groupID E.&&.
+                recipr E.^. CollabRecipRemoteActor E.==. E.val remoteActorID
+            return $ recipr E.^. CollabRecipRemoteCollab
+
+    insertCollab role recipient inviteDB acceptID = do
+        collabID <- insert $ Collab role
+        fulfillsID <- insert $ CollabFulfillsInvite collabID acceptID
+        insert_ $ CollabTopicGroup collabID groupID
+        case inviteDB of
+            Left (_, _, inviteID) ->
+                insert_ $ CollabInviterLocal fulfillsID inviteID
+            Right (author, _, inviteID) -> do
+                let authorID = remoteAuthorId author
+                insert_ $ CollabInviterRemote fulfillsID authorID inviteID
+        case recipient of
+            Left (GrantRecipPerson (Entity personID _)) ->
+                insert_ $ CollabRecipLocal collabID personID
+            Right remoteActorID ->
+                insert_ $ CollabRecipRemote collabID remoteActorID
+
+    prepareAccept invitedDB = do
+        encodeRouteHome <- getEncodeRouteHome
+
+        audInviter <- lift $ makeAudSenderOnly authorIdMsig
+        audInvited <-
+            case invitedDB of
+                Left (GrantRecipPerson (Entity p _)) -> do
+                    ph <- encodeKeyHashid p
+                    return $ AudLocal [LocalActorPerson ph] []
+                Right remoteActorID -> do
+                    ra <- getJust remoteActorID
+                    ObjURI h lu <- getRemoteActorURI ra
+                    return $ AudRemote h [lu] []
+        audTopic <-
+            AudLocal [] . pure . LocalStageGroupFollowers <$>
+                encodeKeyHashid groupID
+        uInvite <- lift $ getActivityURI authorIdMsig
+
+        let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
+                collectAudience [audInviter, audInvited, audTopic]
+
+            recips = map encodeRouteHome audLocal ++ audRemote
+            action = AP.Action
+                { AP.actionCapability = Nothing
+                , AP.actionSummary    = Nothing
+                , AP.actionAudience   = AP.Audience recips [] [] [] [] []
+                , AP.actionFulfills   = [uInvite]
+                , AP.actionSpecific   = AP.AcceptActivity AP.Accept
+                    { AP.acceptObject   = uInvite
+                    , AP.acceptResult   = Nothing
+                    }
+                }
+
+        return (action, recipientSet, remoteActors, fwdHosts)
+
+-- Meaning: An actor A asked to join a resource
+-- Behavior:
+--      * Verify the resource is me
+--      * Verify A doesn't already have an invite/join/grant for me
+--      * Remember the join in DB
+--      * Forward the Join to my followers
+groupJoin
+    :: UTCTime
+    -> GroupId
+    -> Verse
+    -> AP.Join URIMode
+    -> ActE (Text, Act (), Next)
+groupJoin =
+    topicJoin
+        groupActor LocalActorGroup
+        CollabTopicGroupGroup CollabTopicGroupCollab CollabTopicGroup
+
+-- Meaning: An actor rejected something
+-- Behavior:
+--     * If it's on an Invite where I'm the resource:
+--         * Verify the Reject is by the Invite target
+--         * Remove the relevant Collab record from DB
+--         * Forward the Reject to my followers
+--         * Send a Reject on the Invite:
+--             * To: Rejecter (i.e. Invite target)
+--             * CC: Invite sender, Rejecter's followers, my followers
+--     * If it's on a Join where I'm the resource:
+--         * Verify the Reject is authorized
+--         * Remove the relevant Collab record from DB
+--         * Forward the Reject to my followers
+--         * Send a Reject:
+--             * To: Join sender
+--             * CC: Reject sender, Join sender's followers, my followers
+--     * Otherwise respond with error
+groupReject
+    :: UTCTime
+    -> GroupId
+    -> Verse
+    -> AP.Reject URIMode
+    -> ActE (Text, Act (), Next)
+groupReject = topicReject groupActor LocalActorGroup
+
+-- Meaning: An actor A is removing actor B from a resource
+-- Behavior:
+--      * Verify the resource is me
+--      * Verify A isn't removing themselves
+--      * Verify A is authorized by me to remove actors from me
+--      * Verify B already has a Grant for me
+--      * Remove the whole Collab record from DB
+--      * Forward the Remove to my followers
+--      * Send a Revoke:
+--          * To: Actor B
+--          * CC: Actor A, B's followers, my followers
+groupRemove
+    :: UTCTime
+    -> GroupId
+    -> Verse
+    -> AP.Remove URIMode
+    -> ActE (Text, Act (), Next)
+groupRemove =
+    topicRemove
+        groupActor LocalActorGroup
+        CollabTopicGroupGroup CollabTopicGroupCollab
+
 -- Meaning: An actor is undoing some previous action
 -- Behavior:
 --      * If they're undoing their Following of me:
@@ -269,8 +975,14 @@ groupUndo now recipGroupID (Verse authorIdMsig body) (AP.Undo uObject) = do
 groupBehavior :: UTCTime -> GroupId -> VerseExt -> ActE (Text, Act (), Next)
 groupBehavior now groupID (Left verse@(Verse _authorIdMsig body)) =
     case AP.activitySpecific $ actbActivity body of
+        AP.AcceptActivity accept -> groupAccept now groupID verse accept
         AP.CreateActivity create -> groupCreate now groupID verse create
         AP.FollowActivity follow -> groupFollow now groupID verse follow
+        AP.GrantActivity grant   -> groupGrant now groupID verse grant
+        AP.InviteActivity invite -> groupInvite now groupID verse invite
+        AP.JoinActivity join     -> groupJoin now groupID verse join
+        AP.RejectActivity reject -> groupReject now groupID verse reject
+        AP.RemoveActivity remove -> groupRemove now groupID verse remove
         AP.UndoActivity undo     -> groupUndo now groupID verse undo
         _ -> throwE "Unsupported activity type for Group"
 groupBehavior _ _ (Right _) = throwE "ClientMsgs aren't supported for Group"

src/Vervis/Actor/Person.hs

@@ -28,6 +28,7 @@ import Control.Monad.Trans.Except
 import Control.Monad.Trans.Maybe
 import Control.Monad.Trans.Reader
 import Data.Barbie
+import Data.Bifoldable
 import Data.Bifunctor
 import Data.Bitraversable
 import Data.ByteString (ByteString)
@@ -843,7 +844,7 @@ personGrant now recipPersonID (Verse authorIdMsig body) grant = do
         (role, resource, recip, _mresult, mstart, mend, usage, mdeleg) <-
             parseGrant' grant
         case (recip, authorIdMsig) of
-            (Left (GrantRecipPerson' p), Left (LocalActorPerson p', _, _))
+            (Left (LocalActorPerson p), Left (LocalActorPerson p', _, _))
                 | p == p' ->
                     throwE "Grant sender and target are the same local Person"
             (Right uRecip, Right (author, _, _))
@@ -863,7 +864,7 @@ personGrant now recipPersonID (Verse authorIdMsig body) grant = do
         -- For an extension-Grant, use 'capability' for that
         runMaybeT $ do
             guard $ usage == AP.Invoke
-            guard $ recip == Left (GrantRecipPerson' recipPersonID)
+            guard $ recip == Left (LocalActorPerson recipPersonID)
             lift $ do
                 for_ mstart $ \ start ->
                     unless (start <= now) $
@@ -1105,27 +1106,162 @@ personGrant now recipPersonID (Verse authorIdMsig body) grant = do
         return (action, recipientSet, remoteActors, fwdHosts)
 
 -- Meaning: An actor has revoked some previously published Grants
--- Behavior: Insert to my inbox
+-- Behavior:
+--  * Insert to my inbox
+--  * For each revoked activity:
+--      * If it's a direct-Grant given to me:
+--          * Verify the sender is the Permit topic
+--          * Delete the Permit record
+--      * If it's an extension-Grant given to me:
+--          * Verify the sender is the Permit topic
+--          * Delete the PermitTopicExtend* record
 personRevoke
     :: UTCTime
     -> PersonId
     -> Verse
     -> AP.Revoke URIMode
     -> ActE (Text, Act (), Next)
-personRevoke now recipPersonID (Verse authorIdMsig body) (AP.Revoke _lus) = do
+personRevoke now recipPersonID (Verse authorIdMsig body) (AP.Revoke lus) = do
 
-    maybeRevoke <- lift $ withDB $ do
+    -- Check input
+    grants <- nameExceptT "Revoke.object" $ do
+        ObjURI h _ <- lift $ getActorURI authorIdMsig
+        hl <- hostIsLocal h
+        if hl
+            then
+                for lus $ \ lu ->
+                    (\ (actor, _, item) -> Left (actor, item)) <$>
+                        parseLocalActivityURI' lu
+            else
+                pure $ Right . ObjURI h <$> lus
+
+    maybeNew <- withDBExcept $ do
 
         -- Grab me from DB
-        (_personRecip, actorRecip) <- do
+        (personRecip, actorRecip) <- lift $ do
             p <- getJust recipPersonID
             (p,) <$> getJust (personActor p)
 
-        insertToInbox now authorIdMsig body (actorInbox actorRecip) True
+        -- Look for the revoked Grants in my Permit records
+        grantsDB <- for grants $ \ grant -> runMaybeT $ do
+            grantDB <- MaybeT $ getActivity grant
+            found <-
+                Left <$> tryDirect grantDB <|>
+                Right <$> tryExtension grantDB
+            bitraverse
+                (\ (gestureID, topicAndEnable) -> do
 
-    case maybeRevoke of
+                    -- Verify the Permit is mine
+                    PermitPersonGesture permitID _ <- lift . lift $ getJust gestureID
+                    Permit p _ <- lift . lift $ getJust permitID
+                    guard $ p == recipPersonID
+
+                    -- Verify the Revoke sender is the Permit topic
+                    lift $ do
+                        topic <- lift $ getPermitTopic permitID
+                        case (bimap snd snd topic, bimap (view _1) (view _1) authorIdMsig) of
+                            (Left la, Left la') | la == la' -> pure ()
+                            (Right raID, Right ra) | raID == remoteAuthorId ra -> pure ()
+                            _ -> throwE "Revoke sender isn't the Permit topic"
+
+                    -- Return data for Permit deletion
+                    return (permitID, gestureID, topicAndEnable)
+                )
+                (\ extend -> do
+
+                    -- Verify the Permit is mine
+                    sendID <-
+                        lift . lift $ case extend of
+                            Left k -> permitTopicExtendLocalPermit <$> getJust k
+                            Right k -> permitTopicExtendRemotePermit <$> getJust k
+                    PermitPersonSendDelegator gestureID _ <- lift . lift $ getJust sendID
+                    PermitPersonGesture permitID _ <- lift . lift $ getJust gestureID
+                    Permit p _ <- lift . lift $ getJust permitID
+                    guard $ p == recipPersonID
+
+                    -- Verify the Revoke sender is the Permit topic
+                    lift $ do
+                        topic <- lift $ getPermitTopic permitID
+                        case (bimap snd snd topic, bimap (view _1) (view _1) authorIdMsig) of
+                            (Left la, Left la') | la == la' -> pure ()
+                            (Right raID, Right ra) | raID == remoteAuthorId ra -> pure ()
+                            _ -> throwE "Revoke sender isn't the Permit topic"
+
+                    -- Return data for PermitTopicExtend* deletion
+                    return extend
+                )
+                found
+
+        mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
+        lift $ for mractid $ \ _revokeDB ->
+            -- Delete revoked records from DB
+            for grantsDB $ traverse_ $
+                bitraverse_
+                    (\ (permitID, gestureID, topicAndEnable) -> do
+                        case topicAndEnable of
+                            Left (_, enableID) ->
+                                deleteWhere [PermitTopicExtendLocalTopic ==. enableID]
+                            Right (_, enableID) ->
+                                deleteWhere [PermitTopicExtendRemoteTopic ==. enableID]
+                        deleteBy $ UniquePermitPersonSendDelegator gestureID
+                        case topicAndEnable of
+                            Left (topicID, enableID) -> do
+                                delete enableID
+                                deleteBy $ UniquePermitTopicAcceptLocalTopic topicID
+                            Right (topicID, enableID) -> do
+                                delete enableID
+                                deleteBy $ UniquePermitTopicAcceptRemoteTopic topicID
+                        maybeInvite <- getKeyBy $ UniquePermitFulfillsInvite permitID
+                        for_ maybeInvite $ \ inviteID -> do
+                            deleteBy $ UniquePermitTopicGestureLocal inviteID
+                            deleteBy $ UniquePermitTopicGestureRemote inviteID
+                        delete gestureID
+                        deleteBy $ UniquePermitFulfillsTopicCreation permitID
+                        deleteBy $ UniquePermitFulfillsInvite permitID
+                        deleteBy $ UniquePermitFulfillsJoin permitID
+                        case topicAndEnable of
+                            Left (topicID, _) -> do
+                                deleteBy $ UniquePermitTopicRepo topicID
+                                deleteBy $ UniquePermitTopicDeck topicID
+                                deleteBy $ UniquePermitTopicLoom topicID
+                                deleteBy $ UniquePermitTopicProject topicID
+                                deleteBy $ UniquePermitTopicGroup topicID
+                                delete topicID
+                            Right (topicID, _) -> delete topicID
+                        delete permitID
+                    )
+                    (\case
+                        Left k -> delete k
+                        Right k -> delete k
+                    )
+
+    case maybeNew of
         Nothing -> done "I already have this activity in my inbox"
-        Just _revokeDB -> done "Inserted to my inbox"
+        Just _ -> done "Deleted any relevant Permit/Extend records"
+
+    where
+
+    tryDirect objectDB =
+        case objectDB of
+            Left (_actorByKey, _actorEntity, itemID) -> do
+                Entity enableID (PermitTopicEnableLocal gestureID topicID _) <-
+                    MaybeT $ lift $ getBy $ UniquePermitTopicEnableLocalGrant itemID
+                return (gestureID, Left (topicID, enableID))
+            Right remoteActivityID -> do
+                Entity enableID (PermitTopicEnableRemote gestureID topicID _) <-
+                    MaybeT $ lift $ getBy $ UniquePermitTopicEnableRemoteGrant remoteActivityID
+                return (gestureID, Right (topicID, enableID))
+
+    tryExtension objectDB =
+        case objectDB of
+            Left (_actorByKey, _actorEntity, itemID) -> do
+                Entity extendID (PermitTopicExtendLocal _ _ _) <-
+                    MaybeT $ lift $ getBy $ UniquePermitTopicExtendLocalGrant itemID
+                return $ Left extendID
+            Right remoteActivityID -> do
+                Entity extendID (PermitTopicExtendRemote _ _ _) <-
+                    MaybeT $ lift $ getBy $ UniquePermitTopicExtendRemoteGrant remoteActivityID
+                return $ Right extendID
 
 ------------------------------------------------------------------------------
 -- Main behavior function

src/Vervis/Actor/Person/Client.hs

@@ -360,6 +360,7 @@ clientAdd now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts a
 -- Meaning: The human wants to create a ticket tracker
 -- Behavior:
 --      * Create a deck on DB
+--      * Create a Permit record in DB
 --      * Launch a deck actor
 --      * Record a FollowRequest in DB
 --      * Create and send Create and Follow to it
@@ -389,6 +390,14 @@ clientCreateDeck now personMeID (ClientMsg maybeCap localRecips remoteRecips fwd
         (deckID, deckFollowerSetID) <-
             lift $ insertDeck now name msummary createID wid actorMeID
 
+        -- Insert a Permit record
+        lift $ do
+            permitID <- insert $ Permit personMeID AP.RoleAdmin
+            topicID <- insert $ PermitTopicLocal permitID
+            insert_ $ PermitTopicDeck topicID deckID
+            insert_ $ PermitFulfillsTopicCreation permitID
+            insert_ $ PermitPersonGesture permitID createID
+
         -- Insert the Create activity to my outbox
         deckHash <- encodeKeyHashid deckID
         actionCreate <- prepareCreate name msummary deckHash
@@ -525,6 +534,7 @@ clientCreateDeck now personMeID (ClientMsg maybeCap localRecips remoteRecips fwd
 -- Meaning: The human wants to create a project
 -- Behavior:
 --      * Create a project on DB
+--      * Create a Permit record in DB
 --      * Launch a project actor
 --      * Record a FollowRequest in DB
 --      * Create and send Create and Follow to it
@@ -553,6 +563,13 @@ clientCreateProject now personMeID (ClientMsg maybeCap localRecips remoteRecips
         (projectID, projectFollowerSetID) <-
             insertProject now name msummary createID actorMeID
 
+        -- Insert a Permit record
+        permitID <- insert $ Permit personMeID AP.RoleAdmin
+        topicID <- insert $ PermitTopicLocal permitID
+        insert_ $ PermitTopicProject topicID projectID
+        insert_ $ PermitFulfillsTopicCreation permitID
+        insert_ $ PermitPersonGesture permitID createID
+
         -- Insert the Create activity to my outbox
         projectHash <- lift $ encodeKeyHashid projectID
         actionCreate <- lift $ prepareCreate name msummary projectHash
@@ -682,6 +699,7 @@ clientCreateProject now personMeID (ClientMsg maybeCap localRecips remoteRecips
 -- Meaning: The human wants to create a team
 -- Behavior:
 --      * Create a team on DB
+--      * Create a Permit record in DB
 --      * Launch a team actor
 --      * Record a FollowRequest in DB
 --      * Create and send Create and Follow to it
@@ -710,6 +728,13 @@ clientCreateTeam now personMeID (ClientMsg maybeCap localRecips remoteRecips fwd
         (groupID, projectFollowerSetID) <-
             insertTeam now name msummary createID actorMeID
 
+        -- Insert a Permit record
+        permitID <- insert $ Permit personMeID AP.RoleAdmin
+        topicID <- insert $ PermitTopicLocal permitID
+        insert_ $ PermitTopicGroup topicID groupID
+        insert_ $ PermitFulfillsTopicCreation permitID
+        insert_ $ PermitPersonGesture permitID createID
+
         -- Insert the Create activity to my outbox
         groupHash <- lift $ encodeKeyHashid groupID
         actionCreate <- lift $ prepareCreate name msummary groupHash

src/Vervis/Actor/Project.hs

@@ -295,7 +295,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
                     case (collab, acceptDB) of
                         (Left (fulfillsID, Left recipID), Left (_, _, acceptID)) -> do
                             maybeAccept <- lift $ insertUnique $ CollabRecipLocalAccept recipID fulfillsID acceptID
-                            unless (isNothing maybeAccept) $
+                            unless (isJust maybeAccept) $
                                 throwE "This Invite already has an Accept by recip"
                         (Left (fulfillsID, Right recipID), Right (_, _, acceptID)) -> do
                             maybeAccept <- lift $ insertUnique $ CollabRecipRemoteAccept recipID fulfillsID acceptID
@@ -978,7 +978,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
             (Right u, Right (ra, _, _)) | remoteAuthorURI ra == u -> pure ()
             _ -> throwE "Author and context aren't the same actor"
         case recipient of
-            Left (GrantRecipProject' j) | j == projectID -> pure ()
+            Left (LocalActorProject j) | j == projectID -> pure ()
             _ -> throwE "Target isn't me"
         for_ mstart $ \ start ->
             unless (start < now) $ throwE "Start time is in the future"
@@ -1009,7 +1009,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
             (Right u, Right (ra, _, _)) | remoteAuthorURI ra == u -> pure ()
             _ -> throwE "Author and context aren't the same actor"
         case recipient of
-            Left (GrantRecipProject' j) | j == projectID -> pure ()
+            Left (LocalActorProject j) | j == projectID -> pure ()
             _ -> throwE "Target isn't me"
         for_ mstart $ \ start ->
             unless (start < now) $ throwE "Start time is in the future"

src/Vervis/Client.hs

@@ -43,6 +43,7 @@ module Vervis.Client
     , remove
     , inviteComponent
     , acceptProjectInvite
+    , acceptPersonalInvite
     )
 where
 
@@ -1410,3 +1411,44 @@ acceptProjectInvite personID component project uInvite = do
         audience = [audComp, audProject, audAuthor]
 
     return (Nothing, audience, activity)
+
+acceptPersonalInvite
+    :: PersonId
+    -> Either (LocalActorBy Key) RemoteActorId
+    -> FedURI
+    -> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Accept URIMode)
+acceptPersonalInvite personID resource uInvite = do
+
+    encodeRouteHome <- getEncodeRouteHome
+    resource' <- bitraverse VR.hashLocalActor pure resource
+
+    let activity = AP.Accept uInvite Nothing
+
+    -- If resource is remote, get it from DB to determine its followers
+    -- collection
+    resourceDB <-
+        bitraverse
+            pure
+            (\ remoteActorID -> lift $ runDB $ do
+                ra <- getJust remoteActorID
+                u <- getRemoteActorURI ra
+                return (ra, u)
+            )
+            resource'
+
+    senderHash <- encodeKeyHashid personID
+
+    let audResource =
+            case resourceDB of
+                Left la ->
+                    AudLocal [la] [localActorFollowers la]
+                Right (remoteActor, ObjURI h lu) ->
+                    AudRemote h
+                        [lu]
+                        (maybeToList $ remoteActorFollowers remoteActor)
+        audAuthor =
+            AudLocal [] [LocalStagePersonFollowers senderHash]
+
+        audience = [audResource, audAuthor]
+
+    return (Nothing, audience, activity)

src/Vervis/Data/Collab.hs

@@ -39,9 +39,6 @@ module Vervis.Data.Collab
     , unhashComponentE
     , componentActor
     , actorToComponent
-
-    , GrantRecipBy' (..)
-    , hashGrantRecip'
     )
 where
 
@@ -301,7 +298,7 @@ parseGrant'
     -> ActE
         ( AP.RoleExt
         , Either (LocalActorBy Key) FedURI
-        , Either (GrantRecipBy' Key) FedURI
+        , Either (LocalActorBy Key) FedURI
         , Maybe (LocalURI, Maybe Int)
         , Maybe UTCTime
         , Maybe UTCTime
@@ -333,7 +330,7 @@ parseGrant' (AP.Grant object context target mresult mstart mend allows deleg) =
                         "Grant context isn't a valid route"
                 parseLocalActorE' route
             else pure $ Right u
-    parseTarget u@(ObjURI h lu) = do
+    parseTarget u@(ObjURI h lu) = nameExceptT "Grant target" $ do
         hl <- hostIsLocal h
         if hl
             then Left <$> do
@@ -341,13 +338,7 @@ parseGrant' (AP.Grant object context target mresult mstart mend allows deleg) =
                     fromMaybeE
                         (decodeRouteLocal lu)
                         "Grant target isn't a valid route"
-                recipHash <-
+                parseLocalActorE' route
-                    fromMaybeE
-                        (parseGrantRecip' route)
-                        "Grant target isn't a grant recipient route"
-                unhashGrantRecipE'
-                    recipHash
-                    "Grant target contains invalid hashid"
             else pure $ Right u
 
 parseAccept (AP.Accept object mresult) = do
@@ -471,38 +462,3 @@ actorToComponent = \case
     LocalActorLoom k -> Just $ ComponentLoom k
     LocalActorProject _ -> Nothing
     LocalActorGroup _ -> Nothing
-
-data GrantRecipBy' f
-    = GrantRecipPerson' (f Person)
-    | GrantRecipProject' (f Project)
-    | GrantRecipComponent' (ComponentBy f)
-    deriving (Generic, FunctorB, TraversableB, ConstraintsB)
-
-deriving instance AllBF Eq f GrantRecipBy' => Eq (GrantRecipBy' f)
-
-parseGrantRecip' (PersonR p)  = Just $ GrantRecipPerson' p
-parseGrantRecip' (ProjectR j) = Just $ GrantRecipProject' j
-parseGrantRecip' r            = GrantRecipComponent' <$> parseComponent r
-
-hashGrantRecip' (GrantRecipPerson' k) =
-    GrantRecipPerson' <$> WAP.encodeKeyHashid k
-hashGrantRecip' (GrantRecipProject' k) =
-    GrantRecipProject' <$> WAP.encodeKeyHashid k
-hashGrantRecip' (GrantRecipComponent' byk) =
-    GrantRecipComponent' <$> hashComponent byk
-
-unhashGrantRecipPure' ctx = f
-    where
-    f (GrantRecipPerson' p) =
-        GrantRecipPerson' <$> decodeKeyHashidPure ctx p
-    f (GrantRecipProject' p) =
-        GrantRecipProject' <$> decodeKeyHashidPure ctx p
-    f (GrantRecipComponent' c) =
-        GrantRecipComponent' <$> unhashComponentPure ctx c
-
-unhashGrantRecip' resource = do
-    ctx <- asksEnv WAP.stageHashidsContext
-    return $ unhashGrantRecipPure' ctx resource
-
-unhashGrantRecipE' resource e =
-    ExceptT $ maybe (Left e) Right <$> unhashGrantRecip' resource

src/Vervis/Federation/Collab.hs

@@ -1,150 +0,0 @@
-{- This file is part of Vervis.
- -
- - Written in 2022, 2023 by fr33domlover <fr33domlover@riseup.net>.
- -
- - ♡ Copying is an act of love. Please copy, reuse and share.
- -
- - The author(s) have dedicated all copyright and related and neighboring
- - rights to this software to the public domain worldwide. This software is
- - distributed without any warranty.
- -
- - You should have received a copy of the CC0 Public Domain Dedication along
- - with this software. If not, see
- - <http://creativecommons.org/publicdomain/zero/1.0/>.
- -}
-
-{-# LANGUAGE RankNTypes #-}
-
-module Vervis.Federation.Collab
-    ( --personInviteF
-      --topicInviteF
-
-     -- repoJoinF
-    --, deckJoinF
-    --, loomJoinF
-
-    --, repoAcceptF
-    --, deckAcceptF
-    --, loomAcceptF
-
-    --, personGrantF
-    )
-where
-
-import Control.Applicative
-import Control.Exception hiding (Handler)
-import Control.Monad
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.Except
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.Reader
-import Data.Barbie
-import Data.Bifunctor
-import Data.Bitraversable
-import Data.ByteString (ByteString)
-import Data.Either
-import Data.Foldable
-import Data.Functor.Identity
-import Data.List.NonEmpty (NonEmpty)
-import Data.Maybe
-import Data.Text (Text)
-import Data.Time.Clock
-import Data.Traversable
-import Database.Persist
-import Database.Persist.Sql
-import Yesod.Persist.Core
-
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.Text as T
-
-import Database.Persist.JSON
-import Development.PatchMediaType
-import Network.FedURI
-import Yesod.ActivityPub
-import Yesod.FedURI
-import Yesod.Hashids
-import Yesod.MonadSite
-
-import qualified Web.ActivityPub as AP
-
-import Control.Monad.Trans.Except.Local
-import Data.Either.Local
-import Data.Tuple.Local
-import Database.Persist.Local
-import Yesod.Persist.Local
-
-import Vervis.Access
-import Vervis.ActivityPub
-import Vervis.Actor (RemoteAuthor (..), ActivityBody (..))
-import Vervis.Data.Actor
-import Vervis.Data.Collab
-import Vervis.Web.Delivery
-import Vervis.FedURI
-import Vervis.Federation.Auth
-import Vervis.Federation.Util
-import Vervis.Foundation
-import Vervis.Model
-import Vervis.Persist.Actor
-import Vervis.Persist.Collab
-import Vervis.Recipient
-import Vervis.RemoteActorStore
-
-{-
-repoJoinF
-    :: UTCTime
-    -> KeyHashid Repo
-    -> RemoteAuthor
-    -> ActivityBody
-    -> Maybe (RecipientRoutes, ByteString)
-    -> LocalURI
-    -> AP.Join URIMode
-    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
-repoJoinF = topicJoinF repoActor GrantResourceRepo
-
-deckJoinF
-    :: UTCTime
-    -> KeyHashid Deck
-    -> RemoteAuthor
-    -> ActivityBody
-    -> Maybe (RecipientRoutes, ByteString)
-    -> LocalURI
-    -> AP.Join URIMode
-    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
-deckJoinF = topicJoinF deckActor GrantResourceDeck
-
-loomJoinF
-    :: UTCTime
-    -> KeyHashid Loom
-    -> RemoteAuthor
-    -> ActivityBody
-    -> Maybe (RecipientRoutes, ByteString)
-    -> LocalURI
-    -> AP.Join URIMode
-    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
-loomJoinF = topicJoinF loomActor GrantResourceLoom
--}
-
-{-
-repoAcceptF
-    :: UTCTime
-    -> KeyHashid Repo
-    -> RemoteAuthor
-    -> ActivityBody
-    -> Maybe (RecipientRoutes, ByteString)
-    -> LocalURI
-    -> AP.Accept URIMode
-    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
-repoAcceptF = topicAcceptF repoActor GrantResourceRepo
-
-loomAcceptF
-    :: UTCTime
-    -> KeyHashid Loom
-    -> RemoteAuthor
-    -> ActivityBody
-    -> Maybe (RecipientRoutes, ByteString)
-    -> LocalURI
-    -> AP.Accept URIMode
-    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
-loomAcceptF = topicAcceptF loomActor GrantResourceLoom
--}

src/Vervis/Form/Tracker.hs

@@ -27,6 +27,8 @@ module Vervis.Form.Tracker
     , ProjectInvite (..)
     , projectInviteForm
     , projectInviteCompForm
+    , GroupInvite (..)
+    , groupInviteForm
     --, NewProjectCollab (..)
     --, newProjectCollabForm
     --, editProjectForm
@@ -179,6 +181,38 @@ projectInviteForm projectID = renderDivs $ ProjectInvite
 projectInviteCompForm :: Form FedURI
 projectInviteCompForm = renderDivs $ areq fedUriField "Component URI*" Nothing
 
+data GroupInvite = GroupInvite
+    { giPerson :: PersonId
+    , giRole   :: AP.Role
+    }
+
+groupInviteForm :: GroupId -> Form GroupInvite
+groupInviteForm groupID = renderDivs $ GroupInvite
+    <$> areq selectPerson "Person*" Nothing
+    <*> areq selectRole   "Role*"   Nothing
+    where
+    selectPerson = selectField $ do
+        l <- runDB $ E.select $
+            E.from $ \ (person `E.InnerJoin` actor `E.LeftOuterJoin` (recip `E.InnerJoin` topic)) -> do
+                E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicGroupCollab E.&&.
+                       topic E.^. CollabTopicGroupGroup E.==. E.val groupID
+                E.on $ person E.^. PersonId E.==. recip E.^. CollabRecipLocalPerson
+                E.on $ person E.^. PersonActor E.==. actor E.^. ActorId
+                E.where_ $ E.isNothing $ E.just $ recip E.^. CollabRecipLocalId
+                return (person, actor)
+        optionsPairs $
+            map (\ (Entity pid p, Entity _ a) ->
+                    ( T.concat
+                        [ actorName a
+                        , " ~"
+                        , username2text $ personUsername p
+                        ]
+                    , pid
+                    )
+                )
+            l
+    selectRole = selectField optionsEnum
+
 {-
 editProjectAForm :: SharerId -> Entity Project -> AForm Handler Project
 editProjectAForm sid (Entity jid project) = Project

src/Vervis/Foundation.hs

@@ -160,6 +160,9 @@ type SigKeyKeyHashid            = KeyHashid SigKey
 type ProjectKeyHashid           = KeyHashid Project
 type CollabEnableKeyHashid      = KeyHashid CollabEnable
 type StemKeyHashid              = KeyHashid Stem
+type PermitFulfillsInviteKeyHashid = KeyHashid PermitFulfillsInvite
+type DestThemSendDelegatorLocalKeyHashid = KeyHashid DestThemSendDelegatorLocal
+type DestThemSendDelegatorRemoteKeyHashid = KeyHashid DestThemSendDelegatorRemote
 
 -- This is where we define all of the routes in our application. For a full
 -- explanation of the syntax, please see:
@@ -856,6 +859,8 @@ instance YesodBreadcrumbs App where
         PublishRemoveR     -> ("Remove someone from a resource", Just HomeR)
         PublishResolveR     -> ("Close a ticket", Just HomeR)
 
+        AcceptInviteR _ -> ("", Nothing)
+
         PersonR p             -> ("Person ~" <> keyHashidText p, Just HomeR)
         PersonInboxR p        -> ("Inbox", Just $ PersonR p)
         PersonOutboxR p       -> ("Outbox", Just $ PersonR p)
@@ -883,7 +888,14 @@ instance YesodBreadcrumbs App where
 
         GroupStampR g k -> ("Stamp #" <> keyHashidText k, Just $ GroupR g)
 
-        GroupMembersR g -> ("Members", Just $ GroupR g)
+        GroupMembersR g  -> ("Members", Just $ GroupR g)
+        GroupInviteR g   -> ("Invite", Just $ GroupR g)
+        GroupRemoveR _ _ -> ("", Nothing)
+
+        GroupChildrenR j -> ("Child teams", Just $ GroupR j)
+        GroupChildLocalLiveR j d -> ("Local " <> keyHashidText d, Just $ GroupChildrenR j)
+        GroupChildRemoteLiveR j d -> ("Remote " <> keyHashidText d, Just $ GroupChildrenR j)
+        GroupParentsR j -> ("Parent teams", Just $ GroupR j)
 
         RepoR r             -> ("Repo ^" <> keyHashidText r, Just HomeR)
         RepoInboxR r        -> ("Inbox", Just $ RepoR r)
@@ -1020,3 +1032,8 @@ instance YesodBreadcrumbs App where
         ProjectCollabLiveR j c -> (keyHashidText c, Just $ ProjectCollabsR j)
 
         ProjectInviteCompR d  -> ("Invite", Just $ ProjectComponentsR d)
+
+        ProjectChildrenR j -> ("Child projects", Just $ ProjectR j)
+        ProjectParentsR j -> ("Parent projects", Just $ ProjectR j)
+        ProjectParentLocalLiveR j d -> ("Local " <> keyHashidText d, Just $ ProjectParentsR j)
+        ProjectParentRemoteLiveR j d -> ("Remote " <> keyHashidText d, Just $ ProjectParentsR j)

src/Vervis/Handler/Client.hs

@@ -44,6 +44,8 @@ module Vervis.Handler.Client
 
     , getPublishResolveR
     , postPublishResolveR
+
+    , postAcceptInviteR
     )
 where
 
@@ -53,12 +55,15 @@ import Control.Monad
 import Control.Monad.Trans.Except
 import Data.Bifunctor
 import Data.Bitraversable
+import Data.Function
 import Data.List
 import Data.Text (Text)
 import Data.Time.Clock
 import Data.Traversable
 import Database.Persist
+import Network.HTTP.Types.Method
 import Text.Blaze.Html (preEscapedToHtml)
+import Optics.Core
 import Yesod.Auth
 import Yesod.Auth.Account
 import Yesod.Auth.Account.Message
@@ -77,6 +82,7 @@ import Network.FedURI
 import Web.Text
 import Yesod.ActivityPub
 import Yesod.Auth.Unverified
+import Yesod.FedURI
 import Yesod.Hashids
 import Yesod.MonadSite
 import Yesod.RenderSource
@@ -89,6 +95,7 @@ import Data.EventTime.Local
 import Database.Persist.Local
 import Yesod.Form.Local
 
+import Vervis.Actor
 import Vervis.API
 import Vervis.Client
 import Vervis.Data.Actor
@@ -98,12 +105,17 @@ import Vervis.Form.Ticket
 import Vervis.Foundation
 import Vervis.Model
 import Vervis.Model.Ident
+import Vervis.Persist.Actor
 import Vervis.Persist.Collab
 import Vervis.Recipient
 import Vervis.Settings
 import Vervis.Web.Actor
+import Vervis.Widget
 import Vervis.Widget.Tracker
 
+import qualified Vervis.Client as C
+import qualified Vervis.Recipient as VR
+
 -- | Account verification email resend form
 getResendVerifyEmailR :: Handler Html
 getResendVerifyEmailR = do
@@ -130,64 +142,208 @@ getHomeR = do
     where
     personalOverview :: Entity Person -> Handler Html
     personalOverview (Entity pid _person) = do
-        (repos, decks, looms, projects, groups) <- runDB $ (,,,,)
+        (permits, invites) <- runDB $ do
-            <$> (E.select $ E.from $ \ (recip `E.InnerJoin` collab `E.InnerJoin` topic `E.InnerJoin` enable `E.InnerJoin` repo `E.InnerJoin` actor) -> do
+            permits <- do
-                    E.on $ repo E.^. RepoActor E.==. actor E.^. ActorId
+                locals <- do
-                    E.on $ topic E.^. CollabTopicRepoRepo E.==. repo E.^. RepoId
+                    ls <- E.select $ E.from $ \ (permit `E.InnerJoin` topic `E.InnerJoin` enable) -> do
-                    E.on $ topic E.^. CollabTopicRepoCollab E.==. enable E.^. CollabEnableCollab
+                        E.on $ topic E.^. PermitTopicLocalId E.==. enable E.^. PermitTopicEnableLocalTopic
-                    E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicRepoCollab
+                        E.on $ permit E.^. PermitId E.==. topic E.^. PermitTopicLocalPermit
-                    E.on $ recip E.^. CollabRecipLocalCollab E.==. collab E.^. CollabId
+                        E.where_ $ permit E.^. PermitPerson E.==. E.val pid
-                    E.where_ $ recip E.^. CollabRecipLocalPerson E.==. E.val pid
+                        E.orderBy [E.asc $ enable E.^. PermitTopicEnableLocalId]
-                    E.orderBy [E.asc $ repo E.^. RepoId]
+                        return
-                    return (repo, actor, collab)
+                            ( enable E.^. PermitTopicEnableLocalPermit
-                )
+                            , permit E.^. PermitRole
-            <*> (E.select $ E.from $ \ (recip `E.InnerJoin` collab `E.InnerJoin` topic `E.InnerJoin` enable `E.InnerJoin` deck `E.InnerJoin` actor) -> do
+                            , topic E.^. PermitTopicLocalId
-                    E.on $ deck E.^. DeckActor E.==. actor E.^. ActorId
+                            )
-                    E.on $ topic E.^. CollabTopicDeckDeck E.==. deck E.^. DeckId
+                    for ls $ \ (E.Value gestureID, E.Value role, E.Value topicID) -> do
-                    E.on $ topic E.^. CollabTopicDeckCollab E.==. enable E.^. CollabEnableCollab
+                        topic <- getPermitTopicLocal topicID
-                    E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicDeckCollab
+                        actorID <- do
-                    E.on $ recip E.^. CollabRecipLocalCollab E.==. collab E.^. CollabId
+                            ma <- getLocalActorEntity topic
-                    E.where_ $ recip E.^. CollabRecipLocalPerson E.==. E.val pid
+                            case ma of
-                    E.orderBy [E.asc $ deck E.^. DeckId]
+                                Nothing -> error "Impossible, we should have found the local actor in DB"
-                    return (deck, actor, collab)
+                                Just a -> pure $ localActorID a
-                )
+                        actor <- getJust actorID
-            <*> (E.select $ E.from $ \ (recip `E.InnerJoin` collab `E.InnerJoin` topic `E.InnerJoin` enable `E.InnerJoin` loom `E.InnerJoin` actor) -> do
+                        delegator <- getKeyBy $ UniquePermitPersonSendDelegator gestureID
-                    E.on $ loom E.^. LoomActor E.==. actor E.^. ActorId
+                        exts <-
-                    E.on $ topic E.^. CollabTopicLoomLoom E.==. loom E.^. LoomId
+                            case delegator of
-                    E.on $ topic E.^. CollabTopicLoomCollab E.==. enable E.^. CollabEnableCollab
+                                Nothing -> pure []
-                    E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicLoomCollab
+                                Just sendID -> do
-                    E.on $ recip E.^. CollabRecipLocalCollab E.==. collab E.^. CollabId
+                                    topicHash <- VR.hashLocalActor topic
-                    E.where_ $ recip E.^. CollabRecipLocalPerson E.==. E.val pid
+                                    hashItem <- getEncodeKeyHashid
-                    E.orderBy [E.asc $ loom E.^. LoomId]
+                                    encodeRouteHome <- getEncodeRouteHome
-                    return (loom, actor, collab)
+                                    map (encodeRouteHome . activityRoute topicHash . hashItem . permitTopicExtendLocalGrant  . entityVal) <$>
-                )
+                                        selectList [PermitTopicExtendLocalPermit ==. sendID] [Asc PermitTopicExtendLocalId]
-            <*> (E.select $ E.from $ \ (recip `E.InnerJoin` collab `E.InnerJoin` topic `E.InnerJoin` enable `E.InnerJoin` project `E.InnerJoin` actor) -> do
+                        return
-                    E.on $ project E.^. ProjectActor E.==. actor E.^. ActorId
+                            ( gestureID
-                    E.on $ topic E.^. CollabTopicProjectProject E.==. project E.^. ProjectId
+                            , role
-                    E.on $ topic E.^. CollabTopicProjectCollab E.==. enable E.^. CollabEnableCollab
+                            , delegator
-                    E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicProjectCollab
+                            , localActorType topic
-                    E.on $ recip E.^. CollabRecipLocalCollab E.==. collab E.^. CollabId
+                            , Left (topic, actor)
-                    E.where_ $ recip E.^. CollabRecipLocalPerson E.==. E.val pid
+                            , exts
-                    E.orderBy [E.asc $ project E.^. ProjectId]
+                            )
-                    return (project, actor, collab)
+                remotes <- do
-                )
+                    rs <- E.select $ E.from $ \ (permit `E.InnerJoin` topic `E.InnerJoin` enable) -> do
-            <*> (E.select $ E.from $ \ (recip `E.InnerJoin` collab `E.InnerJoin` topic `E.InnerJoin` enable `E.InnerJoin` group `E.InnerJoin` actor) -> do
+                        E.on $ topic E.^. PermitTopicRemoteId E.==. enable E.^. PermitTopicEnableRemoteTopic
-                    E.on $ group E.^. GroupActor E.==. actor E.^. ActorId
+                        E.on $ permit E.^. PermitId E.==. topic E.^. PermitTopicRemotePermit
-                    E.on $ topic E.^. CollabTopicGroupGroup E.==. group E.^. GroupId
+                        E.where_ $ permit E.^. PermitPerson E.==. E.val pid
-                    E.on $ topic E.^. CollabTopicGroupCollab E.==. enable E.^. CollabEnableCollab
+                        E.orderBy [E.asc $ enable E.^. PermitTopicEnableRemoteId]
-                    E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicGroupCollab
+                        return
-                    E.on $ recip E.^. CollabRecipLocalCollab E.==. collab E.^. CollabId
+                            ( enable E.^. PermitTopicEnableRemotePermit
-                    E.where_ $ recip E.^. CollabRecipLocalPerson E.==. E.val pid
+                            , permit E.^. PermitRole
-                    E.orderBy [E.asc $ group E.^. GroupId]
+                            , topic E.^. PermitTopicRemoteActor
-                    return (group, actor, collab)
+                            )
-                )
+                    for rs $ \ (E.Value gestureID, E.Value role, E.Value remoteActorID) -> do
-        hashRepo <- getEncodeKeyHashid
+                        remoteActor <- getJust remoteActorID
-        hashDeck <- getEncodeKeyHashid
+                        remoteObject <- getJust $ remoteActorIdent remoteActor
-        hashLoom <- getEncodeKeyHashid
+                        inztance <- getJust $ remoteObjectInstance remoteObject
-        hashProject <- getEncodeKeyHashid
+                        delegator <- getKeyBy $ UniquePermitPersonSendDelegator gestureID
-        hashGroup <- getEncodeKeyHashid
+                        exts <-
+                            case delegator of
+                                Nothing -> pure []
+                                Just sendID -> do
+                                    es <- selectList [PermitTopicExtendRemotePermit ==. sendID] [Asc PermitTopicExtendRemoteId]
+                                    for es $ \ (Entity _ (PermitTopicExtendRemote _ _ grantID)) -> do
+                                        grant <- getJust grantID
+                                        getRemoteActivityURI grant
+                        return
+                            ( gestureID
+                            , role
+                            , delegator
+                            , remoteActorType remoteActor
+                            , Right (inztance, remoteObject, remoteActor)
+                            , exts
+                            )
+                return $ locals ++ remotes
+            invites <- do
+                locals <- do
+                    ls <- E.select $ E.from $ \ (permit `E.InnerJoin` fulfills `E.InnerJoin` topic `E.LeftOuterJoin` enable `E.LeftOuterJoin` valid `E.LeftOuterJoin` accept) -> do
+                        E.on $ E.just (permit E.^. PermitId) E.==. accept E.?. PermitPersonGesturePermit
+                        E.on $ E.just (topic E.^. PermitTopicLocalId) E.==. valid E.?. PermitTopicAcceptLocalTopic
+                        E.on $ E.just (topic E.^. PermitTopicLocalId) E.==. enable E.?. PermitTopicEnableLocalTopic
+                        E.on $ permit E.^. PermitId E.==. topic E.^. PermitTopicLocalPermit
+                        E.on $ permit E.^. PermitId E.==. fulfills E.^. PermitFulfillsInvitePermit
+                        E.where_ $
+                            permit E.^. PermitPerson E.==. E.val pid E.&&.
+                            E.isNothing (enable E.?. PermitTopicEnableLocalId)
+                        E.orderBy [E.asc $ permit E.^. PermitId]
+                        return
+                            ( fulfills E.^. PermitFulfillsInviteId
+                            , permit E.^. PermitRole
+                            , valid E.?. PermitTopicAcceptLocalId
+                            , accept E.?. PermitPersonGestureId
+                            , topic E.^. PermitTopicLocalId
+                            )
+                    for ls $ \ (E.Value fulfillsID, E.Value role, E.Value valid, E.Value accept, E.Value topicID) -> do
+                        topic <- getPermitTopicLocal topicID
+                        actorID <- do
+                            ma <- getLocalActorEntity topic
+                            case ma of
+                                Nothing -> error "Impossible, we should have found the local actor in DB"
+                                Just a -> pure $ localActorID a
+                        actor <- getJust actorID
+                        fulfillsHash <- encodeKeyHashid fulfillsID
+                        return
+                            ( fulfillsID
+                            , role
+                            , () <$ valid
+                            , accept
+                            , fulfillsHash
+                            , Left (topic, actor)
+                            )
+                remotes <- do
+                    rs <- E.select $ E.from $ \ (permit `E.InnerJoin` fulfills `E.InnerJoin` topic `E.LeftOuterJoin` enable `E.LeftOuterJoin` valid `E.LeftOuterJoin` accept) -> do
+                        E.on $ E.just (permit E.^. PermitId) E.==. accept E.?. PermitPersonGesturePermit
+                        E.on $ E.just (topic E.^. PermitTopicRemoteId) E.==. valid E.?. PermitTopicAcceptRemoteTopic
+                        E.on $ E.just (topic E.^. PermitTopicRemoteId) E.==. enable E.?. PermitTopicEnableRemoteTopic
+                        E.on $ permit E.^. PermitId E.==. topic E.^. PermitTopicRemotePermit
+                        E.on $ permit E.^. PermitId E.==. fulfills E.^. PermitFulfillsInvitePermit
+                        E.where_ $
+                            permit E.^. PermitPerson E.==. E.val pid E.&&.
+                            E.isNothing (enable E.?. PermitTopicEnableRemoteId)
+                        E.orderBy [E.asc $ permit E.^. PermitId]
+                        return
+                            ( fulfills E.^. PermitFulfillsInviteId
+                            , permit E.^. PermitRole
+                            , valid E.?. PermitTopicAcceptRemoteId
+                            , accept E.?. PermitPersonGestureId
+                            , topic E.^. PermitTopicRemoteActor
+                            )
+                    for rs $ \ (E.Value fulfillsID, E.Value role, E.Value valid, E.Value accept, E.Value remoteActorID) -> do
+                        remoteActor <- getJust remoteActorID
+                        remoteObject <- getJust $ remoteActorIdent remoteActor
+                        inztance <- getJust $ remoteObjectInstance remoteObject
+                        fulfillsHash <- encodeKeyHashid fulfillsID
+                        return
+                            ( fulfillsID
+                            , role
+                            , () <$ valid
+                            , accept
+                            , fulfillsHash
+                            , Right (inztance, remoteObject, remoteActor)
+                            )
+                return $ sortOn (view _1) $ locals ++ remotes
+            return (permits, invites)
+        let (people, repos, decks, looms, projects, groups, others) =
+                partitionByActorType (view _4) (view _1) permits
+        if null people
+            then pure ()
+            else error "Bug: Person as a PermitTopic"
         defaultLayout $(widgetFile "personal-overview")
 
+        where
+
+        partitionByActorType
+            :: Eq b
+            => (a -> AP.ActorType)
+            -> (a -> b)
+            -> [a]
+            -> ([a], [a], [a], [a], [a], [a], [a])
+        partitionByActorType typ key xs =
+            let p = filter ((== AP.ActorTypePerson) . typ) xs
+                r = filter ((== AP.ActorTypeRepo) . typ) xs
+                d = filter ((== AP.ActorTypeTicketTracker) . typ) xs
+                l = filter ((== AP.ActorTypePatchTracker) . typ) xs
+                j = filter ((== AP.ActorTypeProject) . typ) xs
+                g = filter ((== AP.ActorTypeTeam) . typ) xs
+                x = deleteFirstsBy ((==) `on` key) xs (p ++ r ++ d ++ l ++ j ++ g)
+            in  (p, r, d, l, j, g, x)
+
+        item (_gestureID, role, deleg, _typ, actor, exts) =
+            [whamlet|
+                <span>
+                  [
+                  #{show role}
+                  ] #
+                  $maybe _ <- deleg
+                    \ [D] #
+                  $nothing
+                    \ [_] #
+                  ^{actorLinkFedW actor}
+                <ul>
+                  $forall u <- exts
+                    <li>
+                      <a href="#{renderObjURI u}">
+                        #{renderObjURI u}
+            |]
+
+        invite (_fulfillsID, role, valid, accept, fulfillsHash, actor) =
+            [whamlet|
+                <span>
+                  [
+                  #{show role}
+                  ] #
+                  $maybe _ <- valid
+                    \ [Valid] #
+                  $nothing
+                    \ [Not validated] #
+                  $maybe _ <- accept
+                    \ [You've accepted] #
+                  $nothing
+                    ^{buttonW POST "Accept" (AcceptInviteR fulfillsHash)}
+                  $#\ [Reject Button] #
+                  ^{actorLinkFedW actor}
+            |]
+
 getBrowseR :: Handler Html
 getBrowseR = do
     (people, groups, repos, decks, looms, projects) <- runDB $
@@ -1251,9 +1407,6 @@ getPublishInviteR = do
 
 postPublishInviteR :: Handler ()
 postPublishInviteR = do
-    federation <- getsYesod $ appFederation . appSettings
-    unless federation badMethod
-
     (uRecipient, uResourceCollabs, role, (uCap, cap)) <-
         runFormPostRedirect PublishInviteR inviteForm
 
@@ -1353,3 +1506,50 @@ postPublishResolveR = do
         Right _ -> do
             setMessage "Resolve activity sent"
             redirect HomeR
+
+postAcceptInviteR :: KeyHashid PermitFulfillsInvite -> Handler ()
+postAcceptInviteR fulfillsHash = do
+    fulfillsID <- decodeKeyHashid404 fulfillsHash
+
+    personEntity@(Entity personID person) <- requireAuth
+    personHash <- encodeKeyHashid personID
+    encodeRouteHome <- getEncodeRouteHome
+
+    result <- runExceptT $ do
+        (uInvite, topic) <- lift $ runDB $ do
+            PermitFulfillsInvite permitID <- get404 fulfillsID
+            Permit p _ <- getJust permitID
+            unless (p == personID) notFound
+            uInvite <- do
+                i <-
+                    requireEitherAlt
+                        (getValBy $ UniquePermitTopicGestureLocal fulfillsID)
+                        (getValBy $ UniquePermitTopicGestureRemote fulfillsID)
+                        "Invite not found"
+                        "Multiple invites"
+                case i of
+                    Left (PermitTopicGestureLocal _ inviteID) -> do
+                        outboxID <- outboxItemOutbox <$> getJust inviteID
+                        actorID <- getKeyByJust $ UniqueActorOutbox outboxID
+                        actor <- getLocalActor actorID
+                        actorHash <- VR.hashLocalActor actor
+                        inviteHash <- encodeKeyHashid inviteID
+                        return $ encodeRouteHome $
+                            activityRoute actorHash inviteHash
+                    Right (PermitTopicGestureRemote _ _ inviteID) -> do
+                        invite <- getJust inviteID
+                        getRemoteActivityURI invite
+            topic <- bimap snd snd <$> getPermitTopic permitID
+            return (uInvite, topic)
+        (maybeSummary, audience, accept) <-
+            C.acceptPersonalInvite personID topic uInvite
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            C.makeServerInput Nothing maybeSummary audience $
+                AP.AcceptActivity accept
+        handleViaActor
+            personID Nothing localRecips remoteRecips fwdHosts action
+
+    case result of
+        Left e -> setMessage $ toHtml e
+        Right _acceptID -> setMessage "Accept sent"
+    redirect HomeR

src/Vervis/Handler/Deck.hs

@@ -109,7 +109,6 @@ import Yesod.Persist.Local
 import Vervis.Access
 import Vervis.API
 import Vervis.Federation.Auth
-import Vervis.Federation.Collab
 import Vervis.Federation.Discussion
 import Vervis.Federation.Offer
 import Vervis.Federation.Ticket

src/Vervis/Handler/Group.hs

@@ -28,7 +28,14 @@ module Vervis.Handler.Group
     , getGroupStampR
 
     , getGroupMembersR
+    , getGroupInviteR
+    , postGroupInviteR
+    , postGroupRemoveR
 
+    , getGroupChildrenR
+    , getGroupChildLocalLiveR
+    , getGroupChildRemoteLiveR
+    , getGroupParentsR
 
 
 
@@ -55,12 +62,14 @@ import Data.Bitraversable
 import Data.ByteString (ByteString)
 import Data.Default.Class
 import Data.Foldable
+import Data.List
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Data.Time.Clock
 import Data.Traversable
 import Database.Persist
 import Network.HTTP.Types.Method
+import Optics.Core
 import Text.Blaze.Html (Html)
 import Yesod.Auth (requireAuth)
 import Yesod.Core
@@ -94,7 +103,6 @@ import Vervis.Access
 import Vervis.API
 import Vervis.Data.Collab
 import Vervis.Federation.Auth
-import Vervis.Federation.Collab
 import Vervis.Federation.Discussion
 import Vervis.Federation.Offer
 import Vervis.Federation.Ticket
@@ -188,8 +196,8 @@ getGroupR groupHash = do
             }
         groupAP = AP.Team
             { AP.teamActor    = actorAP
-            , AP.teamChildren = []
+            , AP.teamChildren = encodeRouteLocal $ GroupChildrenR groupHash
-            , AP.teamParents  = []
+            , AP.teamParents  = encodeRouteLocal $ GroupParentsR groupHash
             , AP.teamMembers  = encodeRouteLocal $ GroupMembersR groupHash
             }
 
@@ -291,7 +299,307 @@ getGroupMembersR groupHash = do
                 LocalActorPerson personID -> return personID
                 _ -> error "Surprise, local inviter actor isn't a Person"
 
+getGroupInviteR :: KeyHashid Group -> Handler Html
+getGroupInviteR groupHash = do
+    groupID <- decodeKeyHashid404 groupHash
+    ((_result, widget), enctype) <- runFormPost $ groupInviteForm groupID
+    defaultLayout $(widgetFile "group/member/new")
 
+postGroupInviteR :: KeyHashid Group -> Handler Html
+postGroupInviteR groupHash = do
+    groupID <- decodeKeyHashid404 groupHash
+    GroupInvite recipPersonID role <-
+        runFormPostRedirect (GroupInviteR groupHash) $ groupInviteForm groupID
+
+    personEntity@(Entity personID person) <- requireAuth
+    personHash <- encodeKeyHashid personID
+    recipPersonHash <- encodeKeyHashid recipPersonID
+    encodeRouteHome <- getEncodeRouteHome
+
+    result <- runExceptT $ do
+        (maybeSummary, audience, invite) <- do
+            let uRecipient = encodeRouteHome $ PersonR recipPersonHash
+                uResourceCollabs = encodeRouteHome $ GroupMembersR groupHash
+            C.invite personID uRecipient uResourceCollabs role
+        grantID <- do
+            maybeItem <- lift $ runDB $ getGrant CollabTopicGroupCollab CollabTopicGroupGroup groupID personID
+            fromMaybeE maybeItem "You need to be a collaborator in the Group to invite people"
+        grantHash <- encodeKeyHashid grantID
+        let uCap = encodeRouteHome $ GroupOutboxItemR groupHash grantHash
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            C.makeServerInput (Just uCap) maybeSummary audience $ AP.InviteActivity invite
+        let cap =
+                Left (LocalActorGroup groupID, LocalActorGroup groupHash, grantID)
+        handleViaActor
+            personID (Just cap) localRecips remoteRecips fwdHosts action
+
+    case result of
+        Left e -> do
+            setMessage $ toHtml e
+            redirect $ GroupInviteR groupHash
+        Right inviteID -> do
+            setMessage "Invite sent"
+            redirect $ GroupMembersR groupHash
+
+postGroupRemoveR :: KeyHashid Group -> CollabTopicGroupId -> Handler Html
+postGroupRemoveR groupHash ctID = do
+    groupID <- decodeKeyHashid404 groupHash
+
+    personEntity@(Entity personID person) <- requireAuth
+    personHash <- encodeKeyHashid personID
+    encodeRouteHome <- getEncodeRouteHome
+
+    result <- runExceptT $ do
+        mpidOrU <- lift $ runDB $ runMaybeT $ do
+            CollabTopicGroup collabID groupID' <- MaybeT $ get ctID
+            guard $ groupID' == groupID
+            _ <- MaybeT $ getBy $ UniqueCollabEnable collabID
+            member <-
+                Left <$> MaybeT (getValBy $ UniqueCollabRecipLocal collabID) <|>
+                Right <$> MaybeT (getValBy $ UniqueCollabRecipRemote collabID)
+            lift $
+                bitraverse
+                    (pure . collabRecipLocalPerson)
+                    (getRemoteActorURI <=< getJust . collabRecipRemoteActor)
+                    member
+        pidOrU <- maybe notFound pure mpidOrU
+        (maybeSummary, audience, remove) <- do
+            uRecipient <-
+                case pidOrU of
+                    Left pid -> encodeRouteHome . PersonR <$> encodeKeyHashid pid
+                    Right u -> pure u
+            let uResourceCollabs = encodeRouteHome $ GroupMembersR groupHash
+            C.remove personID uRecipient uResourceCollabs
+        grantID <- do
+            maybeItem <- lift $ runDB $ getGrant CollabTopicGroupCollab CollabTopicGroupGroup groupID personID
+            fromMaybeE maybeItem "You need to be a collaborator in the Group to remove people"
+        grantHash <- encodeKeyHashid grantID
+        let uCap = encodeRouteHome $ GroupOutboxItemR groupHash grantHash
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            C.makeServerInput (Just uCap) maybeSummary audience $ AP.RemoveActivity remove
+        let cap =
+                Left (LocalActorGroup groupID, LocalActorGroup groupHash, grantID)
+        handleViaActor
+            personID (Just cap) localRecips remoteRecips fwdHosts action
+
+    case result of
+        Left e -> do
+            setMessage $ toHtml e
+        Right removeID ->
+            setMessage "Remove sent"
+    redirect $ GroupMembersR groupHash
+
+getGroupChildrenR :: KeyHashid Group -> Handler TypedContent
+getGroupChildrenR groupHash = do
+    groupID <- decodeKeyHashid404 groupHash
+    (actor, group, children) <- runDB $ do
+        group <- get404 groupID
+        actor <- getJust $ groupActor group
+        children <- getChildren groupID
+        return (actor, group, children)
+    encodeRouteLocal <- getEncodeRouteLocal
+    encodeRouteHome <- getEncodeRouteHome
+    hashGroup <- getEncodeKeyHashid
+    h <- asksSite siteInstanceHost
+    let makeId (Left (childID, _)) =
+            encodeRouteHome $ GroupR $ hashGroup childID
+        makeId (Right (i, ro, _)) =
+            ObjURI (instanceHost i) (remoteObjectIdent ro)
+        makeItem (role, time, i) = AP.Relationship
+            { AP.relationshipId           = Nothing
+            , AP.relationshipExtraTypes   = []
+            , AP.relationshipSubject      = encodeRouteHome $ GroupR groupHash
+            , AP.relationshipProperty     = Left AP.RelHasChild
+            , AP.relationshipObject       = makeId i
+            , AP.relationshipAttributedTo = encodeRouteLocal $ GroupR groupHash
+            , AP.relationshipPublished    = Just time
+            , AP.relationshipUpdated      = Nothing
+            , AP.relationshipInstrument   = Just role
+            }
+        childrenAP = Collection
+            { collectionId         = encodeRouteLocal $ GroupChildrenR groupHash
+            , collectionType       = CollectionTypeUnordered
+            , collectionTotalItems = Just $ length children
+            , collectionCurrent    = Nothing
+            , collectionFirst      = Nothing
+            , collectionLast       = Nothing
+            , collectionItems      = map (Doc h . makeItem) children
+            , collectionContext    =
+                Just $ encodeRouteLocal $ GroupR groupHash
+            }
+    provideHtmlAndAP childrenAP $ getHtml groupID group actor children
+
+    where
+
+    getChildren groupID = fmap (sortOn $ view _2) $ liftA2 (++)
+        (map (\ (E.Value role, E.Value time, E.Value child, Entity _ actor) ->
+                (role, time, Left (child, actor))
+             )
+            <$> getLocals groupID
+        )
+        (map (\ (E.Value role, E.Value time, Entity _ i, Entity _ ro, Entity _ ra) ->
+                (role, time, Right (i, ro, ra))
+             )
+            <$> getRemotes groupID
+        )
+
+    getLocals groupID =
+        E.select $ E.from $ \ (dest `E.InnerJoin` holder `E.InnerJoin` topic `E.InnerJoin` group `E.InnerJoin` actor `E.InnerJoin` accept `E.InnerJoin` deleg `E.InnerJoin` grant) -> do
+            E.on $ deleg E.^. DestThemSendDelegatorLocalGrant E.==. grant E.^. OutboxItemId
+            E.on $ accept E.^. DestUsAcceptId E.==. deleg E.^. DestThemSendDelegatorLocalDest
+            E.on $ dest E.^. DestId E.==. accept E.^. DestUsAcceptDest
+            E.on $ group E.^. GroupActor E.==. actor E.^. ActorId
+            E.on $ topic E.^. DestTopicGroupChild E.==. group E.^. GroupId
+            E.on $ holder E.^. DestHolderGroupId E.==. topic E.^. DestTopicGroupHolder
+            E.on $ dest E.^. DestId E.==. holder E.^. DestHolderGroupDest
+            E.where_ $ holder E.^. DestHolderGroupGroup E.==. E.val groupID
+            E.orderBy [E.asc $ grant E.^. OutboxItemPublished]
+            return
+                ( dest E.^. DestRole
+                , grant E.^. OutboxItemPublished
+                , topic E.^. DestTopicGroupChild
+                , actor
+                )
+
+    getRemotes groupID =
+        E.select $ E.from $ \ (dest `E.InnerJoin` holder `E.InnerJoin` topic `E.InnerJoin` accept `E.InnerJoin` deleg `E.InnerJoin` grant `E.InnerJoin` ra `E.InnerJoin` ro `E.InnerJoin` i) -> do
+            E.on $ ro E.^. RemoteObjectInstance E.==. i E.^. InstanceId
+            E.on $ ra E.^. RemoteActorIdent E.==. ro E.^. RemoteObjectId
+            E.on $ topic E.^. DestTopicRemoteTopic E.==. ra E.^. RemoteActorId
+            E.on $ deleg E.^. DestThemSendDelegatorRemoteGrant E.==. grant E.^. RemoteActivityId
+            E.on $ accept E.^. DestUsAcceptId E.==. deleg E.^. DestThemSendDelegatorRemoteDest
+            E.on $ dest E.^. DestId E.==. accept E.^. DestUsAcceptDest
+            E.on $ dest E.^. DestId E.==. topic E.^. DestTopicRemoteDest
+            E.on $ dest E.^. DestId E.==. holder E.^. DestHolderGroupDest
+            E.where_ $ holder E.^. DestHolderGroupGroup E.==. E.val groupID
+            E.orderBy [E.asc $ grant E.^. RemoteActivityReceived]
+            return
+                ( dest E.^. DestRole
+                , grant E.^. RemoteActivityReceived
+                , i
+                , ro
+                , ra
+                )
+
+    getHtml groupID group actor children = do
+        $(widgetFile "group/children")
+
+getGroupChildLocalLiveR :: KeyHashid Group -> KeyHashid DestThemSendDelegatorLocal -> Handler ()
+getGroupChildLocalLiveR groupHash delegHash = do
+    groupID <- decodeKeyHashid404 groupHash
+    delegID <- decodeKeyHashid404 delegHash
+    runDB $ do
+        _ <- get404 groupID
+        DestThemSendDelegatorLocal _ localID _ <- get404 delegID
+        DestTopicLocal destID <- getJust localID
+        Entity _ (DestHolderGroup _ g) <-
+            getBy404 $ UniqueDestHolderGroup destID
+        unless (g == groupID) notFound
+
+getGroupChildRemoteLiveR :: KeyHashid Group -> KeyHashid DestThemSendDelegatorRemote -> Handler ()
+getGroupChildRemoteLiveR groupHash delegHash = do
+    groupID <- decodeKeyHashid404 groupHash
+    delegID <- decodeKeyHashid404 delegHash
+    runDB $ do
+        _ <- get404 groupID
+        DestThemSendDelegatorRemote _ remoteID _ <- get404 delegID
+        DestTopicRemote destID _ <- getJust remoteID
+        Entity _ (DestHolderGroup _ g) <-
+            getBy404 $ UniqueDestHolderGroup destID
+        unless (g == groupID) notFound
+
+getGroupParentsR :: KeyHashid Group -> Handler TypedContent
+getGroupParentsR groupHash = do
+    groupID <- decodeKeyHashid404 groupHash
+    (actor, group, parents) <- runDB $ do
+        group <- get404 groupID
+        actor <- getJust $ groupActor group
+        parents <- getParents groupID
+        return (actor, group, parents)
+    encodeRouteHome <- getEncodeRouteHome
+    encodeRouteLocal <- getEncodeRouteLocal
+    hashGroup <- getEncodeKeyHashid
+    h <- asksSite siteInstanceHost
+    let makeId (Left (parentID, _)) =
+            encodeRouteHome $ GroupR $ hashGroup parentID
+        makeId (Right (i, ro, _)) =
+            ObjURI (instanceHost i) (remoteObjectIdent ro)
+        makeItem (role, time, i) = AP.Relationship
+            { AP.relationshipId           = Nothing
+            , AP.relationshipExtraTypes   = []
+            , AP.relationshipSubject      = encodeRouteHome $ GroupR groupHash
+            , AP.relationshipProperty     = Left AP.RelHasParent
+            , AP.relationshipObject       = makeId i
+            , AP.relationshipAttributedTo = encodeRouteLocal $ GroupR groupHash
+            , AP.relationshipPublished    = Just time
+            , AP.relationshipUpdated      = Nothing
+            , AP.relationshipInstrument   = Just role
+            }
+        parentsAP = Collection
+            { collectionId         = encodeRouteLocal $ GroupParentsR groupHash
+            , collectionType       = CollectionTypeUnordered
+            , collectionTotalItems = Just $ length parents
+            , collectionCurrent    = Nothing
+            , collectionFirst      = Nothing
+            , collectionLast       = Nothing
+            , collectionItems      = map (Doc h . makeItem) parents
+            , collectionContext    =
+                Just $ encodeRouteLocal $ GroupR groupHash
+            }
+    provideHtmlAndAP parentsAP $ getHtml groupID group actor parents
+
+    where
+
+    getParents groupID = fmap (sortOn $ view _2) $ liftA2 (++)
+        (map (\ (E.Value role, E.Value time, E.Value parent, Entity _ actor) ->
+                (role, time, Left (parent, actor))
+             )
+            <$> getLocals groupID
+        )
+        (map (\ (E.Value role, E.Value time, Entity _ i, Entity _ ro, Entity _ ra) ->
+                (role, time, Right (i, ro, ra))
+             )
+            <$> getRemotes groupID
+        )
+
+    getLocals groupID =
+        E.select $ E.from $ \ (source `E.InnerJoin` holder `E.InnerJoin` topic `E.InnerJoin` group `E.InnerJoin` actor `E.InnerJoin` deleg `E.InnerJoin` grant) -> do
+            E.on $ deleg E.^. SourceUsSendDelegatorGrant E.==. grant E.^. OutboxItemId
+            E.on $ source E.^. SourceId E.==. deleg E.^. SourceUsSendDelegatorSource
+            E.on $ group E.^. GroupActor E.==. actor E.^. ActorId
+            E.on $ topic E.^. SourceTopicGroupParent E.==. group E.^. GroupId
+            E.on $ holder E.^. SourceHolderGroupId E.==. topic E.^. SourceTopicGroupHolder
+            E.on $ source E.^. SourceId E.==. holder E.^. SourceHolderGroupSource
+            E.where_ $ holder E.^. SourceHolderGroupGroup E.==. E.val groupID
+            E.orderBy [E.asc $ deleg E.^. SourceUsSendDelegatorId]
+            return
+                ( source E.^. SourceRole
+                , grant E.^. OutboxItemPublished
+                , topic E.^. SourceTopicGroupParent
+                , actor
+                )
+
+    getRemotes groupID =
+        E.select $ E.from $ \ (source `E.InnerJoin` holder `E.InnerJoin` topic `E.InnerJoin` deleg `E.InnerJoin` grant `E.InnerJoin` ra `E.InnerJoin` ro `E.InnerJoin` i) -> do
+            E.on $ ro E.^. RemoteObjectInstance E.==. i E.^. InstanceId
+            E.on $ ra E.^. RemoteActorIdent E.==. ro E.^. RemoteObjectId
+            E.on $ topic E.^. SourceTopicRemoteTopic E.==. ra E.^. RemoteActorId
+            E.on $ deleg E.^. SourceUsSendDelegatorGrant E.==. grant E.^. OutboxItemId
+            E.on $ source E.^. SourceId E.==. deleg E.^. SourceUsSendDelegatorSource
+            E.on $ source E.^. SourceId E.==. topic E.^. SourceTopicRemoteSource
+            E.on $ source E.^. SourceId E.==. holder E.^. SourceHolderGroupSource
+            E.where_ $ holder E.^. SourceHolderGroupGroup E.==. E.val groupID
+            E.orderBy [E.asc $ deleg E.^. SourceUsSendDelegatorId]
+            return
+                ( source E.^. SourceRole
+                , grant E.^. OutboxItemPublished
+                , i
+                , ro
+                , ra
+                )
+
+    getHtml groupID group actor parents = do
+        $(widgetFile "group/parents")
 
 
 

src/Vervis/Handler/Loom.hs

@@ -78,7 +78,6 @@ import Yesod.Persist.Local
 import Vervis.Access
 import Vervis.API
 import Vervis.Federation.Auth
-import Vervis.Federation.Collab
 import Vervis.Federation.Discussion
 import Vervis.Federation.Offer
 import Vervis.Federation.Ticket

src/Vervis/Handler/Person.hs

@@ -73,7 +73,6 @@ import Vervis.ActivityPub
 import Vervis.API
 import Vervis.Data.Actor
 import Vervis.Federation.Auth
-import Vervis.Federation.Collab
 import Vervis.Federation.Discussion
 import Vervis.Federation.Offer
 import Vervis.FedURI

src/Vervis/Handler/Project.hs

@@ -38,6 +38,11 @@ module Vervis.Handler.Project
 
     , getProjectInviteCompR
     , postProjectInviteCompR
+
+    , getProjectChildrenR
+    , getProjectParentsR
+    , getProjectParentLocalLiveR
+    , getProjectParentRemoteLiveR
     )
 where
 
@@ -51,12 +56,14 @@ import Data.Bitraversable
 import Data.ByteString (ByteString)
 import Data.Default.Class
 import Data.Foldable
+import Data.List
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Data.Time.Clock
 import Data.Traversable
 import Database.Persist
 import Network.HTTP.Types.Method
+import Optics.Core
 import Text.Blaze.Html (Html)
 import Yesod.Auth (requireAuth)
 import Yesod.Core
@@ -90,7 +97,6 @@ import Vervis.Access
 import Vervis.API
 import Vervis.Data.Collab
 import Vervis.Federation.Auth
-import Vervis.Federation.Collab
 import Vervis.Federation.Discussion
 import Vervis.Federation.Offer
 import Vervis.Federation.Ticket
@@ -153,8 +159,8 @@ getProjectR projectHash = do
                     }
                 }
             , AP.projectTracker    = Nothing
-            , AP.projectChildren   = []
+            , AP.projectChildren   = encodeRouteLocal $ ProjectChildrenR projectHash
-            , AP.projectParents    = []
+            , AP.projectParents    = encodeRouteLocal $ ProjectParentsR projectHash
             , AP.projectComponents =
                 encodeRouteLocal $ ProjectComponentsR projectHash
             , AP.projectCollaborators =
@@ -564,3 +570,215 @@ postProjectInviteCompR projectHash = do
         Right inviteID -> do
             setMessage "Invite sent"
             redirect $ ProjectComponentsR projectHash
+
+getProjectChildrenR :: KeyHashid Project -> Handler TypedContent
+getProjectChildrenR projectHash = do
+    projectID <- decodeKeyHashid404 projectHash
+    (actor, project, children) <- runDB $ do
+        project <- get404 projectID
+        actor <- getJust $ projectActor project
+        children <- getChildren projectID
+        return (actor, project, children)
+    encodeRouteHome <- getEncodeRouteHome
+    encodeRouteLocal <- getEncodeRouteLocal
+    hashProject <- getEncodeKeyHashid
+    h <- asksSite siteInstanceHost
+    let makeId (Left (childID, _)) =
+            encodeRouteHome $ ProjectR $ hashProject childID
+        makeId (Right (i, ro, _)) =
+            ObjURI (instanceHost i) (remoteObjectIdent ro)
+        makeItem (role, time, i) = AP.Relationship
+            { AP.relationshipId           = Nothing
+            , AP.relationshipExtraTypes   = []
+            , AP.relationshipSubject      = encodeRouteHome $ ProjectR projectHash
+            , AP.relationshipProperty     = Left AP.RelHasChild
+            , AP.relationshipObject       = makeId i
+            , AP.relationshipAttributedTo = encodeRouteLocal $ ProjectR projectHash
+            , AP.relationshipPublished    = Just time
+            , AP.relationshipUpdated      = Nothing
+            , AP.relationshipInstrument   = Just role
+            }
+        childrenAP = Collection
+            { collectionId         = encodeRouteLocal $ ProjectChildrenR projectHash
+            , collectionType       = CollectionTypeUnordered
+            , collectionTotalItems = Just $ length children
+            , collectionCurrent    = Nothing
+            , collectionFirst      = Nothing
+            , collectionLast       = Nothing
+            , collectionItems      = map (Doc h . makeItem) children
+            , collectionContext    =
+                Just $ encodeRouteLocal $ ProjectR projectHash
+            }
+    provideHtmlAndAP childrenAP $ getHtml projectID project actor children
+
+    where
+
+    getChildren projectID = fmap (sortOn $ view _2) $ liftA2 (++)
+        (map (\ (E.Value role, E.Value time, E.Value child, Entity _ actor) ->
+                (role, time, Left (child, actor))
+             )
+            <$> getLocals projectID
+        )
+        (map (\ (E.Value role, E.Value time, Entity _ i, Entity _ ro, Entity _ ra) ->
+                (role, time, Right (i, ro, ra))
+             )
+            <$> getRemotes projectID
+        )
+
+    getLocals projectID =
+        E.select $ E.from $ \ (source `E.InnerJoin` holder `E.InnerJoin` topic `E.InnerJoin` project `E.InnerJoin` actor `E.InnerJoin` deleg `E.InnerJoin` grant) -> do
+            E.on $ deleg E.^. SourceUsSendDelegatorGrant E.==. grant E.^. OutboxItemId
+            E.on $ source E.^. SourceId E.==. deleg E.^. SourceUsSendDelegatorSource
+            E.on $ project E.^. ProjectActor E.==. actor E.^. ActorId
+            E.on $ topic E.^. SourceTopicProjectChild E.==. project E.^. ProjectId
+            E.on $ holder E.^. SourceHolderProjectId E.==. topic E.^. SourceTopicProjectHolder
+            E.on $ source E.^. SourceId E.==. holder E.^. SourceHolderProjectSource
+            E.where_ $ holder E.^. SourceHolderProjectProject E.==. E.val projectID
+            E.orderBy [E.asc $ deleg E.^. SourceUsSendDelegatorId]
+            return
+                ( source E.^. SourceRole
+                , grant E.^. OutboxItemPublished
+                , topic E.^. SourceTopicProjectChild
+                , actor
+                )
+
+    getRemotes projectID =
+        E.select $ E.from $ \ (source `E.InnerJoin` holder `E.InnerJoin` topic `E.InnerJoin` deleg `E.InnerJoin` grant `E.InnerJoin` ra `E.InnerJoin` ro `E.InnerJoin` i) -> do
+            E.on $ ro E.^. RemoteObjectInstance E.==. i E.^. InstanceId
+            E.on $ ra E.^. RemoteActorIdent E.==. ro E.^. RemoteObjectId
+            E.on $ topic E.^. SourceTopicRemoteTopic E.==. ra E.^. RemoteActorId
+            E.on $ deleg E.^. SourceUsSendDelegatorGrant E.==. grant E.^. OutboxItemId
+            E.on $ source E.^. SourceId E.==. deleg E.^. SourceUsSendDelegatorSource
+            E.on $ source E.^. SourceId E.==. topic E.^. SourceTopicRemoteSource
+            E.on $ source E.^. SourceId E.==. holder E.^. SourceHolderProjectSource
+            E.where_ $ holder E.^. SourceHolderProjectProject E.==. E.val projectID
+            E.orderBy [E.asc $ deleg E.^. SourceUsSendDelegatorId]
+            return
+                ( source E.^. SourceRole
+                , grant E.^. OutboxItemPublished
+                , i
+                , ro
+                , ra
+                )
+
+    getHtml projectID project actor children = do
+        $(widgetFile "project/children")
+
+getProjectParentsR :: KeyHashid Project -> Handler TypedContent
+getProjectParentsR projectHash = do
+    projectID <- decodeKeyHashid404 projectHash
+    (actor, project, parents) <- runDB $ do
+        project <- get404 projectID
+        actor <- getJust $ projectActor project
+        parents <- getParents projectID
+        return (actor, project, parents)
+    encodeRouteHome <- getEncodeRouteHome
+    encodeRouteLocal <- getEncodeRouteLocal
+    hashProject <- getEncodeKeyHashid
+    h <- asksSite siteInstanceHost
+    let makeId (Left (parentID, _)) =
+            encodeRouteHome $ ProjectR $ hashProject parentID
+        makeId (Right (i, ro, _)) =
+            ObjURI (instanceHost i) (remoteObjectIdent ro)
+        makeItem (role, time, i) = AP.Relationship
+            { AP.relationshipId           = Nothing
+            , AP.relationshipExtraTypes   = []
+            , AP.relationshipSubject      = encodeRouteHome $ ProjectR projectHash
+            , AP.relationshipProperty     = Left AP.RelHasParent
+            , AP.relationshipObject       = makeId i
+            , AP.relationshipAttributedTo = encodeRouteLocal $ ProjectR projectHash
+            , AP.relationshipPublished    = Just time
+            , AP.relationshipUpdated      = Nothing
+            , AP.relationshipInstrument   = Just role
+            }
+        parentsAP = Collection
+            { collectionId         = encodeRouteLocal $ ProjectParentsR projectHash
+            , collectionType       = CollectionTypeUnordered
+            , collectionTotalItems = Just $ length parents
+            , collectionCurrent    = Nothing
+            , collectionFirst      = Nothing
+            , collectionLast       = Nothing
+            , collectionItems      = map (Doc h . makeItem) parents
+            , collectionContext    =
+                Just $ encodeRouteLocal $ ProjectR projectHash
+            }
+    provideHtmlAndAP parentsAP $ getHtml projectID project actor parents
+
+    where
+
+    getParents projectID = fmap (sortOn $ view _2) $ liftA2 (++)
+        (map (\ (E.Value role, E.Value time, E.Value parent, Entity _ actor) ->
+                (role, time, Left (parent, actor))
+             )
+            <$> getLocals projectID
+        )
+        (map (\ (E.Value role, E.Value time, Entity _ i, Entity _ ro, Entity _ ra) ->
+                (role, time, Right (i, ro, ra))
+             )
+            <$> getRemotes projectID
+        )
+
+    getLocals projectID =
+        E.select $ E.from $ \ (dest `E.InnerJoin` holder `E.InnerJoin` topic `E.InnerJoin` project `E.InnerJoin` actor `E.InnerJoin` accept `E.InnerJoin` deleg `E.InnerJoin` grant) -> do
+            E.on $ deleg E.^. DestThemSendDelegatorLocalGrant E.==. grant E.^. OutboxItemId
+            E.on $ accept E.^. DestUsAcceptId E.==. deleg E.^. DestThemSendDelegatorLocalDest
+            E.on $ dest E.^. DestId E.==. accept E.^. DestUsAcceptDest
+            E.on $ project E.^. ProjectActor E.==. actor E.^. ActorId
+            E.on $ topic E.^. DestTopicProjectParent E.==. project E.^. ProjectId
+            E.on $ holder E.^. DestHolderProjectId E.==. topic E.^. DestTopicProjectHolder
+            E.on $ dest E.^. DestId E.==. holder E.^. DestHolderProjectDest
+            E.where_ $ holder E.^. DestHolderProjectProject E.==. E.val projectID
+            E.orderBy [E.asc $ grant E.^. OutboxItemPublished]
+            return
+                ( dest E.^. DestRole
+                , grant E.^. OutboxItemPublished
+                , topic E.^. DestTopicProjectParent
+                , actor
+                )
+
+    getRemotes projectID =
+        E.select $ E.from $ \ (dest `E.InnerJoin` holder `E.InnerJoin` topic `E.InnerJoin` accept `E.InnerJoin` deleg `E.InnerJoin` grant `E.InnerJoin` ra `E.InnerJoin` ro `E.InnerJoin` i) -> do
+            E.on $ ro E.^. RemoteObjectInstance E.==. i E.^. InstanceId
+            E.on $ ra E.^. RemoteActorIdent E.==. ro E.^. RemoteObjectId
+            E.on $ topic E.^. DestTopicRemoteTopic E.==. ra E.^. RemoteActorId
+            E.on $ deleg E.^. DestThemSendDelegatorRemoteGrant E.==. grant E.^. RemoteActivityId
+            E.on $ accept E.^. DestUsAcceptId E.==. deleg E.^. DestThemSendDelegatorRemoteDest
+            E.on $ dest E.^. DestId E.==. accept E.^. DestUsAcceptDest
+            E.on $ dest E.^. DestId E.==. topic E.^. DestTopicRemoteDest
+            E.on $ dest E.^. DestId E.==. holder E.^. DestHolderProjectDest
+            E.where_ $ holder E.^. DestHolderProjectProject E.==. E.val projectID
+            E.orderBy [E.asc $ grant E.^. RemoteActivityReceived]
+            return
+                ( dest E.^. DestRole
+                , grant E.^. RemoteActivityReceived
+                , i
+                , ro
+                , ra
+                )
+
+    getHtml projectID project actor parents = do
+        $(widgetFile "project/parents")
+
+getProjectParentLocalLiveR :: KeyHashid Project -> KeyHashid DestThemSendDelegatorLocal -> Handler ()
+getProjectParentLocalLiveR projectHash delegHash = do
+    projectID <- decodeKeyHashid404 projectHash
+    delegID <- decodeKeyHashid404 delegHash
+    runDB $ do
+        _ <- get404 projectID
+        DestThemSendDelegatorLocal _ localID _ <- get404 delegID
+        DestTopicLocal destID <- getJust localID
+        Entity _ (DestHolderProject _ j) <-
+            getBy404 $ UniqueDestHolderProject destID
+        unless (j == projectID) notFound
+
+getProjectParentRemoteLiveR :: KeyHashid Project -> KeyHashid DestThemSendDelegatorRemote -> Handler ()
+getProjectParentRemoteLiveR projectHash delegHash = do
+    projectID <- decodeKeyHashid404 projectHash
+    delegID <- decodeKeyHashid404 delegHash
+    runDB $ do
+        _ <- get404 projectID
+        DestThemSendDelegatorRemote _ remoteID _ <- get404 delegID
+        DestTopicRemote destID _ <- getJust remoteID
+        Entity _ (DestHolderProject _ j) <-
+            getBy404 $ UniqueDestHolderProject destID
+        unless (j == projectID) notFound

src/Vervis/Handler/Repo.hs

@@ -165,7 +165,6 @@ import Vervis.Access
 import Vervis.ActivityPub
 import Vervis.API
 import Vervis.Federation.Auth
-import Vervis.Federation.Collab
 import Vervis.Federation.Offer
 import Vervis.FedURI
 import Vervis.Form.Repo

src/Vervis/Migration.hs

@@ -3121,6 +3121,83 @@ changes hLocal ctx =
     , addUnique' "ComponentFurtherRemote" "" ["component", "collab"]
       -- 564
     , addEntities model_564_permit
+      -- 565
+    , removeUnique' "PermitTopicExtendLocal" ""
+      -- 566
+    , removeUnique' "PermitTopicExtendLocal" "Topic"
+      -- 567
+    , removeUnique' "PermitTopicExtendRemote" ""
+      -- 568
+    , removeUnique' "PermitTopicExtendRemote" "Topic"
+      -- 569
+    , unchecked $ lift $ do
+        recips <- selectList [] []
+        for_ recips $ \ (Entity recipID (CollabRecipLocal565 collabID personID)) -> do
+            Collab565 role <- getJust collabID
+            permitID <- insert $ Permit565 personID role
+            topicID <- insert $ PermitTopicLocal565 permitID
+
+            mr <- getValBy $ UniqueCollabTopicRepo565 collabID
+            for_ mr $ \ (CollabTopicRepo565 _ repoID) ->
+                insert_ $ PermitTopicRepo565 topicID repoID
+            md <- getValBy $ UniqueCollabTopicDeck565 collabID
+            for_ md $ \ (CollabTopicDeck565 _ deckID) ->
+                insert_ $ PermitTopicDeck565 topicID deckID
+            ml <- getValBy $ UniqueCollabTopicLoom565 collabID
+            for_ ml $ \ (CollabTopicLoom565 _ loomID) ->
+                insert_ $ PermitTopicLoom565 topicID loomID
+            mj <- getValBy $ UniqueCollabTopicProject565 collabID
+            for_ mj $ \ (CollabTopicProject565 _ projectID) ->
+                insert_ $ PermitTopicProject565 topicID projectID
+            mg <- getValBy $ UniqueCollabTopicGroup565 collabID
+            for_ mg $ \ (CollabTopicGroup565 _ groupID) ->
+                insert_ $ PermitTopicGroup565 topicID groupID
+
+            fc <- getKeyBy $ UniqueCollabFulfillsLocalTopicCreation565 collabID
+            g1 <- for fc $ \ fulfillsID -> do
+                insert_ $ PermitFulfillsTopicCreation565 permitID
+                actorID <- person565Actor <$> getJust personID
+                outboxID <- actor565Outbox <$> getJust actorID
+                let doc = persistJSONObjectFromDoc $ Doc hLocal emptyActivity
+                createID <- insert $ OutboxItem565 outboxID doc defaultTime
+                insert $ PermitPersonGesture565 permitID createID
+
+            fi <- getBy $ UniqueCollabFulfillsInvite565 collabID
+            g2 <- for fi $ \ (Entity fulfillsID (CollabFulfillsInvite565 _ acceptID)) -> do
+                pfi <- insert $ PermitFulfillsInvite565 permitID
+                l <- getValBy $ UniqueCollabInviterLocal565 fulfillsID
+                for_ l $ \ (CollabInviterLocal565 _ inviteID) ->
+                    insert_ $ PermitTopicGestureLocal565 pfi inviteID
+                r <- getValBy $ UniqueCollabInviterRemote565 fulfillsID
+                for_ r $ \ (CollabInviterRemote565 _ actorID inviteID) ->
+                    insert_ $ PermitTopicGestureRemote565 pfi actorID inviteID
+                insert_ $ PermitTopicAcceptLocal565 pfi topicID acceptID
+                a <- getValBy $ UniqueCollabRecipLocalAcceptCollab565 recipID
+                for a $ \ (CollabRecipLocalAccept565 _ _ acceptID) ->
+                    insert $ PermitPersonGesture565 permitID acceptID
+
+            fj <- getKeyBy $ UniqueCollabFulfillsJoin565 collabID
+            g3 <- for fj $ \ fulfillsID -> do
+                CollabRecipLocalJoin565 _ _ joinID <- getValByJust $ UniqueCollabRecipLocalJoinCollab565 recipID
+                insert $ PermitPersonGesture565 permitID joinID
+
+            me <- getValBy $ UniqueCollabEnable565 collabID
+            for_ (liftA2 (,) me (g1 <|> join g2 <|> g3)) $ \ (CollabEnable565 _ grantID, gestureID) -> do
+                enableID <- insert $ PermitTopicEnableLocal565 gestureID topicID grantID
+                d <- getBy $ UniqueCollabDelegLocalRecip565 recipID
+                for_ d $ \ (Entity cdl (CollabDelegLocal565 _ _ delegID)) -> do
+                    sendID <- insert $ PermitPersonSendDelegator565 gestureID delegID
+                    for_ mj $ \ (CollabTopicProject565 _ projectID) -> do
+                        gs <- E.select $ E.from $ \ (enable `E.InnerJoin` comp `E.InnerJoin` further) -> do
+                            E.on $ enable E.^. ComponentEnable565Id E.==. further E.^. ComponentFurtherLocal565Component
+                            E.on $ enable E.^. ComponentEnable565Component E.==. comp E.^. Component565Id
+                            E.where_ $
+                                comp E.^. Component565Project E.==. E.val projectID E.&&.
+                                further E.^. ComponentFurtherLocal565Collab E.==. E.val cdl
+                            return $ further E.^. ComponentFurtherLocal565Grant
+                        insertMany_ $ map (PermitTopicExtendLocal565 sendID enableID . E.unValue) gs
+      -- 570
+    , addEntities model_570_source_dest
     ]
 
 migrateDB

src/Vervis/Migration/Entities.hs

@@ -67,6 +67,7 @@ module Vervis.Migration.Entities
     , model_551_group_collab
     , model_552_collab_deleg
     , model_564_permit
+    , model_570_source_dest
     )
 where
 
@@ -260,3 +261,6 @@ model_552_collab_deleg = $(schema "552_2023-11-21_collab_deleg")
 
 model_564_permit :: [Entity SqlBackend]
 model_564_permit = $(schema "564_2023-11-22_permit")
+
+model_570_source_dest :: [Entity SqlBackend]
+model_570_source_dest = $(schema "570_2023-12-09_source_dest")

src/Vervis/Migration/Model.hs

@@ -537,3 +537,6 @@ makeEntitiesMigration "553"
 
 makeEntitiesMigration "554"
     $(modelFile "migrations/554_2023-11-21_further_local_deleg.model")
+
+makeEntitiesMigration "565"
+    $(modelFile "migrations/565_2023-12-09_collab_permit.model")

src/Vervis/Persist/Collab.hs

@@ -17,6 +17,7 @@ module Vervis.Persist.Collab
     ( getCollabTopic
     , getCollabTopic'
     , getCollabRecip
+    , getPermitTopicLocal
     , getPermitTopic
     , getStemIdent
     , getStemProject
@@ -112,6 +113,29 @@ getCollabRecip collabID =
         "Collab without recip"
         "Collab with both local and remote recip"
 
+getPermitTopicLocal
+    :: MonadIO m
+    => PermitTopicLocalId
+    -> ReaderT SqlBackend m (LocalActorBy Key)
+getPermitTopicLocal localID = do
+    options <-
+        sequence
+            [ fmap (LocalActorRepo . permitTopicRepoRepo) <$>
+                getValBy (UniquePermitTopicRepo localID)
+            , fmap (LocalActorDeck . permitTopicDeckDeck) <$>
+                getValBy (UniquePermitTopicDeck localID)
+            , fmap (LocalActorLoom . permitTopicLoomLoom) <$>
+                getValBy (UniquePermitTopicLoom localID)
+            , fmap (LocalActorProject . permitTopicProjectProject) <$>
+                getValBy (UniquePermitTopicProject localID)
+            , fmap (LocalActorGroup . permitTopicGroupGroup) <$>
+                getValBy (UniquePermitTopicGroup localID)
+            ]
+    exactlyOneJust
+        options
+        "Found Permit without topic"
+        "Found Permit with multiple topics"
+
 getPermitTopic
     :: MonadIO m
     => PermitId
@@ -128,25 +152,7 @@ getPermitTopic permitID = do
             "Permit without topic"
             "Permit with both local and remote topic"
     bitraverse
-        (\ localID -> (localID,) <$> do
+        (\ localID -> (localID,) <$> getPermitTopicLocal localID)
-            options <-
-                sequence
-                    [ fmap (LocalActorRepo . permitTopicRepoRepo) <$>
-                        getValBy (UniquePermitTopicRepo localID)
-                    , fmap (LocalActorDeck . permitTopicDeckDeck) <$>
-                        getValBy (UniquePermitTopicDeck localID)
-                    , fmap (LocalActorLoom . permitTopicLoomLoom) <$>
-                        getValBy (UniquePermitTopicLoom localID)
-                    , fmap (LocalActorProject . permitTopicProjectProject) <$>
-                        getValBy (UniquePermitTopicProject localID)
-                    , fmap (LocalActorGroup . permitTopicGroupGroup) <$>
-                        getValBy (UniquePermitTopicGroup localID)
-                    ]
-            exactlyOneJust
-                options
-                "Found Permit without topic"
-                "Found Permit with multiple topics"
-        )
         (\ (Entity topicID (PermitTopicRemote _ actorID)) ->
             return (topicID, actorID)
         )

src/Vervis/Widget/Person.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016, 2019, 2022 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2019, 2022, 2023 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -31,6 +31,8 @@ import Network.FedURI
 import Yesod.Auth.Unverified
 import Yesod.Hashids
 
+import qualified Web.ActivityPub as AP
+
 import Database.Persist.Local
 
 import Vervis.Foundation
@@ -54,13 +56,22 @@ personLinkFedW (Left (ep, a)) = personLinkW ep a
 personLinkFedW (Right (inztance, object, actor)) =
     [whamlet|
         <a href="#{renderObjURI uActor}">
+          #{marker $ remoteActorType actor} #
           $maybe name <- remoteActorName actor
-            #{name}
+            #{name} @ #{renderAuthority $ instanceHost inztance}
           $nothing
             #{renderAuthority $ instanceHost inztance}#{localUriPath $ remoteObjectIdent object}
     |]
     where
     uActor = ObjURI (instanceHost inztance) (remoteObjectIdent object)
+    marker = \case
+        AP.ActorTypePerson -> '~'
+        AP.ActorTypeRepo -> '^'
+        AP.ActorTypeTicketTracker -> '='
+        AP.ActorTypePatchTracker -> '+'
+        AP.ActorTypeProject -> '$'
+        AP.ActorTypeTeam -> '&'
+        AP.ActorTypeOther _ -> '?'
 
 followW :: Route App -> Route App -> FollowerSetId -> Widget
 followW followRoute unfollowRoute fsid = do

src/Vervis/Widget/Tracker.hs

@@ -19,19 +19,28 @@ module Vervis.Widget.Tracker
     , projectNavW
     , componentLinkFedW
     , projectLinkFedW
+    , groupLinkFedW
+    , actorLinkFedW
     , groupNavW
     )
 where
 
+import Data.Bifunctor
+import Database.Persist
 import Database.Persist.Types
 import Yesod.Core.Widget
+import Yesod.Persist.Core
 
 import Network.FedURI
 import Yesod.Hashids
 
+import qualified Web.ActivityPub as AP
+
+import Vervis.Actor
 import Vervis.Data.Collab
 import Vervis.Foundation
 import Vervis.Model
+import Vervis.Model.Ident
 import Vervis.Settings
 
 deckNavW :: Entity Deck -> Actor -> Widget
@@ -94,19 +103,72 @@ componentLinkFedW (Right (inztance, object, actor)) =
 projectLinkFedW
     :: Either (ProjectId, Actor) (Instance, RemoteObject, RemoteActor)
     -> Widget
-projectLinkFedW (Left (j, actor)) = do
+projectLinkFedW = actorLinkFedW . bimap (first LocalActorProject) id
-    h <- encodeKeyHashid j
+
+groupLinkFedW
+    :: Either (GroupId, Actor) (Instance, RemoteObject, RemoteActor)
+    -> Widget
+groupLinkFedW = actorLinkFedW . bimap (first LocalActorGroup) id
+
+actorLinkW :: LocalActorBy Key -> Actor -> Widget
+actorLinkW (LocalActorPerson k) actor = do
+    p <- handlerToWidget $ runDB $ getJust k
+    h <- encodeKeyHashid k
+    [whamlet|
+        <a href=@{PersonR h}>
+          ~#{username2text $ personUsername p} #{actorName actor}
+    |]
+actorLinkW (LocalActorRepo k) actor = do
+    h <- encodeKeyHashid k
+    [whamlet|
+        <a href=@{RepoR h}>
+          ^#{keyHashidText h} #{actorName actor}
+    |]
+actorLinkW (LocalActorDeck k) actor = do
+    h <- encodeKeyHashid k
+    [whamlet|
+        <a href=@{DeckR h}>
+          =#{keyHashidText h} #{actorName actor}
+    |]
+actorLinkW (LocalActorLoom k) actor = do
+    h <- encodeKeyHashid k
+    [whamlet|
+        <a href=@{LoomR h}>
+          +#{keyHashidText h} #{actorName actor}
+    |]
+actorLinkW (LocalActorProject k) actor = do
+    h <- encodeKeyHashid k
     [whamlet|
         <a href=@{ProjectR h}>
           \$#{keyHashidText h} #{actorName actor}
     |]
-projectLinkFedW (Right (inztance, object, actor)) =
+actorLinkW (LocalActorGroup k) actor = do
+    h <- encodeKeyHashid k
+    [whamlet|
+        <a href=@{GroupR h}>
+          &#{keyHashidText h} #{actorName actor}
+    |]
+
+actorLinkFedW
+    :: Either (LocalActorBy Key, Actor) (Instance, RemoteObject, RemoteActor)
+    -> Widget
+actorLinkFedW (Left (c, a)) = actorLinkW c a
+actorLinkFedW (Right (inztance, object, actor)) =
     [whamlet|
         <a href="#{renderObjURI uActor}">
+          #{marker $ remoteActorType actor} #
           $maybe name <- remoteActorName actor
-            #{name}
+            #{name} @ #{renderAuthority $ instanceHost inztance}
           $nothing
             #{renderAuthority $ instanceHost inztance}#{localUriPath $ remoteObjectIdent object}
     |]
     where
     uActor = ObjURI (instanceHost inztance) (remoteObjectIdent object)
+    marker = \case
+        AP.ActorTypePerson -> '~'
+        AP.ActorTypeRepo -> '^'
+        AP.ActorTypeTicketTracker -> '='
+        AP.ActorTypePatchTracker -> '+'
+        AP.ActorTypeProject -> '$'
+        AP.ActorTypeTeam -> '&'
+        AP.ActorTypeOther _ -> '?'

src/Web/ActivityPub.hs

@@ -880,8 +880,8 @@ instance ActivityPub ResourceWithCollections where
 data Project u = Project
     { projectActor      :: Actor u
     , projectTracker    :: Maybe (ObjURI u)
-    , projectChildren   :: [ObjURI u]
+    , projectChildren   :: LocalURI
-    , projectParents    :: [ObjURI u]
+    , projectParents    :: LocalURI
     , projectComponents :: LocalURI
     , projectCollaborators :: LocalURI
     }
@@ -895,36 +895,22 @@ instance ActivityPub Project where
         fmap (h,) $
             Project a
                 <$> o .:? "ticketsTrackedBy"
-                <*> (do c <- o .: "subprojects"
+                <*> withAuthorityO h (o .: "subprojects")
-                        typ <- c .: "type"
+                <*> withAuthorityO h (o .: "context")
-                        unless (typ == ("Collection" :: Text)) $
-                            fail "subprojects.type isn't Collection"
-                        items <- c .: "items"
-                        mtotal <- c .:? "totalItems"
-                        for_ mtotal $ \ total ->
-                            unless (length items == total) $
-                                fail "Incorrect totalItems"
-                        return items
-                    )
-                <*> o .:? "context" .!= []
                 <*> withAuthorityO h (o .: "components")
                 <*> withAuthorityO h (o .: "collaborators")
     toSeries h (Project actor tracker children parents components collabs)
         =  toSeries h actor
         <> "ticketsTrackedBy" .=? tracker
-        <> "subprojects" `pair` pairs
+        <> "subprojects"    .= ObjURI h children
-            (  "type"       .= ("Collection" :: Text)
+        <> "context"        .= ObjURI h parents
-            <> "items"      .= children
-            <> "totalItems" .= length children
-            )
-        <> "context"        .= parents
         <> "components"     .= ObjURI h components
         <> "collaborators"  .= ObjURI h collabs
 
 data Team u = Team
     { teamActor    :: Actor u
-    , teamChildren :: [ObjURI u]
+    , teamChildren :: LocalURI
-    , teamParents  :: [ObjURI u]
+    , teamParents  :: LocalURI
     , teamMembers  :: LocalURI
     }
 
@@ -936,27 +922,13 @@ instance ActivityPub Team where
             fail "Actor type isn't Team"
         fmap (h,) $
             Team a
-                <$> (do c <- o .: "subteams"
+                <$> withAuthorityO h (o .: "subteams")
-                        typ <- c .: "type"
+                <*> withAuthorityO h (o .: "context")
-                        unless (typ == ("Collection" :: Text)) $
-                            fail "subteams.type isn't Collection"
-                        items <- c .: "items"
-                        mtotal <- c .:? "totalItems"
-                        for_ mtotal $ \ total ->
-                            unless (length items == total) $
-                                fail "Incorrect totalItems"
-                        return items
-                    )
-                <*> o .:? "context" .!= []
                 <*> withAuthorityO h (o .: "members")
     toSeries h (Team actor children parents members)
         =  toSeries h actor
-        <> "subteams" `pair` pairs
+        <> "subteams"       .= ObjURI h children
-            (  "type"       .= ("Collection" :: Text)
+        <> "context"        .= ObjURI h parents
-            <> "items"      .= children
-            <> "totalItems" .= length children
-            )
-        <> "context"        .= parents
         <> "members"        .= ObjURI h members
 
 data Audience u = Audience
@@ -1120,7 +1092,7 @@ instance ActivityPub Note where
         <> "mediaType"    .=  ("text/html" :: Text)
 
 data RelationshipProperty =
-    RelDependsOn | RelHasCollab | RelHasMember
+    RelDependsOn | RelHasCollab | RelHasMember | RelHasChild | RelHasParent
     deriving Eq
 
 instance FromJSON RelationshipProperty where
@@ -1130,6 +1102,8 @@ instance FromJSON RelationshipProperty where
             | t == "dependsOn" = pure RelDependsOn
             | t == "hasCollaborator" = pure RelHasCollab
             | t == "hasMember" = pure RelHasMember
+            | t == "hasChild" = pure RelHasChild
+            | t == "hasParent" = pure RelHasParent
             | otherwise = fail $ "Unrecognized relationship: " ++ T.unpack t
 
 instance ToJSON RelationshipProperty where
@@ -1139,6 +1113,8 @@ instance ToJSON RelationshipProperty where
             RelDependsOn -> "dependsOn" :: Text
             RelHasCollab -> "hasCollaborator"
             RelHasMember -> "hasMember"
+            RelHasChild -> "hasChild"
+            RelHasParent -> "hasParent"
 
 data Relationship u = Relationship
     { relationshipId           :: Maybe (ObjURI u)

templates/group/children.hamlet

@@ -0,0 +1,28 @@
+$# This file is part of Vervis.
+$#
+$# Written in 2016, 2019, 2022, 2023 by fr33domlover <fr33domlover@riseup.net>.
+$#
+$# ♡ Copying is an act of love. Please copy, reuse and share.
+$#
+$# The author(s) have dedicated all copyright and related and neighboring
+$# rights to this software to the public domain worldwide. This software is
+$# distributed without any warranty.
+$#
+$# You should have received a copy of the CC0 Public Domain Dedication along
+$# with this software. If not, see
+$# <http://creativecommons.org/publicdomain/zero/1.0/>.
+
+^{groupNavW (Entity groupID group) actor}
+
+<h2>Children
+
+<table>
+  <tr>
+    <th>Role
+    <th>Since
+    <th>Child
+  $forall (role, since, child) <- children
+    <tr>
+      <td>#{show role}
+      <td>#{showDate since}
+      <td>^{groupLinkFedW child}

templates/group/member/new.hamlet

@@ -1,6 +1,6 @@
 $# This file is part of Vervis.
 $#
-$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+$# Written in 2016, 2023 by fr33domlover <fr33domlover@riseup.net>.
 $#
 $# ♡ Copying is an act of love. Please copy, reuse and share.
 $#
@@ -12,7 +12,7 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
 $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
-<form method=POST action=@{GroupMembersR shar} enctype=#{enctype}>
+<form method=POST action=@{GroupInviteR groupHash} enctype=#{enctype}>
   ^{widget}
   <div class="submit">
     <input type="submit">

templates/group/members.hamlet

@@ -26,7 +26,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
       <td>#{show role}
       <td>^{personLinkFedW person}
       <td>#{showDate since}
-      $#<td>^{buttonW POST "Remove" (GroupRemoveR groupHash ctID)}
+      <td>^{buttonW POST "Remove" (GroupRemoveR groupHash ctID)}
 
 <h2>Invites
 
@@ -43,7 +43,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
       <td>#{show role}
       <td>#{showDate time}
 
-$#<a href=@{ProjectInviteR projectHash}>Invite…
+<a href=@{GroupInviteR groupHash}>Invite…
 
 <h2>Joins
 

templates/group/nav.hamlet

@@ -30,5 +30,11 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
   <span>
     <a href=@{GroupMembersR groupHash}>
       [🤝 Members]
+  <span>
+    <a href=@{GroupChildrenR groupHash}>
+      [🐛 Children]
+  <span>
+    <a href=@{GroupParentsR groupHash}>
+      [🦋 Parents]
   <span>
     [✏ Edit]

templates/group/parents.hamlet

@@ -0,0 +1,28 @@
+$# This file is part of Vervis.
+$#
+$# Written in 2016, 2019, 2022, 2023 by fr33domlover <fr33domlover@riseup.net>.
+$#
+$# ♡ Copying is an act of love. Please copy, reuse and share.
+$#
+$# The author(s) have dedicated all copyright and related and neighboring
+$# rights to this software to the public domain worldwide. This software is
+$# distributed without any warranty.
+$#
+$# You should have received a copy of the CC0 Public Domain Dedication along
+$# with this software. If not, see
+$# <http://creativecommons.org/publicdomain/zero/1.0/>.
+
+^{groupNavW (Entity groupID group) actor}
+
+<h2>Parents
+
+<table>
+  <tr>
+    <th>Role
+    <th>Since
+    <th>Child
+  $forall (role, since, parent) <- parents
+    <tr>
+      <td>#{show role}
+      <td>#{showDate since}
+      <td>^{groupLinkFedW parent}

templates/personal-overview.hamlet

@@ -67,54 +67,48 @@ $#       Comment on a ticket or merge request
 <h2>Your teams
 
 <ul>
-  $forall (Entity groupID _, Entity _ actor, Entity _ (Collab role)) <- groups
+  $forall i <- groups
     <li>
-      [
+      ^{item i}
-      #{show role}
-      ]
-      <a href=@{GroupR $ hashGroup groupID}>
-        &#{keyHashidText $ hashGroup groupID} #{actorName actor}
 
 <h2>Your repos
 
 <ul>
-  $forall (Entity repoID _, Entity _ actor, Entity _ (Collab role)) <- repos
+  $forall i <- repos
     <li>
-      [
+      ^{item i}
-      #{show role}
-      ]
-      <a href=@{RepoR $ hashRepo repoID}>
-        ^#{keyHashidText $ hashRepo repoID} #{actorName actor}
 
 <h2>Your ticket trackers
 
 <ul>
-  $forall (Entity deckID _, Entity _ actor, Entity _ (Collab role)) <- decks
+  $forall i <- decks
     <li>
-      [
+      ^{item i}
-      #{show role}
-      ]
-      <a href=@{DeckR $ hashDeck deckID}>
-        =#{keyHashidText $ hashDeck deckID} #{actorName actor}
 
 <h2>Your patch trackers
 
 <ul>
-  $forall (Entity loomID _, Entity _ actor, Entity _ (Collab role)) <- looms
+  $forall i <- looms
     <li>
-      [
+      ^{item i}
-      #{show role}
-      ]
-      <a href=@{LoomR $ hashLoom loomID}>
-        +#{keyHashidText $ hashLoom loomID} #{actorName actor}
 
 <h2>Your projects
 
 <ul>
-  $forall (Entity projectID _, Entity _ actor, Entity _ (Collab role)) <- projects
+  $forall i <- projects
     <li>
-      [
+      ^{item i}
-      #{show role}
+
-      ]
+<h2>Your resources of unrecognized type
-      <a href=@{ProjectR $ hashProject projectID}>
+
-        \$#{keyHashidText $ hashProject projectID} #{actorName actor}
+<ul>
+  $forall i <- others
+    <li>
+      ^{item i}
+
+<h2>Your invites
+
+<ul>
+  $forall i <- invites
+    <li>
+      ^{invite i}

templates/project/children.hamlet

@@ -0,0 +1,28 @@
+$# This file is part of Vervis.
+$#
+$# Written in 2016, 2019, 2022, 2023 by fr33domlover <fr33domlover@riseup.net>.
+$#
+$# ♡ Copying is an act of love. Please copy, reuse and share.
+$#
+$# The author(s) have dedicated all copyright and related and neighboring
+$# rights to this software to the public domain worldwide. This software is
+$# distributed without any warranty.
+$#
+$# You should have received a copy of the CC0 Public Domain Dedication along
+$# with this software. If not, see
+$# <http://creativecommons.org/publicdomain/zero/1.0/>.
+
+^{projectNavW (Entity projectID project) actor}
+
+<h2>Children
+
+<table>
+  <tr>
+    <th>Role
+    <th>Since
+    <th>Child
+  $forall (role, since, child) <- children
+    <tr>
+      <td>#{show role}
+      <td>#{showDate since}
+      <td>^{projectLinkFedW child}

templates/project/parents.hamlet

@@ -0,0 +1,28 @@
+$# This file is part of Vervis.
+$#
+$# Written in 2016, 2019, 2022, 2023 by fr33domlover <fr33domlover@riseup.net>.
+$#
+$# ♡ Copying is an act of love. Please copy, reuse and share.
+$#
+$# The author(s) have dedicated all copyright and related and neighboring
+$# rights to this software to the public domain worldwide. This software is
+$# distributed without any warranty.
+$#
+$# You should have received a copy of the CC0 Public Domain Dedication along
+$# with this software. If not, see
+$# <http://creativecommons.org/publicdomain/zero/1.0/>.
+
+^{projectNavW (Entity projectID project) actor}
+
+<h2>Parents
+
+<table>
+  <tr>
+    <th>Role
+    <th>Since
+    <th>Child
+  $forall (role, since, parent) <- parents
+    <tr>
+      <td>#{show role}
+      <td>#{showDate since}
+      <td>^{projectLinkFedW parent}

templates/project/widget/nav.hamlet

@@ -28,6 +28,12 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
   <span>
     <a href=@{ProjectComponentsR projectHash}>
       [🧩 Components]
+  <span>
+    <a href=@{ProjectChildrenR projectHash}>
+      [🐛 Children]
+  <span>
+    <a href=@{ProjectParentsR projectHash}>
+      [🦋 Parents]
   <span>
     [No wiki]
   <span>

th/models

@@ -920,8 +920,6 @@ PermitTopicExtendLocal
     topic  PermitTopicEnableLocalId
     grant  OutboxItemId
 
-    UniquePermitTopicExtendLocal      permit
-    UniquePermitTopicExtendLocalTopic topic
     UniquePermitTopicExtendLocalGrant grant
 
 PermitTopicExtendRemote
@@ -929,8 +927,6 @@ PermitTopicExtendRemote
     topic  PermitTopicEnableRemoteId
     grant  RemoteActivityId
 
-    UniquePermitTopicExtendRemote      permit
-    UniquePermitTopicExtendRemoteTopic topic
     UniquePermitTopicExtendRemoteGrant grant
 
 ------------------------------------------------------------------------------
@@ -1271,3 +1267,363 @@ StemDelegateLocal
 
     UniqueStemDelegateLocal      stem
     UniqueStemDelegateLocalGrant grant
+
+------------------------------------------------------------------------------
+-- Inheritance - Receiver tracking her givers
+-- (Project tracking its children)
+-- (Team tracking its parents)
+------------------------------------------------------------------------------
+
+Source
+    role Role
+
+SourceHolderProject
+    source  SourceId
+    project ProjectId
+
+    UniqueSourceHolderProject source
+
+SourceHolderGroup
+    source SourceId
+    group  GroupId
+
+    UniqueSourceHolderGroup source
+
+-------------------------------- Source topic --------------------------------
+
+SourceTopicLocal
+    source SourceId
+
+    UniqueSourceTopicLocal source
+
+SourceTopicProject
+    holder SourceHolderProjectId
+    topic  SourceTopicLocalId
+    child  ProjectId
+
+    UniqueSourceTopicProject      holder
+    UniqueSourceTopicProjectTopic topic
+
+SourceTopicGroup
+    holder SourceHolderGroupId
+    topic  SourceTopicLocalId
+    parent GroupId
+
+    UniqueSourceTopicGroup      holder
+    UniqueSourceTopicGroupTopic topic
+
+SourceTopicRemote
+    source SourceId
+    topic  RemoteActorId
+
+    UniqueSourceTopicRemote source
+
+-------------------------------- Source flow ---------------------------------
+
+SourceOriginUs
+    source SourceId
+
+    UniqueSourceOriginUs source
+
+SourceOriginThem
+    source SourceId
+
+    UniqueSourceOriginThem source
+
+-- Our collaborator's gesture
+--
+-- OriginUs: The Add that started the sequence
+-- OriginThem: N/A (they send their Accept but we don't record it)
+
+SourceUsGestureLocal
+    us  SourceOriginUsId
+    add OutboxItemId
+
+    UniqueSourceUsGestureLocal    us
+    UniqueSourceUsGestureLocalAdd add
+
+SourceUsGestureRemote
+    us    SourceOriginUsId
+    actor RemoteActorId
+    add   RemoteActivityId
+
+    UniqueSourceUsGestureRemote    us
+    UniqueSourceUsGestureRemoteAdd add
+
+-- Our accept
+--
+-- OriginUs: I checked the Add and sending my Accept
+-- OriginThem: N/A
+
+SourceUsAccept
+    us    SourceOriginUsId
+    accept OutboxItemId
+
+    UniqueSourceUsAccept       us
+    UniqueSourceUsAcceptAccept accept
+
+-- Their collaborator's gesture
+--
+-- OriginUs: N/A (they send it but we don't record it)
+-- OriginThem: The Add that started the sequence
+
+SourceThemGestureLocal
+    them SourceOriginThemId
+    add  OutboxItemId
+
+    UniqueSourceThemGestureLocal    them
+    UniqueSourceThemGestureLocalAdd add
+
+SourceThemGestureRemote
+    them  SourceOriginThemId
+    actor RemoteActorId
+    add   RemoteActivityId
+
+    UniqueSourceThemGestureRemote    them
+    UniqueSourceThemGestureRemoteAdd add
+
+-- Their accept
+--
+-- OriginUs: Seeing our accept and their collaborator's accept, they send their
+--           own accept
+-- OriginThem: Checking the Add, they send their Accept
+
+SourceThemAcceptLocal
+    topic  SourceTopicLocalId
+    accept OutboxItemId
+
+    UniqueSourceThemAcceptLocal       topic
+    UniqueSourceThemAcceptLocalAccept accept
+
+SourceThemAcceptRemote
+    topic  SourceTopicRemoteId
+    accept RemoteActivityId
+
+    UniqueSourceThemAcceptRemote       topic
+    UniqueSourceThemAcceptRemoteAccept accept
+
+-------------------------------- Source enable -------------------------------
+
+-- Witnesses that, seeing their approval and our collaborator's gesture, I've
+-- sent them a delegator-Grant and now officially considering them a source of
+-- us
+SourceUsSendDelegator
+    source SourceId
+    grant  OutboxItemId
+
+    UniqueSourceUsSendDelegator      source
+    UniqueSourceUsSendDelegatorGrant grant
+
+-- Witnesses that, using the delegator-Grant, they sent us a start-Grant or
+-- extension-Grant to delegate further
+
+SourceThemDelegateLocal
+    source SourceThemAcceptLocalId
+    grant  OutboxItemId
+
+    UniqueSourceThemDelegateLocal      source
+    UniqueSourceThemDelegateLocalGrant grant
+
+SourceThemDelegateRemote
+    source SourceThemAcceptRemoteId
+    grant  RemoteActivityId
+
+    UniqueSourceThemDelegateRemote      source
+    UniqueSourceThemDelegateRemoteGrant grant
+
+-- Witnesses that, seeing the delegation from them, I've sent an
+-- extension-Grant to a Dest of mine
+
+SourceUsGatherLocal
+    deleg SourceUsSendDelegatorId
+    dest  DestThemSendDelegatorLocalId
+    grant OutboxItemId
+
+    UniqueSourceUsGatherLocal grant
+
+SourceUsGatherRemote
+    deleg SourceUsSendDelegatorId
+    dest  DestThemSendDelegatorRemoteId
+    grant RemoteActivityId
+
+    UniqueSourceUsGatherRemote grant
+
+-- Witnesses that, seeing the delegation from them, I've sent a leaf-Grant to a
+-- direct-collaborator of mine
+
+SourceUsLeafLocal
+    deleg  SourceUsSendDelegatorId
+    collab CollabDelegLocalId
+    grant  OutboxItemId
+
+    UniqueSourceUsLeafLocal grant
+
+SourceUsLeafRemote
+    deleg  SourceUsSendDelegatorId
+    collab CollabDelegRemoteId
+    grant  RemoteActivityId
+
+    UniqueSourceUsLeafRemote grant
+
+------------------------------------------------------------------------------
+-- Inheritance - Giver tracking her receivers
+-- (Project tracking its parents)
+-- (Team tracking its children)
+------------------------------------------------------------------------------
+
+Dest
+    role Role
+
+DestHolderProject
+    dest    DestId
+    project ProjectId
+
+    UniqueDestHolderProject dest
+
+DestHolderGroup
+    dest  DestId
+    group GroupId
+
+    UniqueDestHolderGroup dest
+
+---------------------------------- Dest topic --------------------------------
+
+DestTopicLocal
+    dest DestId
+
+    UniqueDestTopicLocal dest
+
+DestTopicProject
+    holder DestHolderProjectId
+    topic  DestTopicLocalId
+    parent ProjectId
+
+    UniqueDestTopicProject      holder
+    UniqueDestTopicProjectTopic topic
+
+DestTopicGroup
+    holder DestHolderGroupId
+    topic  DestTopicLocalId
+    child  GroupId
+
+    UniqueDestTopicGroup      holder
+    UniqueDestTopicGroupTopic topic
+
+DestTopicRemote
+    dest  DestId
+    topic RemoteActorId
+
+    UniqueDestTopicRemote dest
+
+---------------------------------- Dest flow ---------------------------------
+
+DestOriginUs
+    dest DestId
+
+    UniqueDestOriginUs dest
+
+DestOriginThem
+    dest DestId
+
+    UniqueDestOriginThem dest
+
+-- Our collaborator's gesture
+--
+-- OriginUs: The Add that started the sequence
+-- OriginThem: Seeing the Add and their Accept, my collaborator has sent her
+--             Accept
+
+DestUsGestureLocal
+    dest     DestId
+    activity OutboxItemId
+
+    UniqueDestUsGestureLocal         dest
+    UniqueDestUsGestureLocalActivity activity
+
+DestUsGestureRemote
+    dest     DestId
+    actor    RemoteActorId
+    activity RemoteActivityId
+
+    UniqueDestUsGestureRemote         dest
+    UniqueDestUsGestureRemoteActivity activity
+
+-- Our accept
+--
+-- OriginUs: Checking my collaborator's Add, I sent my Accept
+-- OriginThem: Seeing the Add, their Accept and my collaborator's Accept, I
+--             sent my Accept
+
+DestUsAccept
+    dest DestId
+    accept OutboxItemId
+
+    UniqueDestUsAccept       dest
+    UniqueDestUsAcceptAccept accept
+
+-- Their collaborator's gesture
+--
+-- OriginUs: N/A (they send it but we don't record it)
+-- OriginThem: The Add that started the sequence
+
+DestThemGestureLocal
+    them DestOriginThemId
+    add  OutboxItemId
+
+    UniqueDestThemGestureLocal    them
+    UniqueDestThemGestureLocalAdd add
+
+DestThemGestureRemote
+    them  DestOriginThemId
+    actor RemoteActorId
+    add   RemoteActivityId
+
+    UniqueDestThemGestureRemote    them
+    UniqueDestThemGestureRemoteAdd add
+
+-- Their accept
+--
+-- OriginUs: N/A
+-- OriginThem: Seeing their collaborator's Add, they sent an Accept
+
+DestThemAcceptLocal
+    them   DestOriginThemId
+    topic  DestTopicLocalId
+    accept OutboxItemId
+
+    UniqueDestThemAcceptLocal       them
+    UniqueDestThemAcceptLocalTopic  topic
+    UniqueDestThemAcceptLocalAccept accept
+
+DestThemAcceptRemote
+    them   DestOriginThemId
+    topic  DestTopicRemoteId
+    accept RemoteActivityId
+
+    UniqueDestThemAcceptRemote       them
+    UniqueDestThemAcceptRemoteTopic  topic
+    UniqueDestThemAcceptRemoteAccept accept
+
+---------------------------------- Dest enable -------------------------------
+
+-- Witnesses that, seeing our approval and their collaborator's gesture,
+-- they've sent us a delegator-Grant, and we now officially consider them a
+-- dest of us
+
+DestThemSendDelegatorLocal
+    dest  DestUsAcceptId
+    topic DestTopicLocalId
+    grant OutboxItemId
+
+    UniqueDestThemSendDelegatorLocal      dest
+    UniqueDestThemSendDelegatorLocalTopic topic
+    UniqueDestThemSendDelegatorLocalGrant grant
+
+DestThemSendDelegatorRemote
+    dest  DestUsAcceptId
+    topic DestTopicRemoteId
+    grant RemoteActivityId
+
+    UniqueDestThemSendDelegatorRemote      dest
+    UniqueDestThemSendDelegatorRemoteTopic topic
+    UniqueDestThemSendDelegatorRemoteGrant grant

th/routes

@@ -136,6 +136,8 @@
 /publish/remove      PublishRemoveR     GET POST
 /publish/resolve     PublishResolveR    GET POST
 
+/accept-invite/#PermitFulfillsInviteKeyHashid AcceptInviteR POST
+
 ---- Person ------------------------------------------------------------------
 
 /people/#PersonKeyHashid                                 PersonR           GET
@@ -169,6 +171,13 @@
 /groups/#GroupKeyHashid/stamps/#SigKeyKeyHashid         GroupStampR      GET
 
 /groups/#GroupKeyHashid/members                         GroupMembersR    GET
+/groups/#GroupKeyHashid/invite                          GroupInviteR     GET POST
+/groups/#GroupKeyHashid/remove/#CollabTopicGroupId      GroupRemoveR     POST
+
+/groups/#GroupKeyHashid/children GroupChildrenR GET
+/groups/#GroupKeyHashid/children/local/#DestThemSendDelegatorLocalKeyHashid/live GroupChildLocalLiveR GET
+/groups/#GroupKeyHashid/children/remote/#DestThemSendDelegatorRemoteKeyHashid/live GroupChildRemoteLiveR GET
+/groups/#GroupKeyHashid/parents  GroupParentsR  GET
 
 ---- Repo --------------------------------------------------------------------
 
@@ -339,3 +348,8 @@
 /projects/#ProjectKeyHashid/collabs/#CollabEnableKeyHashid/live ProjectCollabLiveR    GET
 
 /projects/#ProjectKeyHashid/invite-component             ProjectInviteCompR     GET POST
+
+/projects/#ProjectKeyHashid/children ProjectChildrenR GET
+/projects/#ProjectKeyHashid/parents  ProjectParentsR  GET
+/projects/#ProjectKeyHashid/parents/local/#DestThemSendDelegatorLocalKeyHashid/live ProjectParentLocalLiveR GET
+/projects/#ProjectKeyHashid/parents/remote/#DestThemSendDelegatorRemoteKeyHashid/live ProjectParentRemoteLiveR GET

vervis.cabal

@@ -171,7 +171,6 @@ library
 
                        --Vervis.Federation
                        Vervis.Federation.Auth
-                       Vervis.Federation.Collab
                        Vervis.Federation.Discussion
                        Vervis.Federation.Offer
                        --Vervis.Federation.Push