S2S: Group: Remove: Implement resource-passive mode

src/Vervis/Actor/Group.hs

@@ -3974,6 +3974,9 @@ groupReject = topicReject groupResource LocalResourceGroup
 --      * If I'm B, being removed from the parents of a child of mine:
 --          * Do nothing, just waiting for parent to send a Revoke on the
 --            delegator-Grant
+--      * If I'm B, being removed from the teams of a resource of mine:
+--          * Record this Remove in the Effort record
+--          * Forward to followers
 groupRemove
     :: UTCTime
     -> GroupId
@@ -3999,19 +4002,27 @@ groupRemove now groupID (Verse authorIdMsig body) remove = do
                     removeChildPassive $ Left j
                 Left (Right (ATGroupChildren j)) | j /= groupID ->
                     removeParentPassive $ Left j
+                Left (Right at) | isJust $ addTargetResourceTeams at ->
+                    removeResourcePassive $ Left $ fromJust $ addTargetResourceTeams at
                 Right (ObjURI h luColl) -> do
                     -- NOTE this is HTTP GET done synchronously in the activity
                     -- handler
                     manager <- asksEnv envHttpManager
                     c <- AP.fetchAPID_T manager (AP.collectionId :: AP.Collection FedURI URIMode -> LocalURI) h luColl
                     lu <- fromMaybeE (AP.collectionContext c) "No context"
-                    j <- AP.fetchAPID_T manager (AP.actorId . AP.actorLocal . AP.teamActor) h lu
+                    rwc <- AP.fetchRWC_T manager h lu
-                    case (luColl == AP.teamChildren j, luColl == AP.teamParents j) of
+                    AP.Actor l d <-
-                        (True, False) ->
+                        case AP.rwcResource rwc of
-                            removeParentPassive $ Right $ ObjURI h lu
+                            AP.ResourceActor a -> pure a
-                        (False, True) ->
+                            AP.ResourceChild _ _ -> throwE "Remove.origin remote ResourceChild"
-                            removeChildPassive $ Right $ ObjURI h lu
+                    let typ = AP.actorType d
-                        _ -> throwE "Weird collection situation"
+                    if typ == AP.ActorTypeTeam && Just luColl == AP.rwcSubteams rwc
+                        then removeParentPassive $ Right $ ObjURI h lu
+                    else if typ == AP.ActorTypeTeam && Just luColl == AP.rwcParentsOrProjects rwc
+                        then removeChildPassive $ Right $ ObjURI h lu
+                    else if AP.actorTypeIsResourceNT typ && Just luColl == AP.rwcTeams rwc
+                        then removeResourcePassive $ Right $ ObjURI h lu
+                    else throwE "Weird collection situation"
                 _ -> throwE "I'm being removed from somewhere irrelevant"
         _ -> throwE "This Remove isn't for me"
 
@@ -5166,6 +5177,104 @@ groupRemove now groupID (Verse authorIdMsig body) remove = do
 
             return (action, recipientSet, remoteActors, fwdHosts)
 
+    removeResourcePassive resource = do
+
+        -- If resource is local, find it in our DB
+        -- If resource is remote, HTTP GET it, verify it's an actor of Group
+        -- type, 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 handler,
+        -- which is NOT a good idea. Ideally, it would be done async, and the
+        -- handler result would be sent later in a separate (e.g. Accept) activity.
+        -- But for the PoC level, the current situation will hopefully do.
+        resourceDB <-
+            bitraverse
+                (\ ng ->
+                    withDBExcept $
+                        getLocalResourceEntityE (resourceFromNG ng) "Resource not found in DB"
+                )
+                (\ u@(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 "Resource @id mismatch"
+                        Left (Just err) -> throwE $ T.pack $ displayException err
+                        Right Nothing -> throwE "Resource isn't an actor"
+                        Right (Just actor) -> do
+                            case remoteActorType $ entityVal actor of
+                                AP.ActorTypeTeam -> pure ()
+                                _ -> throwE "Remote resource type isn't Group"
+                            return (u, actor)
+                )
+                resource
+
+        maybeNew <- withDBExcept $ do
+
+            -- Grab me from DB
+            (group, actorRecip) <- lift $ do
+                p <- getJust groupID
+                (p,) <$> getJust (groupActor p)
+
+            -- Verify it's an active resource of mine
+            efforts <- lift $ case resourceDB of
+                Left r ->
+                    fmap (map $ \ (s, d, E.Value a, E.Value t) -> (s, d, Left (a, t))) $
+                    E.select $ E.from $ \ (effort `E.InnerJoin` topic `E.InnerJoin` accept `E.InnerJoin` send) -> do
+                        E.on $ effort E.^. EffortId E.==. send E.^. EffortUsSendDelegatorEffort
+                        E.on $ topic E.^. EffortTopicLocalId E.==. accept E.^. EffortThemAcceptLocalTopic
+                        E.on $ effort E.^. EffortId E.==. topic E.^. EffortTopicLocalEffort
+                        E.where_ $
+                            effort E.^. EffortHolder E.==. E.val groupID E.&&.
+                            topic E.^. EffortTopicLocalTopic E.==. E.val (localResourceID r)
+                        return
+                            ( effort E.^. EffortId
+                            , send
+                            , accept E.^. EffortThemAcceptLocalId
+                            , topic E.^. EffortTopicLocalId
+                            )
+                Right (_, Entity a _) ->
+                    fmap (map $ \ (s, d, E.Value a, E.Value t) -> (s, d, Right (a, t))) $
+                    E.select $ E.from $ \ (effort `E.InnerJoin` topic `E.InnerJoin` accept `E.InnerJoin` send) -> do
+                        E.on $ effort E.^. EffortId E.==. send E.^. EffortUsSendDelegatorEffort
+                        E.on $ topic E.^. EffortTopicRemoteId E.==. accept E.^. EffortThemAcceptRemoteTopic
+                        E.on $ effort E.^. EffortId E.==. topic E.^. EffortTopicRemoteEffort
+                        E.where_ $
+                            effort E.^. EffortHolder E.==. E.val groupID E.&&.
+                            topic E.^. EffortTopicRemoteTopic E.==. E.val a
+                        return
+                            ( effort E.^. EffortId
+                            , send
+                            , accept E.^. EffortThemAcceptRemoteId
+                            , topic E.^. EffortTopicRemoteId
+                            )
+            (E.Value effortID, Entity sendID (EffortUsSendDelegator _ grantID), topic) <-
+                verifySingleE efforts "No effort" "Multiple efforts"
+
+            maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
+            lift $ for maybeRemoveDB $ \ (removeID, _) -> do
+
+                -- Record the removal attempt
+                insert_ $ EffortRemove sendID removeID
+
+                -- Prepare forwarding Remove to my followers
+                sieve <- lift $ do
+                    topicHash <- encodeKeyHashid groupID
+                    let topicByHash =
+                            LocalActorGroup topicHash
+                    return $ makeRecipientSet [] [localActorFollowers topicByHash]
+
+                return (groupActor group, sieve, removeID)
+
+        case maybeNew of
+            Nothing -> done "I already have this activity in my inbox"
+            Just (topicActorID, sieve, inboxItemID) -> do
+                let topicByID = LocalActorGroup groupID
+                forwardActivity authorIdMsig body topicByID topicActorID sieve
+                doneDB inboxItemID "[Resource-passive] Recorded removal attempt, forwarded Remove"
+
 -- Meaning: An actor is revoking Grant activities
 -- Behavior:
 --  * For each revoked activity: