S2S: Project: Revoke: Handle parent revoking the delegator-Grant
This commit is contained in:
Pere Lev
parent
223fbf3d0e
commit
a16fb6cd19
1 changed files with 213 additions and 0 deletions
|
|
@ -4848,6 +4848,218 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do
|
|||
Just () ->
|
||||
done "Saw the removal attempt, just waiting for the Revoke"
|
||||
|
||||
-- Meaning: An actor is revoking Grant activities
|
||||
-- Behavior:
|
||||
-- * For each revoked activity:
|
||||
-- * If it's a parent revoking a delegator-Grant it gave me:
|
||||
-- * Delete the whole Dest record
|
||||
-- * Forward the Revoke to my followers
|
||||
-- * Send Accept to parent+followers & my followers
|
||||
-- * If it's a child revoking a Grant it had extended to me:
|
||||
-- * Delete that extension from my Source record
|
||||
-- * For each further extension I did on that Grant (to a
|
||||
-- parent/collab/team), send a Revoke
|
||||
projectRevoke
|
||||
:: UTCTime
|
||||
-> ProjectId
|
||||
-> Verse
|
||||
-> AP.Revoke URIMode
|
||||
-> ActE (Text, Act (), Next)
|
||||
projectRevoke now projectID (Verse authorIdMsig body) (AP.Revoke (luFirst :| lusRest)) = do
|
||||
|
||||
ObjURI h _ <- lift $ getActorURI authorIdMsig
|
||||
parseRevoked <- do
|
||||
hl <- hostIsLocal h
|
||||
return $
|
||||
\ lu ->
|
||||
if hl
|
||||
then
|
||||
Left . (\ (a, _, i) -> (a, i)) <$>
|
||||
parseLocalActivityURI' lu
|
||||
else pure $ Right lu
|
||||
revokedFirst <- parseRevoked luFirst
|
||||
revokedRest <- traverse parseRevoked lusRest
|
||||
|
||||
mode <- withDBExcept $ do
|
||||
|
||||
revokedFirstDB <- do
|
||||
a <- getActivity $ second (ObjURI h) revokedFirst
|
||||
fromMaybeE a "Can't find revoked in DB"
|
||||
|
||||
let adapt = maybe (Right Nothing) (either Left (Right . Just))
|
||||
maybeMode <-
|
||||
ExceptT $ fmap adapt $ runMaybeT $
|
||||
runExceptT (Left <$> tryParent revokedFirstDB) <|>
|
||||
runExceptT (Right <$> lift mzero)
|
||||
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"
|
||||
|
||||
where
|
||||
|
||||
verifyDestHolder :: DestId -> ActDBE ()
|
||||
verifyDestHolder destID = do
|
||||
mh <- lift $ getValBy $ UniqueDestHolderProject destID
|
||||
case mh of
|
||||
Just (DestHolderProject _ j) | j == projectID -> pure ()
|
||||
_ -> throwE "Revoke object is a Grant for some other project/team"
|
||||
|
||||
tryParent' usAcceptID send = do
|
||||
DestUsAccept destID _ <- lift $ lift $ getJust usAcceptID
|
||||
ExceptT $ lift $ runExceptT $ verifyDestHolder destID
|
||||
topic <- do
|
||||
t <- lift . lift $ getDestTopic destID
|
||||
bitraverse
|
||||
(\ (l, k) ->
|
||||
case k of
|
||||
Left j -> pure (l, j)
|
||||
Right _ -> error "Project Dest topic is a Group, impossible"
|
||||
)
|
||||
pure
|
||||
t
|
||||
return (destID, usAcceptID, topic, send)
|
||||
|
||||
tryParent (Left (_actorByKey, _actorEntity, itemID)) = do
|
||||
Entity sendID (DestThemSendDelegatorLocal usAcceptID _localID _) <-
|
||||
lift $ MaybeT $ getBy $ UniqueDestThemSendDelegatorLocalGrant itemID
|
||||
tryParent' usAcceptID (Left sendID) --(Left localID)
|
||||
tryParent (Right remoteActivityID) = do
|
||||
Entity sendID (DestThemSendDelegatorRemote usAcceptID _remoteID _) <-
|
||||
lift $ MaybeT $ getBy $ UniqueDestThemSendDelegatorRemoteGrant remoteActivityID
|
||||
tryParent' usAcceptID (Right sendID) --(Right remoteID)
|
||||
|
||||
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"
|
||||
|
||||
unless (null revokedRest) $
|
||||
throwE "Parent revoking the delegator-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
|
||||
|
||||
-- Delete uses of this Dest from my Component records
|
||||
case send of
|
||||
Left sendID ->
|
||||
deleteWhere [ComponentGatherLocalParent ==. sendID]
|
||||
Right sendID ->
|
||||
deleteWhere [ComponentGatherRemoteParent ==. sendID]
|
||||
|
||||
-- Delete uses of this Dest from my Source records
|
||||
case send of
|
||||
Left sendID -> do
|
||||
gatherIDs <-
|
||||
map (sourceUsGatherToLocalGather . entityVal) <$>
|
||||
selectList [SourceUsGatherToLocalTo ==. sendID] []
|
||||
deleteWhere [SourceUsGatherFromLocalGather <-. gatherIDs]
|
||||
deleteWhere [SourceUsGatherFromRemoteGather <-. gatherIDs]
|
||||
deleteWhere [SourceUsGatherToLocalGather <-. gatherIDs]
|
||||
deleteWhere [SourceUsGatherId <-. gatherIDs]
|
||||
Right sendID -> do
|
||||
gatherIDs <-
|
||||
map (sourceUsGatherToRemoteGather . entityVal) <$>
|
||||
selectList [SourceUsGatherToRemoteTo ==. sendID] []
|
||||
deleteWhere [SourceUsGatherFromLocalGather <-. gatherIDs]
|
||||
deleteWhere [SourceUsGatherFromRemoteGather <-. gatherIDs]
|
||||
deleteWhere [SourceUsGatherToRemoteGather <-. gatherIDs]
|
||||
deleteWhere [SourceUsGatherId <-. gatherIDs]
|
||||
|
||||
-- Delete the whole Dest record
|
||||
case send of
|
||||
Left sendID -> delete sendID
|
||||
Right sendID -> delete sendID
|
||||
origin <-
|
||||
requireEitherAlt
|
||||
(getKeyBy $ UniqueDestOriginUs destID)
|
||||
(getKeyBy $ UniqueDestOriginThem destID)
|
||||
"Neither us nor them"
|
||||
"Both us and them"
|
||||
deleteBy $ UniqueDestUsGestureLocal destID
|
||||
deleteBy $ UniqueDestUsGestureRemote destID
|
||||
case origin of
|
||||
Left usID -> delete usID
|
||||
Right themID -> do
|
||||
deleteBy $ UniqueDestThemAcceptLocal themID
|
||||
deleteBy $ UniqueDestThemAcceptRemote themID
|
||||
deleteBy $ UniqueDestThemGestureLocal themID
|
||||
deleteBy $ UniqueDestThemGestureRemote themID
|
||||
delete themID
|
||||
delete usAcceptID
|
||||
case parent of
|
||||
Left (l, _j) -> do
|
||||
deleteBy $ UniqueDestTopicProjectTopic l
|
||||
delete l
|
||||
Right (r, _) -> delete r
|
||||
deleteBy $ UniqueDestHolderProject destID
|
||||
delete destID
|
||||
|
||||
-- Prepare forwarding Remove to my followers
|
||||
sieve <- lift $ do
|
||||
topicHash <- encodeKeyHashid projectID
|
||||
let topicByHash =
|
||||
LocalActorProject topicHash
|
||||
return $ makeRecipientSet [] [localActorFollowers topicByHash]
|
||||
|
||||
-- Prepare Accept activity
|
||||
accept@(actionAccept, _, _, _) <- prepareAccept
|
||||
let recipByKey = LocalActorProject projectID
|
||||
acceptID <- insertEmptyOutboxItem' (actorOutbox actorRecip) now
|
||||
_luAccept <- updateOutboxItem' recipByKey acceptID actionAccept
|
||||
|
||||
return (projectActor project, sieve, acceptID, accept)
|
||||
|
||||
case maybeNew of
|
||||
Nothing -> done "I already have this activity in my inbox"
|
||||
Just (topicActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
|
||||
let topicByID = LocalActorProject projectID
|
||||
forwardActivity authorIdMsig body topicByID topicActorID sieve
|
||||
lift $
|
||||
sendActivity
|
||||
topicByID topicActorID localRecipsAccept
|
||||
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
|
||||
done "Deleted the Parent/Dest, forwarded Revoke, sent Accept"
|
||||
|
||||
where
|
||||
|
||||
prepareAccept = do
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
|
||||
audParent <- makeAudSenderWithFollowers authorIdMsig
|
||||
audMe <-
|
||||
AudLocal [] . pure . LocalStageProjectFollowers <$>
|
||||
encodeKeyHashid projectID
|
||||
uRevoke <- lift $ getActivityURI authorIdMsig
|
||||
|
||||
let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
|
||||
collectAudience [audParent, audMe]
|
||||
|
||||
recips = map encodeRouteHome audLocal ++ audRemote
|
||||
action = AP.Action
|
||||
{ AP.actionCapability = Nothing
|
||||
, AP.actionSummary = Nothing
|
||||
, AP.actionAudience = AP.Audience recips [] [] [] [] []
|
||||
, AP.actionFulfills = [uRevoke]
|
||||
, AP.actionSpecific = AP.AcceptActivity AP.Accept
|
||||
{ AP.acceptObject = uRevoke
|
||||
, AP.acceptResult = Nothing
|
||||
}
|
||||
}
|
||||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
-- Meaning: An actor is undoing some previous action
|
||||
-- Behavior:
|
||||
-- * If they're undoing their Following of me:
|
||||
|
|
@ -4983,6 +5195,7 @@ projectBehavior now projectID (Left verse@(Verse _authorIdMsig body)) =
|
|||
AP.JoinActivity join -> projectJoin now projectID verse join
|
||||
AP.RejectActivity reject -> projectReject now projectID verse reject
|
||||
AP.RemoveActivity remove -> projectRemove now projectID verse remove
|
||||
AP.RevokeActivity revoke -> projectRevoke now projectID verse revoke
|
||||
AP.UndoActivity undo -> projectUndo now projectID verse undo
|
||||
_ -> throwE "Unsupported activity type for Project"
|
||||
projectBehavior _ _ (Right _) = throwE "ClientMsgs aren't supported for Project"
|
||||
|
|
|
|||
Loading…
Reference in a new issue