diff --git a/src/Vervis/Actor/Project.hs b/src/Vervis/Actor/Project.hs index 04ca677..e1f61e0 100644 --- a/src/Vervis/Actor/Project.hs +++ b/src/Vervis/Actor/Project.hs @@ -4325,6 +4325,9 @@ projectReject = topicReject projectResource LocalResourceProject -- * Send a Revoke: -- * To: Actor B -- * CC: Actor A, B's followers, my followers +-- * Send revokes on my extensions from: +-- * My components +-- * My children -- -- * If C is my components collection: -- * Verify A is authorized by me @@ -4495,23 +4498,48 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do Entity enableID (CollabEnable _ grantID) <- fromMaybeE maybeEnabled "Remove object isn't a member of me yet" - -- Verify that at least 1 more enabled Admin collab for me exists - otherCollabIDs <- - lift $ E.select $ E.from $ \ (collab `E.InnerJoin` enable) -> do - E.on $ - collab E.^. CollabId E.==. - enable E.^. CollabEnableCollab - E.where_ $ - collab E.^. CollabTopic E.==. E.val resourceID E.&&. - collab E.^. CollabId E.!=. E.val collabID E.&&. - collab E.^. CollabRole E.==. E.val AP.RoleAdmin - return $ collab E.^. CollabId - when (null otherCollabIDs) $ - throwE "No other admins exist, can't remove" - maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox topicActor) False lift $ for maybeRemoveDB $ \ (inboxItemID, _removeDB) -> do + -- Grab grants that I'm about to revoke + maybeDeleg <- + case recipID of + Left (E.Value localID) -> fmap Left <$> getKeyBy (UniqueCollabDelegLocalRecip localID) + Right (E.Value remoteID) -> fmap Right <$> getKeyBy (UniqueCollabDelegRemoteRecip remoteID) + grantIDs <- + case maybeDeleg of + Nothing -> pure [] + Just deleg -> do + fromComponents <- + case deleg of + Left localID -> do + furthersL <- selectList [ComponentFurtherLocalCollab ==. localID] [] + deleteWhere [ComponentFurtherLocalCollab ==. localID] + return $ map (componentFurtherLocalGrant . entityVal) furthersL + Right remoteID -> do + furthersL <- selectList [ComponentFurtherRemoteCollab ==. remoteID] [] + deleteWhere [ComponentFurtherRemoteCollab ==. remoteID] + return $ map (componentFurtherRemoteGrant . entityVal) furthersL + fromChildren <- + case deleg of + Left localID -> do + tos <- selectList [SourceUsLeafToLocalTo ==. localID] [] + leafs <- selectList [SourceUsLeafId <-. map (sourceUsLeafToLocalLeaf . entityVal) tos] [] + deleteWhere [SourceUsLeafFromLocalLeaf <-. map entityKey leafs] + deleteWhere [SourceUsLeafFromRemoteLeaf <-. map entityKey leafs] + deleteWhere [SourceUsLeafToLocalId <-. map entityKey tos] + deleteWhere [SourceUsLeafId <-. map entityKey leafs] + return $ map (sourceUsLeafGrant . entityVal) leafs + Right remoteID -> do + tos <- selectList [SourceUsLeafToRemoteTo ==. remoteID] [] + leafs <- selectList [SourceUsLeafId <-. map (sourceUsLeafToRemoteLeaf . entityVal) tos] [] + deleteWhere [SourceUsLeafFromLocalLeaf <-. map entityKey leafs] + deleteWhere [SourceUsLeafFromRemoteLeaf <-. map entityKey leafs] + deleteWhere [SourceUsLeafToRemoteId <-. map entityKey tos] + deleteWhere [SourceUsLeafId <-. map entityKey leafs] + return $ map (sourceUsLeafGrant . entityVal) leafs + return $ fromComponents ++ fromChildren + -- Delete the whole Collab record deleteBy $ UniqueCollabDelegLocal enableID deleteBy $ UniqueCollabDelegRemote enableID @@ -4551,28 +4579,49 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do LocalActorProject topicHash return $ makeRecipientSet [] [localActorFollowers topicByHash] + -- Prepare Revoke activities on extensions sent from components + -- and children + audCollab <- + case memberDB of + Left (Entity personID _) -> do + personHash <- encodeKeyHashid personID + return $ AudLocal [LocalActorPerson personHash] [] + Right (_, ObjURI h lu) -> + return $ AudRemote h [lu] [] + extensions <- for grantIDs $ \ grantID -> do + revokeID <- insertEmptyOutboxItem' (actorOutbox topicActor) now + revoke@(actionRevoke, _, _, _) <- lift $ prepareExtRevoke audCollab grantID + let recipByKey = LocalActorProject projectID + _luRevoke <- updateOutboxItem' recipByKey revokeID actionRevoke + return (revokeID, revoke) + -- Prepare a Revoke activity and insert to my outbox revoke@(actionRevoke, _, _, _) <- - lift $ prepareRevoke memberDB grantID + lift $ prepareMainRevoke memberDB grantID let recipByKey = LocalActorProject projectID revokeID <- insertEmptyOutboxItem' (actorOutbox topicActor) now _luRevoke <- updateOutboxItem' recipByKey revokeID actionRevoke - return (topicActorID, sieve, revokeID, revoke, inboxItemID) + return (topicActorID, sieve, revokeID, revoke, extensions, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke), inboxItemID) -> do + Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke), extensions, inboxItemID) -> do let topicByID = LocalActorProject projectID forwardActivity authorIdMsig body topicByID topicActorID sieve - lift $ sendActivity - topicByID topicActorID localRecipsRevoke - remoteRecipsRevoke fwdHostsRevoke revokeID actionRevoke - doneDB inboxItemID "Deleted the Grant/Collab, forwarded Remove, sent Revoke" + lift $ do + sendActivity + topicByID topicActorID localRecipsRevoke + remoteRecipsRevoke fwdHostsRevoke revokeID actionRevoke + for_ extensions $ \ (revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke)) -> + sendActivity + topicByID topicActorID localRecipsRevoke + remoteRecipsRevoke fwdHostsRevoke revokeID actionRevoke + doneDB inboxItemID "[Collab] Deleted the Grant/Collab, forwarded Remove, sent Revokes" where - prepareRevoke member grantID = do + prepareMainRevoke member grantID = do encodeRouteHome <- getEncodeRouteHome encodeRouteLocal <- getEncodeRouteLocal @@ -4612,6 +4661,32 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do return (action, recipientSet, remoteActors, fwdHosts) + prepareExtRevoke audCollab grantID = do + encodeRouteHome <- getEncodeRouteHome + encodeRouteLocal <- getEncodeRouteLocal + + projectHash <- encodeKeyHashid projectID + let topicByHash = LocalActorProject projectHash + (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) = + collectAudience [audCollab] + recips = map encodeRouteHome audLocal ++ audRemote + + uRemove <- getActivityURI authorIdMsig + luGrant <- do + grantHash <- encodeKeyHashid grantID + return $ encodeRouteLocal $ activityRoute topicByHash grantHash + let action = AP.Action + { AP.actionCapability = Nothing + , AP.actionSummary = Nothing + , AP.actionAudience = AP.Audience recips [] [] [] [] [] + , AP.actionFulfills = [uRemove] + , AP.actionSpecific = AP.RevokeActivity AP.Revoke + { AP.revokeObject = luGrant :| [] + } + } + + return (action, recipientSet, remoteActors, fwdHosts) + removeComponentActive item = do -- Check remove