S2S: Project: Remove: Implement component-passive mode

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
+                    rwc <- AP.fetchRWC_T manager h lu
-                    case (luColl == AP.projectChildren j, luColl == AP.projectParents 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.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: