S2S: Invite: Remove Invite-based add-component code
This commit is contained in:
parent
1fa71b6b9c
commit
e0935ee6db
3 changed files with 106 additions and 289 deletions
|
@ -1179,18 +1179,6 @@ topicReject grabResource topicResource now recipKey (Verse authorIdMsig body) re
|
|||
-- * Remember the invite in DB
|
||||
-- * Forward the Invite to my followers
|
||||
-- * Send Accept to A, B, my-followers
|
||||
-- * If I'm B, i.e. I'm the one being invited:
|
||||
-- * Verify the resource is some project's components collection URI
|
||||
-- * For each Stem record I have for this project:
|
||||
-- * Verify it's not enabled yet, i.e. I'm not already a component
|
||||
-- of this project
|
||||
-- * Verify it's not in Invite-Accept state, already got the
|
||||
-- project's Accept and waiting for my approval
|
||||
-- * Verify it's not in Add-Accept state, has my approval and
|
||||
-- waiting for the project's side
|
||||
-- * Create a Stem record in DB
|
||||
-- * Insert the Invite to my inbox
|
||||
-- * Forward the Invite to my followers
|
||||
componentInvite
|
||||
:: forall topic.
|
||||
(PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic)
|
||||
|
@ -1204,17 +1192,11 @@ componentInvite
|
|||
componentInvite grabKomponent topicComponent now topicKey (Verse authorIdMsig body) invite = do
|
||||
|
||||
-- Check invite
|
||||
recipOrProject <- do
|
||||
(role, targetByKey) <- do
|
||||
let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig
|
||||
(role, resourceOrComps, recipientOrComp) <- parseInvite author invite
|
||||
let collabMode =
|
||||
Left (Left $ topicResource topicKey) == resourceOrComps
|
||||
compMode =
|
||||
Left (Right $ topicComponent topicKey) == recipientOrComp
|
||||
case (collabMode, compMode) of
|
||||
(False, False) -> throwE "Invite is unrelated to me"
|
||||
(True, True) -> throwE "I'm being invited as a collaborator in myself"
|
||||
(True, False) -> Left . (role,) <$>
|
||||
if Left (Left $ topicResource topicKey) == resourceOrComps
|
||||
then (role,) <$>
|
||||
bitraverse
|
||||
(\case
|
||||
Left r -> pure r
|
||||
|
@ -1222,20 +1204,9 @@ componentInvite grabKomponent topicComponent now topicKey (Verse authorIdMsig bo
|
|||
)
|
||||
pure
|
||||
recipientOrComp
|
||||
(False, True) -> Right <$> do
|
||||
unless (role == AP.RoleAdmin) $
|
||||
throwE "Invite-component role isn't admin"
|
||||
bitraverse
|
||||
(\case
|
||||
Left _ -> throwE "Inviting me to be a collaborator doesn't make sense to me"
|
||||
Right j -> pure j
|
||||
)
|
||||
pure
|
||||
resourceOrComps
|
||||
else throwE "Invite is unrelated to me"
|
||||
|
||||
recipOrProjectDB <-
|
||||
bitraverse
|
||||
(\ (role, targetByKey) -> do
|
||||
(capability, targetDB) <- do
|
||||
|
||||
-- Check capability
|
||||
capability <- do
|
||||
|
@ -1282,52 +1253,7 @@ componentInvite grabKomponent topicComponent now topicKey (Verse authorIdMsig bo
|
|||
)
|
||||
targetByKey
|
||||
|
||||
return (role, capability, targetByKey, targetDB)
|
||||
)
|
||||
|
||||
-- If project is local, find it in our DB
|
||||
-- If project is remote, HTTP GET it 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.
|
||||
(bitraverse
|
||||
(withDBExcept . flip getEntityE "Project not found in DB")
|
||||
(\ u@(ObjURI h luComps) -> do
|
||||
manager <- asksEnv envHttpManager
|
||||
collection <-
|
||||
ExceptT $ first T.pack <$>
|
||||
AP.fetchAPID
|
||||
manager
|
||||
(AP.collectionId :: AP.Collection FedURI URIMode -> LocalURI)
|
||||
h
|
||||
luComps
|
||||
luProject <- fromMaybeE (AP.collectionContext collection) "Collection has no context"
|
||||
project <-
|
||||
ExceptT $ first T.pack <$>
|
||||
AP.fetchAPID manager (AP.actorId . AP.actorLocal . AP.projectActor) h luProject
|
||||
unless (AP.projectComponents project == luComps) $
|
||||
throwE "The collection isn't the project's components collection"
|
||||
|
||||
instanceID <-
|
||||
lift $ withDB $ either entityKey id <$> insertBy' (Instance h)
|
||||
result <-
|
||||
ExceptT $ first (T.pack . displayException) <$>
|
||||
fetchRemoteActor' instanceID h luProject
|
||||
case result of
|
||||
Left Nothing -> throwE "Target @id mismatch"
|
||||
Left (Just err) -> throwE $ T.pack $ displayException err
|
||||
Right Nothing -> throwE "Target isn't an actor"
|
||||
Right (Just actor) -> do
|
||||
unless (remoteActorType (entityVal actor) == AP.ActorTypeProject) $
|
||||
throwE "Remote project type isn't Project"
|
||||
return $ entityKey actor
|
||||
)
|
||||
)
|
||||
|
||||
recipOrProject
|
||||
return (capability, targetDB)
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
|
@ -1337,9 +1263,6 @@ componentInvite grabKomponent topicComponent now topicKey (Verse authorIdMsig bo
|
|||
Resource topicActorID <- lift $ getJust resourceID
|
||||
topicActor <- lift $ getJust topicActorID
|
||||
|
||||
case recipOrProjectDB of
|
||||
Left (role, capability, _targetByKey, targetDB) -> do
|
||||
|
||||
-- Verify the specified capability gives relevant access
|
||||
verifyCapability'
|
||||
capability authorIdMsig (topicResource topicKey) AP.RoleAdmin
|
||||
|
@ -1370,13 +1293,6 @@ componentInvite grabKomponent topicComponent now topicKey (Verse authorIdMsig bo
|
|||
[_] -> throwE "I already have a Collab for the target"
|
||||
_ -> error "Multiple collabs found for target"
|
||||
|
||||
Right projectDB ->
|
||||
|
||||
-- Find existing Stem records I have for this project
|
||||
-- Make sure none are enabled / in Add-Accept mode / in Invite-Accept
|
||||
-- mode
|
||||
checkExistingStems komponentID projectDB
|
||||
|
||||
maybeInviteDB <- lift $ insertToInbox now authorIdMsig body (actorInbox topicActor) False
|
||||
lift $ for maybeInviteDB $ \ (inboxItemID, inviteDB) -> do
|
||||
|
||||
|
@ -1387,33 +1303,27 @@ componentInvite grabKomponent topicComponent now topicKey (Verse authorIdMsig bo
|
|||
resourceToActor $ topicResource topicHash
|
||||
return $ makeRecipientSet [] [localActorFollowers topicByHash]
|
||||
|
||||
-- Insert Collab or Stem record to DB
|
||||
-- In Collab mode: Prepare an Accept activity and insert to my
|
||||
-- outbox
|
||||
maybeAccept <- case recipOrProjectDB of
|
||||
Left (role, _capability, targetByKey, targetDB) -> Just <$> do
|
||||
-- Insert Collab record to DB
|
||||
-- Prepare an Accept activity and insert to my outbox
|
||||
(acceptID, accept) <- do
|
||||
acceptID <- insertEmptyOutboxItem' (actorOutbox topicActor) now
|
||||
insertCollab resourceID role targetDB inviteDB acceptID
|
||||
accept@(actionAccept, _, _, _) <- lift $ prepareAccept targetByKey
|
||||
let topicByKey = resourceToActor $ topicResource topicKey
|
||||
_luAccept <- updateOutboxItem' topicByKey acceptID actionAccept
|
||||
return (acceptID, accept)
|
||||
Right projectDB -> do
|
||||
insertStem komponentID projectDB inviteDB
|
||||
return Nothing
|
||||
|
||||
return (topicActorID, sieve, maybeAccept, inboxItemID)
|
||||
return (topicActorID, sieve, acceptID, accept, inboxItemID)
|
||||
|
||||
case maybeNew of
|
||||
Nothing -> done "I already have this activity in my inbox"
|
||||
Just (topicActorID, sieve, maybeAccept, inboxItemID) -> do
|
||||
Just (topicActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do
|
||||
let topicByID = resourceToActor $ topicResource topicKey
|
||||
forwardActivity authorIdMsig body topicByID topicActorID sieve
|
||||
lift $ for_ maybeAccept $ \ (acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) ->
|
||||
sendActivity
|
||||
lift $ sendActivity
|
||||
topicByID topicActorID localRecipsAccept remoteRecipsAccept
|
||||
fwdHostsAccept acceptID actionAccept
|
||||
doneDB inboxItemID "Recorded and forwarded the Invite, sent an Accept if collab"
|
||||
doneDB inboxItemID "Recorded and forwarded the Invite, sent an Accept"
|
||||
|
||||
where
|
||||
|
||||
|
@ -1435,20 +1345,6 @@ componentInvite grabKomponent topicComponent now topicKey (Verse authorIdMsig bo
|
|||
Right remoteActorID ->
|
||||
insert_ $ CollabRecipRemote collabID remoteActorID
|
||||
|
||||
insertStem komponentID projectDB inviteDB = do
|
||||
stemID <- insert $ Stem AP.RoleAdmin komponentID
|
||||
case projectDB of
|
||||
Left (Entity projectID _) ->
|
||||
insert_ $ StemProjectLocal stemID projectID
|
||||
Right remoteActorID ->
|
||||
insert_ $ StemProjectRemote stemID remoteActorID
|
||||
originID <- insert $ StemOriginInvite stemID
|
||||
case inviteDB of
|
||||
Left (_, _, inviteID) ->
|
||||
insert_ $ StemProjectGestureLocal originID inviteID
|
||||
Right (author, _, inviteID) ->
|
||||
insert_ $ StemProjectGestureRemote originID (remoteAuthorId author) inviteID
|
||||
|
||||
prepareAccept invited = do
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
|
||||
|
|
|
@ -574,27 +574,6 @@ deckReject
|
|||
-> ActE (Text, Act (), Next)
|
||||
deckReject = topicReject deckResource LocalResourceDeck
|
||||
|
||||
-- Meaning: An actor A invited actor B to a resource
|
||||
-- Behavior:
|
||||
-- * If resource is my collaborators collection:
|
||||
-- * Verify A isn't inviting themselves
|
||||
-- * Verify A is authorized by me to invite actors to me
|
||||
-- * Verify B doesn't already have an invite/join/grant for me
|
||||
-- * Remember the invite in DB
|
||||
-- * Forward the Invite to my followers
|
||||
-- * Send Accept to A, B, my-followers
|
||||
-- * If I'm B, i.e. I'm the one being invited:
|
||||
-- * Verify the resource is some project's components collection URI
|
||||
-- * For each Stem record I have for this project:
|
||||
-- * Verify it's not enabled yet, i.e. I'm not already a component
|
||||
-- of this project
|
||||
-- * Verify it's not in Invite-Accept state, already got the
|
||||
-- project's Accept and waiting for my approval
|
||||
-- * Verify it's not in Add-Accept state, has my approval and
|
||||
-- waiting for the project's side
|
||||
-- * Create a Stem record in DB
|
||||
-- * Insert the Invite to my inbox
|
||||
-- * Forward the Invite to my followers
|
||||
deckInvite
|
||||
:: UTCTime
|
||||
-> DeckId
|
||||
|
|
|
@ -4864,28 +4864,19 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
|
|||
|
||||
-- Meaning: An actor A invited actor B to a resource
|
||||
-- Behavior:
|
||||
-- * Verify the resource is my collabs or components list
|
||||
-- * If resource is collabs and B is local, verify it's a Person
|
||||
-- * If resource is components and B is local, verify it's a Component
|
||||
-- * Verify the resource is my collabs list
|
||||
-- * If B is local, verify it's a Person
|
||||
-- * Verify A isn't inviting themselves
|
||||
-- * Verify A is authorized by me to invite collabs/components to me
|
||||
-- * Verify A is authorized by me to invite collabs to me
|
||||
--
|
||||
-- * In collab mode,
|
||||
-- * Verify B doesn't already have an invite/join/grant for me
|
||||
-- * In component mode,
|
||||
-- * Verify B isn't already an active component of mine
|
||||
-- * Verify B isn't already in a Add-Accept process waiting for
|
||||
-- project collab to accept too
|
||||
-- * Verify B isn't already in an Invite-Accept process waiting for
|
||||
-- component (or its collaborator) to accept too
|
||||
--
|
||||
-- * Insert the Invite to my inbox
|
||||
--
|
||||
-- * In collab mode, Insert a Collab record to DB
|
||||
-- * In component mode, Create a Component record in DB
|
||||
-- * Insert a Collab record to DB
|
||||
--
|
||||
-- * Forward the Invite to my followers
|
||||
-- * Send Accept to A, B (and followers if it's a component), my-followers
|
||||
-- * Send Accept to A, B, my-followers
|
||||
projectInvite
|
||||
:: UTCTime
|
||||
-> ProjectId
|
||||
|
@ -4920,7 +4911,6 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do
|
|||
mode <-
|
||||
case resourceOrComps of
|
||||
Left (Left (LocalResourceProject j)) | j == projectID ->
|
||||
Left <$>
|
||||
bitraverse
|
||||
(\case
|
||||
Left r -> pure r
|
||||
|
@ -4928,16 +4918,7 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do
|
|||
)
|
||||
pure
|
||||
recipientOrComp
|
||||
Left (Right j) | j == projectID ->
|
||||
Right <$>
|
||||
bitraverse
|
||||
(\case
|
||||
Left _ -> throwE "Not accepting local Persons as components"
|
||||
Right r -> pure r
|
||||
)
|
||||
pure
|
||||
recipientOrComp
|
||||
_ -> throwE "Invite topic isn't my collabs or components URI"
|
||||
_ -> throwE "Invite topic isn't my collabs URI"
|
||||
return (role, mode)
|
||||
|
||||
-- If target is local, find it in our DB
|
||||
|
@ -4949,16 +4930,10 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do
|
|||
-- handler result (approve/disapprove the Invite) would be sent later in a
|
||||
-- separate (e.g. Accept) activity. But for the PoC level, the current
|
||||
-- situation will hopefully do.
|
||||
invitedDB <-
|
||||
collab <-
|
||||
bitraverse
|
||||
(bitraverse
|
||||
(withDBExcept . flip getGrantRecip "Invitee not found in DB")
|
||||
getRemoteActorFromURI
|
||||
)
|
||||
(bitraverse
|
||||
(withDBExcept . flip getComponentE "Invitee not found in DB")
|
||||
getRemoteActorFromURI
|
||||
)
|
||||
invited
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
@ -4972,29 +4947,19 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do
|
|||
verifyCapability'
|
||||
capability authorIdMsig (LocalResourceProject projectID) AP.RoleAdmin
|
||||
|
||||
case invitedDB of
|
||||
|
||||
-- Verify that target doesn't already have a Collab for me
|
||||
Left collab -> do
|
||||
existingCollabIDs <- lift $ getExistingCollabs resourceID collab
|
||||
case existingCollabIDs of
|
||||
[] -> pure ()
|
||||
[_] -> throwE "I already have a Collab for the target"
|
||||
_ -> error "Multiple collabs found for target"
|
||||
|
||||
-- Find existing Component records I have for this component
|
||||
-- Make sure none are enabled / in Add-Accept mode / in
|
||||
-- Invite-Accept mode
|
||||
Right component -> checkExistingComponents projectID component
|
||||
|
||||
maybeInviteDB <- lift $ insertToInbox now authorIdMsig body (actorInbox topicActor) False
|
||||
lift $ for maybeInviteDB $ \ (inboxItemID, inviteDB) -> do
|
||||
|
||||
-- Insert Collab or Component record to DB
|
||||
acceptID <- insertEmptyOutboxItem' (actorOutbox topicActor) now
|
||||
case invitedDB of
|
||||
Left collab -> insertCollab resourceID role collab inviteDB acceptID
|
||||
Right component -> insertComponent component inviteDB acceptID
|
||||
insertCollab resourceID role collab inviteDB acceptID
|
||||
|
||||
-- Prepare forwarding Invite to my followers
|
||||
sieve <- do
|
||||
|
@ -5002,7 +4967,7 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do
|
|||
return $ makeRecipientSet [] [LocalStageProjectFollowers projectHash]
|
||||
|
||||
-- Prepare an Accept activity and insert to my outbox
|
||||
accept@(actionAccept, _, _, _) <- prepareAccept invitedDB
|
||||
accept@(actionAccept, _, _, _) <- prepareAccept collab
|
||||
_luAccept <- updateOutboxItem' (LocalActorProject projectID) acceptID actionAccept
|
||||
|
||||
return (topicActorID, sieve, acceptID, accept, inboxItemID)
|
||||
|
@ -5065,42 +5030,19 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do
|
|||
Right remoteActorID ->
|
||||
insert_ $ CollabRecipRemote collabID remoteActorID
|
||||
|
||||
insertComponent componentDB inviteDB acceptID = do
|
||||
componentID <- insert $ Component projectID AP.RoleAdmin
|
||||
originID <- insert $ ComponentOriginInvite componentID
|
||||
case inviteDB of
|
||||
Left (_, _, inviteID) ->
|
||||
insert_ $ ComponentProjectGestureLocal componentID inviteID
|
||||
Right (author, _, inviteID) ->
|
||||
insert_ $ ComponentProjectGestureRemote componentID (remoteAuthorId author) inviteID
|
||||
case componentDB of
|
||||
Left l ->
|
||||
insert_ $ ComponentLocal componentID (localComponentID l)
|
||||
Right remoteActorID ->
|
||||
insert_ $ ComponentRemote componentID remoteActorID
|
||||
insert_ $ ComponentProjectAccept originID acceptID
|
||||
|
||||
prepareAccept invitedDB = do
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
|
||||
audInviter <- lift $ makeAudSenderOnly authorIdMsig
|
||||
audInvited <-
|
||||
case invitedDB of
|
||||
Left (Left (GrantRecipPerson (Entity p _))) -> do
|
||||
Left (GrantRecipPerson (Entity p _)) -> do
|
||||
ph <- encodeKeyHashid p
|
||||
return $ AudLocal [LocalActorPerson ph] []
|
||||
Left (Right remoteActorID) -> do
|
||||
Right remoteActorID -> do
|
||||
ra <- getJust remoteActorID
|
||||
ObjURI h lu <- getRemoteActorURI ra
|
||||
return $ AudRemote h [lu] []
|
||||
Right (Left componentByEnt) -> do
|
||||
componentByHash <- hashComponent $ bmap entityKey componentByEnt
|
||||
let actor = resourceToActor $ componentResource componentByHash
|
||||
return $ AudLocal [actor] [localActorFollowers actor]
|
||||
Right (Right remoteActorID) -> do
|
||||
ra <- getJust remoteActorID
|
||||
ObjURI h lu <- getRemoteActorURI ra
|
||||
return $ AudRemote h [lu] (maybeToList $ remoteActorFollowers ra)
|
||||
audTopic <-
|
||||
AudLocal [] . pure . LocalStageProjectFollowers <$>
|
||||
encodeKeyHashid projectID
|
||||
|
|
Loading…
Reference in a new issue