From ae659dbba20e5de713f706a068d88ec5820c74f5 Mon Sep 17 00:00:00 2001 From: Pere Lev Date: Fri, 7 Jun 2024 19:10:06 +0300 Subject: [PATCH] S2S: Project: Remove: Implement component-passive mode --- src/Vervis/Actor/Project.hs | 100 +++++++++++++++++++++++++++++++++--- 1 file changed, 93 insertions(+), 7 deletions(-) diff --git a/src/Vervis/Actor/Project.hs b/src/Vervis/Actor/Project.hs index 3e26bbc..ef75860 100644 --- a/src/Vervis/Actor/Project.hs +++ b/src/Vervis/Actor/Project.hs @@ -4373,6 +4373,10 @@ projectReject = topicReject projectResource LocalResourceProject -- * If I'm B, being removed from the children of a parent of mine: -- * Do nothing, just waiting for parent to send a Revoke on the -- delegator-Grant +-- +-- * If I'm B, being removed from the projects of a component of mine: +-- * Do nothing, just waiting for component to send a Revoke on the +-- start-Grant projectRemove :: UTCTime -> ProjectId @@ -4398,19 +4402,31 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do removeChildPassive $ Left j Left (Right (ATProjectChildren j)) | j /= projectID -> removeParentPassive $ Left j + Left (Right at) | isJust (addTargetComponentProjects at) -> + removeComponentPassive $ Left $ fromJust $ addTargetComponentProjects 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.projectActor) h lu - case (luColl == AP.projectChildren j, luColl == AP.projectParents 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.ActorTypeProject && Just luColl == AP.rwcSubprojects rwc + then removeParentPassive $ Right $ ObjURI h lu + else if typ == AP.ActorTypeProject && Just luColl == AP.rwcParentsOrProjects rwc + then removeChildPassive $ Right $ ObjURI h lu + else if AP.actorTypeIsComponent typ && Just luColl == AP.rwcParentsOrProjects rwc + then removeComponentPassive $ Right $ ObjURI h lu + else throwE "Weird collection situation" _ -> throwE "I'm being removed from somewhere irrelevant" _ -> throwE "This Remove isn't for me" @@ -5641,6 +5657,76 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do Just inboxItemID -> doneDB inboxItemID "Saw the removal attempt, just waiting for the Revoke" + removeComponentPassive component = do + + -- If component is local, find it in our DB + -- If component is remote, HTTP GET it, verify it's an actor of + -- component 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. + componentDB <- + bitraverse + (\ c -> withDBExcept $ getComponentE c "Component 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 "Component @id mismatch" + Left (Just err) -> throwE $ T.pack $ displayException err + Right Nothing -> throwE "Component isn't an actor" + Right (Just actor) -> do + if AP.actorTypeIsComponent $ remoteActorType $ entityVal actor + then pure () + else throwE "Remote component type isn't of component type" + return (u, actor) + ) + component + + maybeNew <- withDBExcept $ do + + -- Grab me from DB + (project, actorRecip) <- lift $ do + p <- getJust projectID + (p,) <$> getJust (projectActor p) + + -- Verify it's an active component of mine + components <- lift $ case componentDB of + Left c -> + E.select $ E.from $ \ (comp `E.InnerJoin` topic `E.InnerJoin` enable) -> do + E.on $ comp E.^. ComponentId E.==. enable E.^. ComponentEnableComponent + E.on $ comp E.^. ComponentId E.==. topic E.^. ComponentLocalComponent + E.where_ $ + comp E.^. ComponentProject E.==. E.val projectID E.&&. + topic E.^. ComponentLocalActor E.==. E.val (localComponentID c) + return $ comp E.^. ComponentId + Right (_, Entity a _) -> + E.select $ E.from $ \ (comp `E.InnerJoin` topic `E.InnerJoin` enable) -> do + E.on $ comp E.^. ComponentId E.==. enable E.^. ComponentEnableComponent + E.on $ comp E.^. ComponentId E.==. topic E.^. ComponentRemoteComponent + E.where_ $ + comp E.^. ComponentProject E.==. E.val projectID E.&&. + topic E.^. ComponentRemoteActor E.==. E.val a + return $ comp E.^. ComponentId + + _ <- verifySingleE components "No component" "Multiple components" + + maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False + lift $ for maybeRemoveDB $ \ (inboxItemID, _removeDB) -> do + + return inboxItemID + + case maybeNew of + Nothing -> done "I already have this activity in my inbox" + Just inboxItemID -> + doneDB inboxItemID "[Component-passive] Saw the removal attempt, just waiting for the Revoke" + -- Meaning: An actor is revoking Grant activities -- Behavior: -- * For each revoked activity: