S2S: Component: Accept: Port team-mode from Project
This commit is contained in:
Pere Lev
parent
cdd43292bc
commit
40ab419946
2 changed files with 257 additions and 52 deletions
|
|
@ -231,6 +231,37 @@ actorFollow parseFollowee grabActor unread getFollowee getSieve makeLocalActor m
|
|||
-- * If I've already seen the project's accept, respond with error
|
||||
-- * Otherwise, just ignore the Accept
|
||||
-- * Otherwise respond with error
|
||||
--
|
||||
-- * Add-a-Team mode
|
||||
-- * Give me a new team active SquadOriginUs
|
||||
-- * Respond with error, we aren't supposed to get any Accept
|
||||
-- * Give me a new team passive SquadOriginThem
|
||||
-- * Option 1: I haven't yet seen parent's Accept
|
||||
-- * Verify sender is the parent
|
||||
-- * Option 2: I saw it, but not my collaborator's Accept
|
||||
-- * Verify the accept is authorized
|
||||
-- * Otherwise respond with error, no Accept is needed
|
||||
--
|
||||
-- * Insert the Accept to my inbox
|
||||
--
|
||||
-- * In team-passive mode,
|
||||
-- * Option 1: Record team's Accept in the Dest record
|
||||
-- * Option 2: Record my collaborator's Accept in the Squad record
|
||||
-- * Prepare to send my own Accept
|
||||
--
|
||||
-- * Forward the Accept to my followers
|
||||
--
|
||||
-- * Possibly send a Grant/Accept:
|
||||
-- * Team-passive
|
||||
-- * In option 2
|
||||
-- * Accept
|
||||
-- * Object: The Add
|
||||
-- * Fulfills: My collaborator's Accept
|
||||
-- * To: Team
|
||||
-- * CC:
|
||||
-- - Team's followers
|
||||
-- - My followers
|
||||
-- - The Accept sender (my collaborator)
|
||||
topicAccept
|
||||
:: forall topic.
|
||||
(PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic)
|
||||
|
|
@ -246,14 +277,6 @@ topicAccept grabResource topicComponent now recipKey (Verse authorIdMsig body) a
|
|||
-- Check input
|
||||
acceptee <- parseAccept accept
|
||||
|
||||
-- Verify the capability URI, if provided, is one of:
|
||||
-- * Outbox item URI of a local actor, i.e. a local activity
|
||||
-- * A remote URI
|
||||
maybeCap <-
|
||||
traverse
|
||||
(nameExceptT "Accept capability" . parseActivityURI')
|
||||
(AP.activityCapability $ actbActivity body)
|
||||
|
||||
-- Grab me from DB
|
||||
(resourceID, recipActorID, recipActor) <- lift $ withDB $ do
|
||||
resourceID <- grabResource <$> getJust recipKey
|
||||
|
|
@ -261,7 +284,7 @@ topicAccept grabResource topicComponent now recipKey (Verse authorIdMsig body) a
|
|||
recipActor <- getJust recipActorID
|
||||
return (resourceID, recipActorID, recipActor)
|
||||
|
||||
collabOrStem <- withDBExcept $ do
|
||||
mode <- withDBExcept $ do
|
||||
|
||||
-- Find the accepted activity in our DB
|
||||
accepteeDB <- do
|
||||
|
|
@ -274,20 +297,30 @@ topicAccept grabResource topicComponent now recipKey (Verse authorIdMsig body) a
|
|||
-- component, grabbing the Stem record from our DB
|
||||
maybeCollabOrStem <-
|
||||
lift $ runMaybeT $
|
||||
Left . Left <$> tryInviteCollab accepteeDB <|>
|
||||
Left . Right <$> tryJoinCollab accepteeDB <|>
|
||||
Right . Left <$> tryInviteComp accepteeDB <|>
|
||||
Right . Right <$> tryAddComp accepteeDB
|
||||
Left . Left . Left <$> tryInviteCollab accepteeDB <|>
|
||||
Left . Left . Right <$> tryJoinCollab accepteeDB <|>
|
||||
Left . Right . Left <$> tryInviteComp accepteeDB <|>
|
||||
Left . Right . Right <$> tryAddComp accepteeDB <|>
|
||||
Right <$> tryAddTeamActive resourceID accepteeDB <|>
|
||||
Right <$> tryAddTeamPassive resourceID accepteeDB
|
||||
fromMaybeE maybeCollabOrStem "Accepted activity isn't an Invite/Join/Add I'm aware of"
|
||||
|
||||
case collabOrStem of
|
||||
Left collab ->
|
||||
topicAcceptCollab maybeCap recipActorID recipActor collab
|
||||
Right stem ->
|
||||
topicAcceptStem maybeCap recipActorID recipActor stem
|
||||
case mode of
|
||||
Left (Left collab) ->
|
||||
topicAcceptCollab recipActorID recipActor collab
|
||||
Left (Right stem) ->
|
||||
topicAcceptStem recipActorID recipActor stem
|
||||
Right team -> addTeam team
|
||||
|
||||
where
|
||||
|
||||
meID = recipKey
|
||||
toComponent = topicComponent
|
||||
|
||||
meComponent = toComponent recipKey
|
||||
meResource = componentResource meComponent
|
||||
meActor = resourceToActor meResource
|
||||
|
||||
topicResource :: forall f. f topic -> LocalResourceBy f
|
||||
topicResource = componentResource . topicComponent
|
||||
|
||||
|
|
@ -343,6 +376,41 @@ topicAccept grabResource topicComponent now recipKey (Verse authorIdMsig body) a
|
|||
lift $ (,remoteActorFollowers actor,remoteActivityID) <$> getRemoteActorURI actor
|
||||
return (stemID, originID, Right adder)
|
||||
|
||||
verifySquadHolder :: ResourceId -> SquadId -> MaybeT ActDB ()
|
||||
verifySquadHolder meResourceID squadID = do
|
||||
Squad _ r <- lift $ getJust squadID
|
||||
guard $ r == meResourceID
|
||||
|
||||
tryAddTeamActive' r squadID = do
|
||||
usID <- MaybeT $ getKeyBy $ UniqueSquadOriginUs squadID
|
||||
verifySquadHolder r squadID
|
||||
topic <- lift $ getSquadTeam squadID
|
||||
return (squadID, topic, Left ())
|
||||
|
||||
tryAddTeamActive r (Left (_actorByKey, _actorEntity, itemID)) = do
|
||||
SquadUsGestureLocal squadID _ <-
|
||||
MaybeT $ getValBy $ UniqueSquadUsGestureLocalActivity itemID
|
||||
tryAddTeamActive' r squadID
|
||||
tryAddTeamActive r (Right remoteActivityID) = do
|
||||
SquadUsGestureRemote squadID _ _ <-
|
||||
MaybeT $ getValBy $ UniqueSquadUsGestureRemoteActivity remoteActivityID
|
||||
tryAddTeamActive' r squadID
|
||||
|
||||
tryAddTeamPassive' r themID = do
|
||||
SquadOriginThem squadID <- lift $ getJust themID
|
||||
verifySquadHolder r squadID
|
||||
topic <- lift $ getSquadTeam squadID
|
||||
return (squadID, topic, Right themID)
|
||||
|
||||
tryAddTeamPassive r (Left (_actorByKey, _actorEntity, itemID)) = do
|
||||
SquadThemGestureLocal themID _ <-
|
||||
MaybeT $ getValBy $ UniqueSquadThemGestureLocalAdd itemID
|
||||
tryAddTeamPassive' r themID
|
||||
tryAddTeamPassive r (Right remoteActivityID) = do
|
||||
SquadThemGestureRemote themID _ _ <-
|
||||
MaybeT $ getValBy $ UniqueSquadThemGestureRemoteAdd remoteActivityID
|
||||
tryAddTeamPassive' r themID
|
||||
|
||||
prepareGrant isInvite sender role = do
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
|
|
@ -405,7 +473,15 @@ topicAccept grabResource topicComponent now recipKey (Verse authorIdMsig body) a
|
|||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
topicAcceptCollab maybeCap recipActorID recipActor collab = do
|
||||
topicAcceptCollab recipActorID recipActor collab = do
|
||||
|
||||
-- Verify the capability URI, if provided, is one of:
|
||||
-- * Outbox item URI of a local actor, i.e. a local activity
|
||||
-- * A remote URI
|
||||
maybeCap <-
|
||||
traverse
|
||||
(nameExceptT "Accept capability" . parseActivityURI')
|
||||
(AP.activityCapability $ actbActivity body)
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
|
|
@ -568,7 +644,15 @@ topicAccept grabResource topicComponent now recipKey (Verse authorIdMsig body) a
|
|||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
topicAcceptStem maybeCap recipActorID recipActor stem = do
|
||||
topicAcceptStem recipActorID recipActor stem = do
|
||||
|
||||
-- Verify the capability URI, if provided, is one of:
|
||||
-- * Outbox item URI of a local actor, i.e. a local activity
|
||||
-- * A remote URI
|
||||
maybeCap <-
|
||||
traverse
|
||||
(nameExceptT "Accept capability" . parseActivityURI')
|
||||
(AP.activityCapability $ actbActivity body)
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
|
|
@ -695,6 +779,159 @@ topicAccept grabResource topicComponent now recipKey (Verse authorIdMsig body) a
|
|||
remoteRecipsReact fwdHostsReact reactID actionReact
|
||||
doneDB inboxItemID "Forwarded the Accept and published an Accept"
|
||||
|
||||
theyIsAuthor' :: Either (a, GroupId) (b, RemoteActorId) -> Bool
|
||||
theyIsAuthor' ident =
|
||||
let author = bimap (view _1) (remoteAuthorId . view _1) authorIdMsig
|
||||
in author == bimap (LocalActorGroup . snd) snd ident
|
||||
|
||||
addTeam (squadID, topic, mode) = do
|
||||
|
||||
(themID, mode') <-
|
||||
case mode of
|
||||
|
||||
-- Team-active mode
|
||||
-- Respond with error, we aren't supposed to get any Accept
|
||||
Left () -> throwE "Team-active (SquadOriginUs) mode, I'm not expecting any Accept"
|
||||
|
||||
-- Team-passive mode
|
||||
-- Option 1: I haven't yet seen team's Accept
|
||||
-- * Verify sender is the team
|
||||
-- Option 2: I saw it, but not my collaborator's Accept
|
||||
-- * Verify the accept is authorized
|
||||
-- Otherwise respond with error, no Accept is needed
|
||||
Right themID -> (themID,) <$> do
|
||||
(maybeTeamAccept, maybeUsGesture) <-
|
||||
lift $ withDB $ liftA2 (,)
|
||||
(case bimap fst fst topic of
|
||||
Left localID -> (() <$) <$> getBy (UniqueSquadThemAcceptLocalTopic localID)
|
||||
Right remoteID -> (() <$) <$> getBy (UniqueSquadThemAcceptRemoteTopic remoteID)
|
||||
)
|
||||
(do l <- getBy $ UniqueSquadUsGestureLocal squadID
|
||||
r <- getBy $ UniqueSquadUsGestureRemote squadID
|
||||
case (isJust l, isJust r) of
|
||||
(False, False) -> pure Nothing
|
||||
(False, True) -> pure $ Just ()
|
||||
(True, False) -> pure $ Just ()
|
||||
(True, True) -> error "Both SquadUsGestureLocal and SquadUsGestureRemote"
|
||||
)
|
||||
case (isJust maybeTeamAccept, isJust maybeUsGesture) of
|
||||
(False, True) -> error "Impossible/bug, didn't see team's Accept but recorded my collaborator's Accept"
|
||||
(False, False) -> do
|
||||
unless (theyIsAuthor' topic) $
|
||||
throwE "The Accept I'm waiting for is from my new team"
|
||||
return $ Left ()
|
||||
(True, False) -> do
|
||||
let muCap = AP.activityCapability $ actbActivity body
|
||||
uCap <- fromMaybeE muCap "No capability provided"
|
||||
verifyCapability''
|
||||
uCap
|
||||
authorIdMsig
|
||||
meResource
|
||||
AP.RoleAdmin
|
||||
return $ Right ()
|
||||
(True, True) -> throwE "Just waiting for Grant from team, or already have it, anyway not needing any further Accept"
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
-- Grab me from DB
|
||||
meResourceID <- lift $ grabResource <$> getJust meID
|
||||
Resource meActorID <- lift $ getJust meResourceID
|
||||
meActorDB <- lift $ getJust meActorID
|
||||
|
||||
maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox meActorDB) False
|
||||
for maybeAcceptDB $ \ (inboxItemID, acceptDB) -> do
|
||||
|
||||
idsForGrant <-
|
||||
lift $ case mode' of
|
||||
|
||||
-- Getting an Accept from the team
|
||||
-- Record team's Accept in the Squad record
|
||||
Left () -> do
|
||||
case (topic, acceptDB) of
|
||||
(Left (localID, _), Left (_, _, acceptID)) ->
|
||||
insert_ $ SquadThemAcceptLocal themID localID acceptID
|
||||
(Right (remoteID, _), Right (_, _, acceptID)) ->
|
||||
insert_ $ SquadThemAcceptRemote themID remoteID acceptID
|
||||
_ -> error "topicAccept impossible v"
|
||||
return Nothing
|
||||
|
||||
-- Getting an Accept from my collaborator
|
||||
-- Record my collaborator's Accept in the Squad record
|
||||
-- Prepare to send my own Accept
|
||||
Right () -> Just <$> do
|
||||
case acceptDB of
|
||||
Left (_, _, acceptID) ->
|
||||
insert_ $ SquadUsGestureLocal squadID acceptID
|
||||
Right (author, _, acceptID) ->
|
||||
insert_ $ SquadUsGestureRemote squadID (remoteAuthorId author) acceptID
|
||||
acceptID <- insertEmptyOutboxItem' (actorOutbox meActorDB) now
|
||||
insert_ $ SquadUsAccept squadID acceptID
|
||||
return acceptID
|
||||
|
||||
-- Prepare forwarding of Accept to my followers
|
||||
sieve <- do
|
||||
h <- hashLocalActor meActor
|
||||
return $ makeRecipientSet [] [localActorFollowers h]
|
||||
|
||||
maybeAct <-
|
||||
for idsForGrant $ \ acceptID -> lift $ do
|
||||
accept@(actionAccept, _, _, _) <-
|
||||
prepareSquadAccept (bimap snd snd topic)
|
||||
_luAccept <- updateOutboxItem' meActor acceptID actionAccept
|
||||
return (acceptID, accept)
|
||||
|
||||
return (meActorID, sieve, maybeAct, inboxItemID)
|
||||
|
||||
case maybeNew of
|
||||
Nothing -> done "I already have this activity in my inbox"
|
||||
Just (recipActorID, sieve, maybeGrant, inboxItemID) -> do
|
||||
forwardActivity authorIdMsig body meActor recipActorID sieve
|
||||
lift $ for_ maybeGrant $ \ (grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant)) ->
|
||||
sendActivity
|
||||
meActor recipActorID localRecipsGrant
|
||||
remoteRecipsGrant fwdHostsGrant grantID actionGrant
|
||||
doneDB inboxItemID "[Team] Forwarded the Accept and maybe published a Grant/Accept"
|
||||
|
||||
where
|
||||
|
||||
prepareSquadAccept topic = do
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
|
||||
audMyCollab <- lift $ makeAudSenderOnly authorIdMsig
|
||||
audSquad <-
|
||||
case topic of
|
||||
Left j -> do
|
||||
h <- encodeKeyHashid j
|
||||
return $
|
||||
AudLocal [LocalActorGroup h] [LocalStageGroupFollowers h]
|
||||
Right raID -> do
|
||||
ra <- getJust raID
|
||||
ObjURI h lu <- getRemoteActorURI ra
|
||||
return $
|
||||
AudRemote h [lu] (maybeToList $ remoteActorFollowers ra)
|
||||
audMe <-
|
||||
AudLocal [] . pure . localActorFollowers <$>
|
||||
hashLocalActor meActor
|
||||
uCollabAccept <- lift $ getActivityURI authorIdMsig
|
||||
let uAdd = AP.acceptObject accept
|
||||
|
||||
(recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
|
||||
collectAudience [audMyCollab, audSquad, audMe]
|
||||
|
||||
recips = map encodeRouteHome audLocal ++ audRemote
|
||||
action = AP.Action
|
||||
{ AP.actionCapability = Nothing
|
||||
, AP.actionSummary = Nothing
|
||||
, AP.actionAudience = AP.Audience recips [] [] [] [] []
|
||||
, AP.actionFulfills = [uCollabAccept]
|
||||
, AP.actionSpecific = AP.AcceptActivity AP.Accept
|
||||
{ AP.acceptObject = uAdd
|
||||
, AP.acceptResult = Nothing
|
||||
}
|
||||
}
|
||||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
topicReject
|
||||
:: (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic)
|
||||
=> (topic -> ResourceId)
|
||||
|
|
|
|||
|
|
@ -541,38 +541,6 @@ deckFollow now recipDeckID verse follow = do
|
|||
-- Access
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- Meaning: An actor accepted something
|
||||
-- Behavior:
|
||||
-- * If it's on an Invite where I'm the resource:
|
||||
-- * Verify the Accept is by the Invite target
|
||||
-- * Forward the Accept to my followers
|
||||
-- * Send a Grant:
|
||||
-- * To: Accepter (i.e. Invite target)
|
||||
-- * CC: Invite sender, Accepter's followers, my followers
|
||||
-- * If it's on a Join where I'm the resource:
|
||||
-- * Verify the Accept is authorized
|
||||
-- * Forward the Accept to my followers
|
||||
-- * Send a Grant:
|
||||
-- * To: Join sender
|
||||
-- * CC: Accept sender, Join sender's followers, my followers
|
||||
-- * If it's an Invite (that I know about) where I'm invited to a project:
|
||||
-- * If I haven't yet seen the project's approval:
|
||||
-- * Verify the author is the project
|
||||
-- * Record the approval in the Stem record in DB
|
||||
-- * If I saw project's approval, but not my collaborators' approval:
|
||||
-- * Verify the Accept is authorized
|
||||
-- * Record the approval in the Stem record in DB
|
||||
-- * Forward to my followers
|
||||
-- * Publish and send an Accept:
|
||||
-- * To: Inviter, project, Accept author
|
||||
-- * CC: Project followers, my followers
|
||||
-- * Record it in the Stem record in DB as well
|
||||
-- * If I already saw both approvals, respond with error
|
||||
-- * If it's an Add (that I know about and already Accepted) where I'm
|
||||
-- invited to a project:
|
||||
-- * If I've already seen the project's accept, respond with error
|
||||
-- * Otherwise, just ignore the Accept
|
||||
-- * Otherwise respond with error
|
||||
deckAccept
|
||||
:: UTCTime
|
||||
-> DeckId
|
||||
|
|
|
|||
Loading…
Reference in a new issue