S2S: Group: Adapt collab-mode code from Project

src/Vervis/Actor/Common.hs

@@ -1855,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

@@ -844,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, _, _))
@@ -864,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) $

src/Vervis/Actor/Project.hs

@@ -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/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