forge/Vervis
1
0
Fork 0
Code Pull requests Activity

S2S: Group: Remove: Implement resource-active mode

Browse source
This commit is contained in:
Pere Lev 2024-06-20 17:58:26 +03:00
parent a36eda1e2b
commit 9df437a043
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
1 changed files with 294 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

294
src/Vervis/Actor/Group.hs
View file

@ -3956,6 +3956,18 @@ groupReject = topicReject groupResource LocalResourceGroup
-- * Send an Accept on the Remove: -- * Send an Accept on the Remove:
-- * To: Actor B -- * To: Actor B
-- * CC: Actor A, B's followers, my followers -- * CC: Actor A, B's followers, my followers
-- * If C is my resources collection:
-- * Verify A is authorized by me to remove resources from me
-- * Verify B is an active resource of mine
-- * Remove the whole Effort record from DB
-- * Forward the Remove to my followers
-- * Send a Revoke on the delegator-Grant I had for B:
-- * To: Actor B
-- * CC: Actor A, B's followers, my followers
-- * Send a Revoke on every extention-Grant I extended on every
-- delegation Grant I got from B
-- * To: The child/member to whom I'd sent the Grant
-- * CC: -
-- * If I'm B, being removed from the children of a parent of mine: -- * If I'm B, being removed from the children of a parent of mine:
-- * Record this Remove in the Source record -- * Record this Remove in the Source record
-- * Forward to followers -- * Forward to followers
@ -3979,6 +3991,8 @@ groupRemove now groupID (Verse authorIdMsig body) remove = do
removeChildActive item removeChildActive item
(Left (Right (ATGroupParents j)), _) | j == groupID -> (Left (Right (ATGroupParents j)), _) | j == groupID ->
removeParentActive item removeParentActive item
(Left (Right (ATGroupEfforts j)), _) | j == groupID ->
removeResourceActive item
(_, Left (LocalActorGroup j)) | j == groupID -> (_, Left (LocalActorGroup j)) | j == groupID ->
case collection of case collection of
Left (Right (ATGroupParents j)) | j /= groupID -> Left (Right (ATGroupParents j)) | j /= groupID ->
@ -4872,6 +4886,286 @@ groupRemove now groupID (Verse authorIdMsig body) remove = do
Just inboxItemID -> Just inboxItemID ->
doneDB inboxItemID "[Child-passive] Saw the removal attempt, just waiting for the Revoke" doneDB inboxItemID "[Child-passive] Saw the removal attempt, just waiting for the Revoke"
removeResourceActive resource = do
-- If resource is local, find it in our DB
-- If resource is remote, HTTP GET it, verify it's an actor of Group
-- 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.
resourceDB <-
bitraverse
(\ la ->
case resourceToNG =<< actorToResource la of
Just ng -> withDBExcept $ getLocalResourceEntityE (resourceFromNG ng) "Resource not found in DB"
Nothing -> throwE "Local resource of non-resource type"
)
(\ 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 "Resource @id mismatch"
Left (Just err) -> throwE $ T.pack $ displayException err
Right Nothing -> throwE "Resource isn't an actor"
Right (Just actor) -> do
case remoteActorType $ entityVal actor of
AP.ActorTypeTeam -> pure ()
_ -> throwE "Remote resource type isn't Group"
return (u, actor)
)
resource
-- Verify that a capability is provided
uCap <- do
let muCap = AP.activityCapability $ actbActivity body
fromMaybeE muCap "No capability provided"
-- Verify the sender is authorized by me to remove a resource
verifyCapability''
uCap
authorIdMsig
(LocalResourceGroup groupID)
AP.RoleAdmin
maybeNew <- withDBExcept $ do
-- Grab me from DB
(group, actorRecip) <- lift $ do
p <- getJust groupID
(p,) <$> getJust (groupActor p)
-- Verify it's an active resource of mine
efforts <- lift $ case resourceDB of
Left r ->
fmap (map $ \ (s, d, E.Value a, E.Value t) -> (s, d, Left (a, t))) $
E.select $ E.from $ \ (effort `E.InnerJoin` topic `E.InnerJoin` accept `E.InnerJoin` send) -> do
E.on $ effort E.^. EffortId E.==. send E.^. EffortUsSendDelegatorEffort
E.on $ topic E.^. EffortTopicLocalId E.==. accept E.^. EffortThemAcceptLocalTopic
E.on $ effort E.^. EffortId E.==. topic E.^. EffortTopicLocalEffort
E.where_ $
effort E.^. EffortHolder E.==. E.val groupID E.&&.
topic E.^. EffortTopicLocalTopic E.==. E.val (localResourceID r)
return
( effort E.^. EffortId
, send
, accept E.^. EffortThemAcceptLocalId
, topic E.^. EffortTopicLocalId
)
Right (_, Entity a _) ->
fmap (map $ \ (s, d, E.Value a, E.Value t) -> (s, d, Right (a, t))) $
E.select $ E.from $ \ (effort `E.InnerJoin` topic `E.InnerJoin` accept `E.InnerJoin` send) -> do
E.on $ effort E.^. EffortId E.==. send E.^. EffortUsSendDelegatorEffort
E.on $ topic E.^. EffortTopicRemoteId E.==. accept E.^. EffortThemAcceptRemoteTopic
E.on $ effort E.^. EffortId E.==. topic E.^. EffortTopicRemoteEffort
E.where_ $
effort E.^. EffortHolder E.==. E.val groupID E.&&.
topic E.^. EffortTopicRemoteTopic E.==. E.val a
return
( effort E.^. EffortId
, send
, accept E.^. EffortThemAcceptRemoteId
, topic E.^. EffortTopicRemoteId
)
(E.Value effortID, Entity sendID (EffortUsSendDelegator _ grantID), topic) <-
verifySingleE efforts "No effort" "Multiple efforts"
maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
lift $ for maybeRemoveDB $ \ (inboxItemID, _removeDB) -> do
-- Grab extension-Grants that I'm about to revoke
distributes <- selectList [EffortUsDistributeEffort ==. sendID] []
leafs <- selectList [EffortUsLeafEffort ==. sendID] []
-- Delete the whole Effort record
deleteWhere [EffortRemoveSend ==. sendID]
let distributeIDs = map entityKey distributes
deleteWhere [EffortUsDistributeFromLocalDistribute <-. distributeIDs]
deleteWhere [EffortUsDistributeFromRemoteDistribute <-. distributeIDs]
deleteWhere [EffortUsDistributeId <-. distributeIDs]
let leafIDs = map entityKey leafs
deleteWhere [EffortUsLeafFromLocalLeaf <-. leafIDs]
deleteWhere [EffortUsLeafFromRemoteLeaf <-. leafIDs]
deleteWhere [EffortUsLeafToLocalLeaf <-. leafIDs]
deleteWhere [EffortUsLeafToRemoteLeaf <-. leafIDs]
deleteWhere [EffortUsLeafId <-. leafIDs]
case topic of
Left (localID, _) -> do
deleteWhere [EffortThemDelegateLocalEffort ==. localID]
delete localID
Right (remoteID, _) -> do
deleteWhere [EffortThemDelegateRemoteEffort ==. remoteID]
delete remoteID
delete sendID
origin <-
requireEitherAlt
(getKeyBy $ UniqueEffortOriginUs effortID)
(getKeyBy $ UniqueEffortOriginThem effortID)
"Neither us nor them"
"Both us and them"
case origin of
Left usID -> do
deleteBy $ UniqueEffortUsAccept usID
deleteBy $ UniqueEffortUsGestureLocal usID
deleteBy $ UniqueEffortUsGestureRemote usID
delete usID
Right themID -> do
deleteBy $ UniqueEffortThemGestureLocal themID
deleteBy $ UniqueEffortThemGestureRemote themID
delete themID
case topic of
Left (_, l) -> delete l
Right (_, r) -> delete r
delete effortID
-- Prepare forwarding Remove to my followers
sieve <- lift $ do
topicHash <- encodeKeyHashid groupID
let topicByHash =
LocalActorGroup topicHash
return $ makeRecipientSet [] [localActorFollowers topicByHash]
-- Prepare main Revoke activity and insert to my outbox
revoke@(actionRevoke, _, _, _) <-
lift $ prepareMainRevoke resourceDB grantID
let recipByKey = LocalActorGroup groupID
revokeID <- insertEmptyOutboxItem' (actorOutbox actorRecip) now
_luRevoke <- updateOutboxItem' recipByKey revokeID actionRevoke
-- Prepare and insert Revokes on all the extension-Grants
revokesD <- for distributes $ \ (Entity _ (EffortUsDistribute _ startID grantID)) -> do
DestUsStart acceptID _ <- getJust startID
DestUsAccept destID _ <- getJust acceptID
child <- do
c <- getDestTopic destID
bitraverse
(\case
Right j -> pure $ LocalActorGroup j
Left _ -> error "I'm a group but I have a child who is a Project"
)
pure
(bimap snd snd c)
return (child, grantID)
revokesL <- for leafs $ \ (Entity _ (EffortUsLeaf _ enableID grantID)) -> do
CollabEnable collabID _ <- getJust enableID
recip <- getCollabRecip collabID
return
( bimap
(LocalActorPerson . collabRecipLocalPerson . entityVal)
(collabRecipRemoteActor . entityVal)
recip
, grantID
)
revokes <- for (revokesD ++ revokesL) $ \ (actor, grantID) -> do
ext@(actionExt, _, _, _) <- prepareExtRevoke actor grantID
let recipByKey = LocalActorGroup groupID
extID <- insertEmptyOutboxItem' (actorOutbox actorRecip) now
_luExt <- updateOutboxItem' recipByKey extID actionExt
return (extID, ext)
return (groupActor group, sieve, revokeID, revoke, revokes, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke), revokes, inboxItemID) -> do
let topicByID = LocalActorGroup groupID
forwardActivity authorIdMsig body topicByID topicActorID sieve
lift $ do
sendActivity
topicByID topicActorID localRecipsRevoke
remoteRecipsRevoke fwdHostsRevoke revokeID actionRevoke
for_ revokes $ \ (extID, (actionExt, localRecipsExt, remoteRecipsExt, fwdHostsExt)) ->
sendActivity
topicByID topicActorID localRecipsExt
remoteRecipsExt fwdHostsExt extID actionExt
doneDB inboxItemID "[Resource-active] Deleted the Effort, forwarded Remove, sent Revokes"
where
prepareMainRevoke resource grantID = do
encodeRouteHome <- getEncodeRouteHome
encodeRouteLocal <- getEncodeRouteLocal
recipHash <- encodeKeyHashid groupID
let topicByHash = LocalActorGroup recipHash
resourceHash <- bitraverse (hashLocalResource . bmap entityKey) pure resource
audRemover <- makeAudSenderOnly authorIdMsig
let audResource =
case resourceHash of
Left lr ->
let la = resourceToActor lr
in AudLocal [la] [localActorFollowers la]
Right (ObjURI h lu, Entity _ actor) ->
AudRemote h [lu] (maybeToList $ remoteActorFollowers actor)
audMe = AudLocal [] [localActorFollowers topicByHash]
(recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
collectAudience [audRemover, audResource, audMe]
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)
prepareExtRevoke recipient grantID = do
encodeRouteHome <- getEncodeRouteHome
encodeRouteLocal <- getEncodeRouteLocal
groupHash <- encodeKeyHashid groupID
let topicByHash = LocalActorGroup groupHash
audRecip <-
case recipient of
Left a -> do
h <- hashLocalActor a
return $ AudLocal [h] [localActorFollowers h]
Right actorID -> do
actor <- getJust actorID
ObjURI h lu <- getRemoteActorURI actor
return $
AudRemote h [lu] (maybeToList $ remoteActorFollowers actor)
let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
collectAudience [audRecip]
recips = map encodeRouteHome audLocal ++ audRemote
uRemove <- lift $ 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)
-- Meaning: An actor is revoking Grant activities -- Meaning: An actor is revoking Grant activities
-- Behavior: -- Behavior:
-- * For each revoked activity: -- * For each revoked activity: