forge/Vervis
1
0
Fork 0
Code Pull requests Activity

S2S: Project: Revoke: Handle child revoking one of the Grants they sent me

Browse source
This commit is contained in:
Pere Lev 2024-04-10 16:27:29 +03:00
parent a16fb6cd19
commit 24aba4d370
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
3 changed files with 180 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

172
src/Vervis/Actor/Project.hs
View file

@ -1207,6 +1207,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
deleteWhere [SourceUsLeafFromRemoteLeaf <-. leafIDs]
deleteWhere [SourceUsLeafToLocalLeaf <-. leafIDs]
deleteWhere [SourceUsLeafToRemoteLeaf <-. leafIDs]
deleteWhere [SourceUsLeafId <-. leafIDs]
case child of
Left (localID, _) -> do
acceptID <- getKeyByJust $ UniqueSourceThemAcceptLocal localID
@ -4890,14 +4891,14 @@ projectRevoke now projectID (Verse authorIdMsig body) (AP.Revoke (luFirst :| lus
maybeMode <-
ExceptT $ fmap adapt $ runMaybeT $
runExceptT (Left <$> tryParent revokedFirstDB) <|>
runExceptT (Right <$> lift mzero)
runExceptT (Right <$> tryChild revokedFirstDB)
fromMaybeE
maybeMode
"Revoked activity isn't a relevant Grant I'm aware of"
case mode of
Left p -> revokeParent revokedRest p
Right () -> error "revokeChild c"
Right c -> revokeChild revokedRest c
where
@ -4932,11 +4933,39 @@ projectRevoke now projectID (Verse authorIdMsig body) (AP.Revoke (luFirst :| lus
lift $ MaybeT $ getBy $ UniqueDestThemSendDelegatorRemoteGrant remoteActivityID
tryParent' usAcceptID (Right sendID) --(Right remoteID)
verifySourceHolder :: SourceId -> ActDBE ()
verifySourceHolder sourceID = do
mh <- lift $ getValBy $ UniqueSourceHolderProject sourceID
case mh of
Just (SourceHolderProject _ j) | j == projectID -> pure ()
_ -> throwE "Revoked object is a Grant for some other project/team"
tryChild' sourceID child = do
ExceptT $ lift $ runExceptT $ verifySourceHolder sourceID
sendID <- lift $ MaybeT $ getKeyBy $ UniqueSourceUsSendDelegator sourceID
return (sendID, child)
tryChild (Left (_actorByKey, _actorEntity, itemID)) = do
Entity delegID (SourceThemDelegateLocal themAcceptID _) <-
lift $ MaybeT $ getBy $ UniqueSourceThemDelegateLocal itemID
SourceThemAcceptLocal topicID _ <- lift $ lift $ getJust themAcceptID
SourceTopicLocal sourceID <- lift $ lift $ getJust topicID
SourceTopicProject _ _ j <- do
mj <- lift $ lift $ getValBy $ UniqueSourceTopicProjectTopic topicID
fromMaybeE mj "The parent to whom this revoked Grant was sent isn't a Project"
tryChild' sourceID $ Left (topicID, j, delegID, themAcceptID)
tryChild (Right remoteActivityID) = do
Entity delegID (SourceThemDelegateRemote themAcceptID _) <-
lift $ MaybeT $ getBy $ UniqueSourceThemDelegateRemote remoteActivityID
SourceThemAcceptRemote topicID _ <- lift $ lift $ getJust themAcceptID
SourceTopicRemote sourceID actorID <- lift $ lift $ getJust topicID
tryChild' sourceID $ Right (topicID, actorID, delegID, themAcceptID)
revokeParent revokedRest (destID, usAcceptID, parent, send) = do
let author = bimap (view _1) (remoteAuthorId . view _1) authorIdMsig
unless (author == bimap (LocalActorProject . snd) snd parent) $
throwE "Sender isn't the parent Project he revoked Grant came from"
throwE "Sender isn't the parent Project the revoked Grant came from"
unless (null revokedRest) $
throwE "Parent revoking the delegator-Grant and something more"
@ -5060,6 +5089,143 @@ projectRevoke now projectID (Verse authorIdMsig body) (AP.Revoke (luFirst :| lus
return (action, recipientSet, remoteActors, fwdHosts)
revokeChild revokedRest (sendID, child) = do
let author = bimap (view _1) (remoteAuthorId . view _1) authorIdMsig
unless (author == bimap (LocalActorProject . view _2) (view _2) child) $
throwE "Sender isn't the child Project the revoked Grant came from"
unless (null revokedRest) $
throwE "Child revoking the start/extension-Grant and something more"
maybeNew <- withDBExcept $ do
-- Grab me from DB
(project, actorRecip) <- lift $ do
p <- getJust projectID
(p,) <$> getJust (projectActor p)
maybeRevokeDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
lift $ for maybeRevokeDB $ \ _revokeDB -> do
-- Collect the extensions I'll need to revoke
gatherIDs <-
case child of
Left (_, _, delegID, _) ->
map (sourceUsGatherFromLocalGather . entityVal) <$>
selectList [SourceUsGatherFromLocalFrom ==. delegID] []
Right (_, _, delegID, _) ->
map (sourceUsGatherFromRemoteGather . entityVal) <$>
selectList [SourceUsGatherFromRemoteFrom ==. delegID] []
gathers <- selectList [SourceUsGatherId <-. gatherIDs] []
leafIDs <-
case child of
Left (_, _, delegID, _) ->
map (sourceUsLeafFromLocalLeaf . entityVal) <$>
selectList [SourceUsLeafFromLocalFrom ==. delegID] []
Right (_, _, delegID, _) ->
map (sourceUsLeafFromRemoteLeaf . entityVal) <$>
selectList [SourceUsLeafFromRemoteFrom ==. delegID] []
leafs <- selectList [SourceUsLeafId <-. leafIDs] []
-- Delete the records of these extensions
deleteWhere [SourceUsGatherFromLocalGather <-. gatherIDs]
deleteWhere [SourceUsGatherFromRemoteGather <-. gatherIDs]
deleteWhere [SourceUsGatherToLocalGather <-. gatherIDs]
deleteWhere [SourceUsGatherToRemoteGather <-. gatherIDs]
deleteWhere [SourceUsGatherId <-. gatherIDs]
deleteWhere [SourceUsLeafFromLocalLeaf <-. leafIDs]
deleteWhere [SourceUsLeafFromRemoteLeaf <-. leafIDs]
deleteWhere [SourceUsLeafToLocalLeaf <-. leafIDs]
deleteWhere [SourceUsLeafToRemoteLeaf <-. leafIDs]
deleteWhere [SourceUsLeafId <-. leafIDs]
case child of
Left (_, _, delegID, _) -> delete delegID
Right (_, _, delegID, _) -> delete delegID
-- Prepare and insert Revokes on all the extension-Grants
revokesG <- for gathers $ \ (Entity _ (SourceUsGather _ acceptID grantID)) -> do
DestUsAccept destID _ <- getJust acceptID
parent <- do
p <- getDestTopic destID
bitraverse
(\case
Left j -> pure $ LocalActorProject j
Right _ -> error "I'm a project but I have a parent who is a Group"
)
pure
(bimap snd snd p)
return (parent, grantID)
revokesL <- for leafs $ \ (Entity _ (SourceUsLeaf _ enableID grantID)) -> do
CollabEnable collabID _ <- getJust enableID
recip <- getCollabRecip collabID
return
( bimap
(LocalActorPerson . collabRecipLocalPerson . entityVal)
(collabRecipRemoteActor . entityVal)
recip
, grantID
)
revokes <- for (revokesG ++ revokesL) $ \ (actor, grantID) -> do
ext@(actionExt, _, _, _) <- prepareExtRevoke actor grantID
let recipByKey = LocalActorProject projectID
extID <- insertEmptyOutboxItem' (actorOutbox actorRecip) now
_luExt <- updateOutboxItem' recipByKey extID actionExt
return (extID, ext)
return (projectActor project, revokes)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (topicActorID, revokes) -> do
let topicByID = LocalActorProject projectID
lift $ for_ revokes $ \ (extID, (actionExt, localRecipsExt, remoteRecipsExt, fwdHostsExt)) ->
sendActivity
topicByID topicActorID localRecipsExt
remoteRecipsExt fwdHostsExt extID actionExt
done "Deleted the SourceThemDelegate* record, sent Revokes"
where
prepareExtRevoke recipient grantID = do
encodeRouteHome <- getEncodeRouteHome
encodeRouteLocal <- getEncodeRouteLocal
projectHash <- encodeKeyHashid projectID
let topicByHash = LocalActorProject projectHash
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
uRevoke <- 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 = [uRevoke]
, AP.actionSpecific = AP.RevokeActivity AP.Revoke
{ AP.revokeObject = luGrant :| []
}
}
return (action, recipientSet, remoteActors, fwdHosts)
-- Meaning: An actor is undoing some previous action
-- Behavior:
-- * If they're undoing their Following of me:

8
src/Vervis/Migration.hs
View file

@ -3214,6 +3214,14 @@ changes hLocal ctx =
, addEntities model_577_component_gather
-- 578
, addEntities model_578_source_remove
-- 579
, removeUnique' "SourceThemDelegateLocal" ""
-- 580
, removeUnique' "SourceThemDelegateRemote" ""
-- 581
, addUnique' "SourceThemDelegateLocal" "" ["grant"]
-- 582
, addUnique' "SourceThemDelegateRemote" "" ["grant"]
]
migrateDB

6
th/models
View file

@ -1,6 +1,6 @@
-- This file is part of Vervis.
--
-- Written in 2016, 2018, 2019, 2020, 2022
-- Written in 2016, 2018, 2019, 2020, 2022, 2024
-- by fr33domlover <fr33domlover@riseup.net>.
--
-- ♡ Copying is an act of love. Please copy, reuse and share.
@ -1438,13 +1438,13 @@ SourceThemDelegateLocal
source SourceThemAcceptLocalId
grant OutboxItemId
UniqueSourceThemDelegateLocal source grant
UniqueSourceThemDelegateLocal grant
SourceThemDelegateRemote
source SourceThemAcceptRemoteId
grant RemoteActivityId
UniqueSourceThemDelegateRemote source grant
UniqueSourceThemDelegateRemote grant
-- Witnesses that, seeing the delegation from them, I've sent an
-- extension-Grant to a Dest of mine