forge/Vervis
1
0
Fork 0
Code Pull requests Activity

S2S: Invite: Remove Invite-based add-component code

Browse source
This commit is contained in:
Pere Lev 2024-07-23 19:31:52 +03:00
parent 1fa71b6b9c
commit e0935ee6db
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
3 changed files with 106 additions and 289 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

260
src/Vervis/Actor/Common.hs
View file

@ -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,112 +1204,56 @@ 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
-- Check capability
capability <- do
-- Verify that a capability is provided
uCap <- do
let muCap = AP.activityCapability $ actbActivity body
fromMaybeE muCap "No capability provided"
-- Verify that a capability is provided
uCap <- do
let muCap = AP.activityCapability $ actbActivity body
fromMaybeE muCap "No capability provided"
-- Verify the capability URI is one of:
-- * Outbox item URI of a local actor, i.e. a local activity
-- * A remote URI
cap <- nameExceptT "Invite capability" $ parseActivityURI' uCap
-- Verify the capability URI is one of:
-- * Outbox item URI of a local actor, i.e. a local activity
-- * A remote URI
cap <- nameExceptT "Invite capability" $ parseActivityURI' uCap
-- Verify the capability is local
case cap of
Left (actorByKey, _, outboxItemID) ->
return (actorByKey, outboxItemID)
_ -> throwE "Capability is remote i.e. definitely not by me"
-- If target is local, find it in our DB
-- If target is remote, HTTP GET it, verify it's an actor, 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 Invite handler,
-- which is NOT a good idea. Ideally, it would be done async, and the
-- 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.
targetDB <-
bitraverse
(withDBExcept . flip getGrantRecip "Invitee 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 "Target @id mismatch"
Left (Just err) -> throwE $ T.pack $ displayException err
Right Nothing -> throwE "Target isn't an actor"
Right (Just actor) -> return $ entityKey actor
)
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"
-- Verify the capability is local
case cap of
Left (actorByKey, _, outboxItemID) ->
return (actorByKey, outboxItemID)
_ -> throwE "Capability is remote i.e. definitely not by me"
-- If target is local, find it in our DB
-- If target is remote, HTTP GET it, verify it's an actor, 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 Invite handler,
-- which is NOT a good idea. Ideally, it would be done async, and the
-- 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.
targetDB <-
bitraverse
(withDBExcept . flip getGrantRecip "Invitee 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 luProject
fetchRemoteActor' instanceID h lu
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
Right (Just actor) -> return $ entityKey actor
)
)
targetByKey
recipOrProject
return (capability, targetDB)
maybeNew <- withDBExcept $ do
@ -1337,45 +1263,35 @@ 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
-- Verify the specified capability gives relevant access
verifyCapability'
capability authorIdMsig (topicResource topicKey) AP.RoleAdmin
-- Verify that target doesn't already have a Collab for me
existingCollabIDs <-
lift $ case targetDB of
Left (GrantRecipPerson (Entity personID _)) ->
E.select $ E.from $ \ (collab `E.InnerJoin` recipl) -> do
E.on $
collab E.^. CollabId E.==.
recipl E.^. CollabRecipLocalCollab
E.where_ $
collab E.^. CollabTopic E.==. E.val resourceID E.&&.
recipl E.^. CollabRecipLocalPerson E.==. E.val personID
return $ recipl E.^. CollabRecipLocalCollab
Right remoteActorID ->
E.select $ E.from $ \ (collab `E.InnerJoin` recipr) -> do
E.on $
collab E.^. CollabId E.==.
recipr E.^. CollabRecipRemoteCollab
E.where_ $
collab E.^. CollabTopic E.==. E.val resourceID E.&&.
recipr E.^. CollabRecipRemoteActor E.==. E.val remoteActorID
return $ recipr E.^. CollabRecipRemoteCollab
case existingCollabIDs of
[] -> pure ()
[_] -> 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
-- Verify that target doesn't already have a Collab for me
existingCollabIDs <-
lift $ case targetDB of
Left (GrantRecipPerson (Entity personID _)) ->
E.select $ E.from $ \ (collab `E.InnerJoin` recipl) -> do
E.on $
collab E.^. CollabId E.==.
recipl E.^. CollabRecipLocalCollab
E.where_ $
collab E.^. CollabTopic E.==. E.val resourceID E.&&.
recipl E.^. CollabRecipLocalPerson E.==. E.val personID
return $ recipl E.^. CollabRecipLocalCollab
Right remoteActorID ->
E.select $ E.from $ \ (collab `E.InnerJoin` recipr) -> do
E.on $
collab E.^. CollabId E.==.
recipr E.^. CollabRecipRemoteCollab
E.where_ $
collab E.^. CollabTopic E.==. E.val resourceID E.&&.
recipr E.^. CollabRecipRemoteActor E.==. E.val remoteActorID
return $ recipr E.^. CollabRecipRemoteCollab
case existingCollabIDs of
[] -> pure ()
[_] -> throwE "I already have a Collab for the target"
_ -> error "Multiple collabs found for target"
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
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
-- 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)
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

21
src/Vervis/Actor/Deck.hs
View file

@ -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

114
src/Vervis/Actor/Project.hs
View file

@ -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
-- * Verify B doesn't already have an invite/join/grant for me
--
-- * 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,24 +4911,14 @@ 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
Right _ -> throwE "Not accepting local component actors as collabs"
)
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"
bitraverse
(\case
Left r -> pure r
Right _ -> throwE "Not accepting local component actors as collabs"
)
pure
recipientOrComp
_ -> throwE "Invite topic isn't my collabs URI"
return (role, mode)
-- If target is local, find it in our DB
@ -4949,17 +4930,11 @@ 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
(withDBExcept . flip getGrantRecip "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
-- Verify that target doesn't already have a Collab for me
existingCollabIDs <- lift $ getExistingCollabs resourceID collab
case existingCollabIDs of
[] -> pure ()
[_] -> throwE "I already have a Collab for the target"
_ -> error "Multiple collabs found for target"
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