S2S: Group: Remove: Implement resource-passive mode
This commit is contained in:
Pere Lev
parent
9df437a043
commit
4d37d1293a
1 changed files with 116 additions and 7 deletions
|
|
@ -3974,6 +3974,9 @@ groupReject = topicReject groupResource LocalResourceGroup
|
|||
-- * If I'm B, being removed from the parents of a child of mine:
|
||||
-- * Do nothing, just waiting for parent to send a Revoke on the
|
||||
-- delegator-Grant
|
||||
-- * If I'm B, being removed from the teams of a resource of mine:
|
||||
-- * Record this Remove in the Effort record
|
||||
-- * Forward to followers
|
||||
groupRemove
|
||||
:: UTCTime
|
||||
-> GroupId
|
||||
|
|
@ -3999,19 +4002,27 @@ groupRemove now groupID (Verse authorIdMsig body) remove = do
|
|||
removeChildPassive $ Left j
|
||||
Left (Right (ATGroupChildren j)) | j /= groupID ->
|
||||
removeParentPassive $ Left j
|
||||
Left (Right at) | isJust $ addTargetResourceTeams at ->
|
||||
removeResourcePassive $ Left $ fromJust $ addTargetResourceTeams at
|
||||
Right (ObjURI h luColl) -> do
|
||||
-- NOTE this is HTTP GET done synchronously in the activity
|
||||
-- handler
|
||||
manager <- asksEnv envHttpManager
|
||||
c <- AP.fetchAPID_T manager (AP.collectionId :: AP.Collection FedURI URIMode -> LocalURI) h luColl
|
||||
lu <- fromMaybeE (AP.collectionContext c) "No context"
|
||||
j <- AP.fetchAPID_T manager (AP.actorId . AP.actorLocal . AP.teamActor) h lu
|
||||
case (luColl == AP.teamChildren j, luColl == AP.teamParents j) of
|
||||
(True, False) ->
|
||||
removeParentPassive $ Right $ ObjURI h lu
|
||||
(False, True) ->
|
||||
removeChildPassive $ Right $ ObjURI h lu
|
||||
_ -> throwE "Weird collection situation"
|
||||
rwc <- AP.fetchRWC_T manager h lu
|
||||
AP.Actor l d <-
|
||||
case AP.rwcResource rwc of
|
||||
AP.ResourceActor a -> pure a
|
||||
AP.ResourceChild _ _ -> throwE "Remove.origin remote ResourceChild"
|
||||
let typ = AP.actorType d
|
||||
if typ == AP.ActorTypeTeam && Just luColl == AP.rwcSubteams rwc
|
||||
then removeParentPassive $ Right $ ObjURI h lu
|
||||
else if typ == AP.ActorTypeTeam && Just luColl == AP.rwcParentsOrProjects rwc
|
||||
then removeChildPassive $ Right $ ObjURI h lu
|
||||
else if AP.actorTypeIsResourceNT typ && Just luColl == AP.rwcTeams rwc
|
||||
then removeResourcePassive $ Right $ ObjURI h lu
|
||||
else throwE "Weird collection situation"
|
||||
_ -> throwE "I'm being removed from somewhere irrelevant"
|
||||
_ -> throwE "This Remove isn't for me"
|
||||
|
||||
|
|
@ -5166,6 +5177,104 @@ groupRemove now groupID (Verse authorIdMsig body) remove = do
|
|||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
removeResourcePassive 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
|
||||
(\ ng ->
|
||||
withDBExcept $
|
||||
getLocalResourceEntityE (resourceFromNG ng) "Resource not found in DB"
|
||||
)
|
||||
(\ 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
|
||||
|
||||
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 $ \ (removeID, _) -> do
|
||||
|
||||
-- Record the removal attempt
|
||||
insert_ $ EffortRemove sendID removeID
|
||||
|
||||
-- Prepare forwarding Remove to my followers
|
||||
sieve <- lift $ do
|
||||
topicHash <- encodeKeyHashid groupID
|
||||
let topicByHash =
|
||||
LocalActorGroup topicHash
|
||||
return $ makeRecipientSet [] [localActorFollowers topicByHash]
|
||||
|
||||
return (groupActor group, sieve, removeID)
|
||||
|
||||
case maybeNew of
|
||||
Nothing -> done "I already have this activity in my inbox"
|
||||
Just (topicActorID, sieve, inboxItemID) -> do
|
||||
let topicByID = LocalActorGroup groupID
|
||||
forwardActivity authorIdMsig body topicByID topicActorID sieve
|
||||
doneDB inboxItemID "[Resource-passive] Recorded removal attempt, forwarded Remove"
|
||||
|
||||
-- Meaning: An actor is revoking Grant activities
|
||||
-- Behavior:
|
||||
-- * For each revoked activity:
|
||||
|
|
|
|||
Loading…
Reference in a new issue