From 4d37d1293a021b1fa1b450703b3b6e6955345d89 Mon Sep 17 00:00:00 2001 From: Pere Lev Date: Thu, 20 Jun 2024 18:37:22 +0300 Subject: [PATCH] S2S: Group: Remove: Implement resource-passive mode --- src/Vervis/Actor/Group.hs | 123 +++++++++++++++++++++++++++++++++++--- 1 file changed, 116 insertions(+), 7 deletions(-) diff --git a/src/Vervis/Actor/Group.hs b/src/Vervis/Actor/Group.hs index bfb0f12..80817aa 100644 --- a/src/Vervis/Actor/Group.hs +++ b/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 - case (luColl == AP.teamChildren j, luColl == AP.teamParents j) of - (True, False) -> - removeParentPassive $ Right $ ObjURI h lu - (False, True) -> - removeChildPassive $ Right $ ObjURI h lu - _ -> throwE "Weird collection situation" + rwc <- AP.fetchRWC_T manager h lu + AP.Actor l d <- + case AP.rwcResource rwc of + AP.ResourceActor a -> pure a + AP.ResourceChild _ _ -> throwE "Remove.origin remote ResourceChild" + let typ = AP.actorType d + 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: