S2S: Component: Grant: Port team-mode from Project
This commit is contained in:
Pere Lev
parent
10a1f74847
commit
02f46a21f9
1 changed files with 139 additions and 2 deletions
|
|
@ -2208,13 +2208,15 @@ componentGrant grabResource topicComponent now recipKey (Verse authorIdMsig body
|
|||
withDBExcept $ do
|
||||
meResourceID <- lift $ grabResource <$> getJust recipKey
|
||||
ExceptT $ fmap adapt $ runMaybeT $
|
||||
runExceptT (id <$> tryStem grant')
|
||||
runExceptT (Left <$> tryStem grant') <|>
|
||||
runExceptT (Right <$> tryTeam meResourceID grant')
|
||||
mode <-
|
||||
fromMaybeE
|
||||
maybeMode
|
||||
"Not a relevant Grant that I'm aware of"
|
||||
case mode of
|
||||
stem -> handleStem stem
|
||||
Left stem -> handleStem stem
|
||||
Right team -> handleTeam team
|
||||
|
||||
where
|
||||
|
||||
|
|
@ -2406,6 +2408,141 @@ componentGrant grabResource topicComponent now recipKey (Verse authorIdMsig body
|
|||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
tryTeam _ (GKDelegationStart _) = lift mzero
|
||||
tryTeam _ (GKDelegationExtend _ _) = lift mzero
|
||||
tryTeam meResourceID GKDelegator = do
|
||||
uFulfills <-
|
||||
case AP.activityFulfills $ actbActivity body of
|
||||
[] -> throwE "No fulfills"
|
||||
[u] -> pure u
|
||||
_ -> throwE "Multiple fulfills"
|
||||
fulfills <- ExceptT $ lift $ lift $ runExceptT $ first (\ (a, _, i) -> (a, i)) <$> parseActivityURI' uFulfills
|
||||
fulfillsDB <- ExceptT $ MaybeT $ either (Just . Left) (fmap Right) <$> runExceptT (getActivity fulfills)
|
||||
-- Find the Squad record from the fulfills
|
||||
squadID <-
|
||||
lift $
|
||||
case fulfillsDB of
|
||||
Left (_, _, addID) ->
|
||||
(do SquadUsGestureLocal squadID _ <- MaybeT $ getValBy $ UniqueSquadUsGestureLocalActivity addID
|
||||
_ <- MaybeT $ getBy $ UniqueSquadOriginUs squadID
|
||||
return squadID
|
||||
)
|
||||
<|>
|
||||
(do SquadThemGestureLocal themID _ <- MaybeT $ getValBy $ UniqueSquadThemGestureLocalAdd addID
|
||||
SquadOriginThem squadID <- lift $ getJust themID
|
||||
return squadID
|
||||
)
|
||||
Right addID ->
|
||||
(do SquadUsGestureRemote squadID _ _ <- MaybeT $ getValBy $ UniqueSquadUsGestureRemoteActivity addID
|
||||
_ <- MaybeT $ getBy $ UniqueSquadOriginUs squadID
|
||||
return squadID
|
||||
)
|
||||
<|>
|
||||
(do SquadThemGestureRemote themID _ _ <- MaybeT $ getValBy $ UniqueSquadThemGestureRemoteAdd addID
|
||||
SquadOriginThem squadID <- lift $ getJust themID
|
||||
return squadID
|
||||
)
|
||||
-- Verify this Squad record is mine
|
||||
Squad role r <- lift $ lift $ getJust squadID
|
||||
lift $ guard $ r == meResourceID
|
||||
-- Verify the Grant sender is the Squad topic
|
||||
topic <- lift $ lift $ getSquadTeam squadID
|
||||
topicForCheck <-
|
||||
lift $ lift $
|
||||
bitraverse
|
||||
(pure . snd)
|
||||
(\ (_, raID) -> getRemoteActorURI =<< getJust raID)
|
||||
topic
|
||||
unless (first LocalActorGroup topicForCheck == bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig) $
|
||||
throwE "Squad topic and Grant author aren't the same actor"
|
||||
-- Verify I sent my Accept
|
||||
maybeMe <- lift $ lift $ getKeyBy $ UniqueSquadUsAccept squadID
|
||||
meAcceptID <- fromMaybeE maybeMe "I haven't sent my Accept"
|
||||
-- Verify I haven't yet seen a delegator-Grant from the team
|
||||
case bimap fst fst topic of
|
||||
Left localID -> do
|
||||
m <- lift $ lift $ getBy $ UniqueSquadThemSendDelegatorLocalTopic localID
|
||||
verifyNothingE m "Already have a SquadThemSendDelegatorLocal"
|
||||
Right remoteID -> do
|
||||
m <- lift $ lift $ getBy $ UniqueSquadThemSendDelegatorRemoteTopic remoteID
|
||||
verifyNothingE m "Already have a SquadThemSendDelegatorRemote"
|
||||
return (role, topic, meAcceptID)
|
||||
|
||||
handleTeam (role, topic, acceptID) = do
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
-- Grab me from DB
|
||||
meResourceID <- lift $ grabResource <$> getJust meID
|
||||
Resource meActorID <- lift $ getJust meResourceID
|
||||
meActorDB <- lift $ getJust meActorID
|
||||
|
||||
maybeGrantDB <- lift $ insertToInbox now authorIdMsig body (actorInbox meActorDB) False
|
||||
for maybeGrantDB $ \ (inboxItemID, grantDB) -> do
|
||||
|
||||
-- Record the delegator-Grant in DB
|
||||
to <- case (grantDB, bimap fst fst topic) of
|
||||
(Left (_, _, grantID), Left localID) -> Left <$> do
|
||||
mk <- lift $ insertUnique $ SquadThemSendDelegatorLocal acceptID localID grantID
|
||||
fromMaybeE mk "I already have such a SquadThemSendDelegatorLocal"
|
||||
(Right (_, _, grantID), Right remoteID) -> Right <$> do
|
||||
mk <- lift $ insertUnique $ SquadThemSendDelegatorRemote acceptID remoteID grantID
|
||||
fromMaybeE mk "I already have such a SquadThemSendDelegatorRemote"
|
||||
_ -> error "componentGrant.team impossible"
|
||||
|
||||
startID <- lift $ insertEmptyOutboxItem' (actorOutbox meActorDB) now
|
||||
squadStartID <- lift $ insert $ SquadUsStart acceptID startID
|
||||
|
||||
-- Prepare a start-Grant
|
||||
start@(actionStart, _, _, _) <- lift $ prepareStartGrant role squadStartID
|
||||
_luStart <- lift $ updateOutboxItem' meActor startID actionStart
|
||||
|
||||
return (meActorID, startID, start, inboxItemID)
|
||||
|
||||
case maybeNew of
|
||||
Nothing -> done "I already have this activity in my inbox"
|
||||
Just (recipActorID, extID, (actionExt, localRecipsExt, remoteRecipsExt, fwdHostsExt), inboxItemID) -> do
|
||||
lift $ sendActivity
|
||||
meActor recipActorID localRecipsExt
|
||||
remoteRecipsExt fwdHostsExt extID actionExt
|
||||
doneDB inboxItemID "[Team] Sent start-Grant"
|
||||
|
||||
where
|
||||
|
||||
prepareStartGrant role startID = do
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
|
||||
meHash <- hashLocalActor meActor
|
||||
|
||||
uDeleg <- lift $ getActivityURI authorIdMsig
|
||||
|
||||
audTeam <- lift $ makeAudSenderOnly authorIdMsig
|
||||
uTeam <- lift $ getActorURI authorIdMsig
|
||||
|
||||
let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
|
||||
collectAudience [audTeam]
|
||||
|
||||
recips = map encodeRouteHome audLocal ++ audRemote
|
||||
action = AP.Action
|
||||
{ AP.actionCapability = Just uDeleg
|
||||
, AP.actionSummary = Nothing
|
||||
, AP.actionAudience = AP.Audience recips [] [] [] [] []
|
||||
, AP.actionFulfills = [uDeleg]
|
||||
, AP.actionSpecific = AP.GrantActivity AP.Grant
|
||||
{ AP.grantObject = AP.RXRole role
|
||||
, AP.grantContext = encodeRouteHome $ renderLocalActor meHash
|
||||
, AP.grantTarget = uTeam
|
||||
, AP.grantResult = Nothing
|
||||
, AP.grantStart = Just now
|
||||
, AP.grantEnd = Nothing
|
||||
, AP.grantAllows = AP.Distribute
|
||||
, AP.grantDelegates = Nothing
|
||||
}
|
||||
}
|
||||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
-- Meaning: An actor is adding some object to some target
|
||||
-- Behavior:
|
||||
-- * If target is my context (i.e. parents) collection:
|
||||
|
|
|
|||
Loading…
Reference in a new issue