S2S, C2S, Client: Update parseRemove to support project+component

src/Vervis/Actor/Common.hs

@@ -858,9 +858,17 @@ topicRemove grabActor topicResource topicField topicCollabField now topicKey (Ve
     -- Check remove
     memberByKey <- do
         let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig
-        (resource, member) <- parseRemove author remove
+        (resource, memberOrComp) <- parseRemove author remove
-        unless (Left (topicResource topicKey) == resource) $
+        unless (Left (Left $ topicResource topicKey) == resource) $
             throwE "Remove topic isn't my collabs URI"
+        member <-
+            bitraverse
+                (\case
+                    Left m -> pure m
+                    Right _ -> throwE "Not accepting component actors as collabs"
+                )
+                pure
+                memberOrComp
         return member
 
     maybeNew <- withDBExcept $ do

src/Vervis/Actor/Person.hs

@@ -502,7 +502,7 @@ personRemove
 personRemove now recipPersonID (Verse authorIdMsig body) remove = do
 
     -- Check input
-    member <- do
+    memberOrComp <- do
         let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig
         (_resource, member) <- parseRemove author remove
         return member
@@ -522,8 +522,8 @@ personRemove now recipPersonID (Verse authorIdMsig body) remove = do
         Nothing -> done "I already have this activity in my inbox"
         Just actorID -> do
             let memberIsMe =
-                    case member of
+                    case memberOrComp of
-                        Left (GrantRecipPerson p) -> p == recipPersonID
+                        Left (Left (GrantRecipPerson p)) -> p == recipPersonID
                         _ -> False
             if not memberIsMe
                 then done "I'm not the member; Inserted to inbox"

src/Vervis/Actor/Person/Client.hs

@@ -626,7 +626,23 @@ clientRemove
 clientRemove now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts action) remove = do
 
     -- Check input
-    (resource, member) <- parseRemove (Left $ LocalActorPerson personMeID) remove
+    (resourceOrComps, memberOrComp) <- parseRemove (Left $ LocalActorPerson personMeID) remove
+    resource <-
+        bitraverse
+            (\case
+                Left r -> pure r
+                Right _ -> throwE "Not accepting project components as target"
+            )
+            pure
+            resourceOrComps
+    member <-
+        bitraverse
+            (\case
+                Left r -> pure r
+                Right _ -> throwE "Not accepting component actors as collabs"
+            )
+            pure
+            memberOrComp
     _capID <- fromMaybeE maybeCap "No capability provided"
 
     -- If resource collabs is remote, HTTP GET it to determine resource
@@ -637,6 +653,9 @@ clientRemove now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost
                 manager <- asksEnv envHttpManager
                 coll <- ExceptT $ liftIO $ first T.pack <$> AP.fetchAPID manager AP.collectionId h luColl
                 lu <- fromMaybeE (AP.collectionContext (coll :: AP.Collection FedURI URIMode)) "Remote topic collabs has no 'context'"
+                AP.ResourceWithCollections _ mluCollabs _ <- ExceptT $ liftIO $ first (T.pack . show) <$> AP.fetchRWC manager h lu
+                unless (mluCollabs == Just luColl) $
+                    throwE "Remove origin isn't a collabs list"
                 return $ ObjURI h lu
             )
             resource

src/Vervis/Client.hs

@@ -1095,8 +1095,24 @@ remove personID uRecipient uResourceCollabs = do
     env <- asksSite appEnv
 
     let activity = AP.Remove uRecipient uResourceCollabs
-    (resource, recipient) <-
+    (resourceOrComps, recipientOrComp) <-
         runActE $ parseRemove (Left $ LocalActorPerson personID) activity
+    resource <-
+        bitraverse
+            (\case
+                Left r -> pure r
+                Right _-> throwE "Not accepting project components as target"
+            )
+            pure
+            resourceOrComps
+    recipient <-
+        bitraverse
+            (\case
+                Left r -> pure r
+                Right _ -> throwE "Not accepting component actors as collabs"
+            )
+            pure
+            recipientOrComp
 
     -- If resource collabs is remote, we need to HTTP GET it to determine the
     -- resource via collection 'context'

src/Vervis/Data/Collab.hs

@@ -330,12 +330,12 @@ parseRemove
     => Either (LocalActorBy Key) FedURI
     -> AP.Remove URIMode
     -> ActE
-        ( Either (GrantResourceBy Key) FedURI
+        ( Either (Either (GrantResourceBy Key) ProjectId) FedURI
-        , Either (GrantRecipBy Key) FedURI
+        , Either (Either (GrantRecipBy Key) (ComponentBy Key)) FedURI
         )
 parseRemove sender (AP.Remove object origin) =
-    (,) <$> nameExceptT "Remove origin" (parseTopic origin)
+    (,) <$> nameExceptT "Remove origin" (parseTopic' origin)
-        <*> nameExceptT "Remove object" (parseRecipient sender object)
+        <*> nameExceptT "Remove object" (parseRecipient' sender object)
 
 parseAdd
     :: StageRoute Env ~ Route App