diff --git a/src/Vervis/Actor/Common.hs b/src/Vervis/Actor/Common.hs index b4041dd..2f48bcf 100644 --- a/src/Vervis/Actor/Common.hs +++ b/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 - unless (Left (topicResource topicKey) == resource) $ + (resource, memberOrComp) <- parseRemove author remove + 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 diff --git a/src/Vervis/Actor/Person.hs b/src/Vervis/Actor/Person.hs index 37e0151..9004177 100644 --- a/src/Vervis/Actor/Person.hs +++ b/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 - Left (GrantRecipPerson p) -> p == recipPersonID + case memberOrComp of + Left (Left (GrantRecipPerson p)) -> p == recipPersonID _ -> False if not memberIsMe then done "I'm not the member; Inserted to inbox" diff --git a/src/Vervis/Actor/Person/Client.hs b/src/Vervis/Actor/Person/Client.hs index c3e663f..287a824 100644 --- a/src/Vervis/Actor/Person/Client.hs +++ b/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 diff --git a/src/Vervis/Client.hs b/src/Vervis/Client.hs index 9d6c47a..4a188bf 100644 --- a/src/Vervis/Client.hs +++ b/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' diff --git a/src/Vervis/Data/Collab.hs b/src/Vervis/Data/Collab.hs index 4600780..25a7bc0 100644 --- a/src/Vervis/Data/Collab.hs +++ b/src/Vervis/Data/Collab.hs @@ -330,12 +330,12 @@ parseRemove => Either (LocalActorBy Key) FedURI -> AP.Remove URIMode -> ActE - ( Either (GrantResourceBy Key) FedURI - , Either (GrantRecipBy Key) FedURI + ( Either (Either (GrantResourceBy Key) ProjectId) FedURI + , Either (Either (GrantRecipBy Key) (ComponentBy Key)) FedURI ) parseRemove sender (AP.Remove object origin) = - (,) <$> nameExceptT "Remove origin" (parseTopic origin) - <*> nameExceptT "Remove object" (parseRecipient sender object) + (,) <$> nameExceptT "Remove origin" (parseTopic' origin) + <*> nameExceptT "Remove object" (parseRecipient' sender object) parseAdd :: StageRoute Env ~ Route App