From b45aa78d7ba889b81a8a123f9c5bcc05197f2b16 Mon Sep 17 00:00:00 2001 From: Pere Lev Date: Wed, 28 Jun 2023 10:44:13 +0300 Subject: [PATCH] Copy topicInvite impl into projectInvite instead of reusing topicInvite That's because projectInvite is about to get changes and can't use topicInvite anymore; that's probably suitable only for components --- src/Vervis/Actor/Project.hs | 141 +++++++++++++++++++++++++++++++++++- 1 file changed, 137 insertions(+), 4 deletions(-) diff --git a/src/Vervis/Actor/Project.hs b/src/Vervis/Actor/Project.hs index 0e7a8d9..c1fd6f0 100644 --- a/src/Vervis/Actor/Project.hs +++ b/src/Vervis/Actor/Project.hs @@ -371,10 +371,143 @@ projectInvite -> Verse -> AP.Invite URIMode -> ActE (Text, Act (), Next) -projectInvite = - topicInvite - projectActor GrantResourceProject - CollabTopicProjectProject CollabTopicProjectCollab CollabTopicProject +projectInvite now projectID (Verse authorIdMsig body) invite = 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 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" + + -- Check invite + (role, targetByKey) <- do + let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig + (role, resourceOrComps, recipientOrComp) <- parseInvite author invite + unless (Left (Left $ GrantResourceProject projectID) == resourceOrComps) $ + throwE "Invite topic isn't my collabs URI" + recipient <- + bitraverse + (\case + Left r -> pure r + Right _ -> throwE "Not accepting component actors as collabs" + ) + pure + recipientOrComp + return (role, recipient) + + -- 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 + + maybeNew <- withDBExcept $ do + + -- Grab me from DB + (topicActorID, topicActor) <- lift $ do + recip <- getJust projectID + let actorID = projectActor recip + (actorID,) <$> getJust actorID + + -- Verify the specified capability gives relevant access + verifyCapability' + capability authorIdMsig (GrantResourceProject projectID) 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 $ \ (topic `E.InnerJoin` recipl) -> do + E.on $ + topic E.^. CollabTopicProjectCollab E.==. + recipl E.^. CollabRecipLocalCollab + E.where_ $ + topic E.^. CollabTopicProjectProject E.==. E.val projectID E.&&. + recipl E.^. CollabRecipLocalPerson E.==. E.val personID + return $ recipl E.^. CollabRecipLocalCollab + Right remoteActorID -> + E.select $ E.from $ \ (topic `E.InnerJoin` recipr) -> do + E.on $ + topic E.^. CollabTopicProjectCollab E.==. + recipr E.^. CollabRecipRemoteCollab + E.where_ $ + topic E.^. CollabTopicProjectProject E.==. E.val projectID 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 $ \ inviteDB -> do + + -- Insert Collab record to DB + insertCollab role targetDB inviteDB + + -- Prepare forwarding Invite to my followers + sieve <- do + projectHash <- encodeKeyHashid projectID + return $ makeRecipientSet [] [LocalStageProjectFollowers projectHash] + return (topicActorID, sieve) + + case maybeNew of + Nothing -> done "I already have this activity in my inbox" + Just (projectActorID, sieve) -> do + forwardActivity + authorIdMsig body (LocalActorProject projectID) projectActorID sieve + done "Recorded and forwarded the Invite" + + where + + insertCollab role recipient inviteDB = do + collabID <- insert $ Collab role + fulfillsID <- insert $ CollabFulfillsInvite collabID + insert_ $ CollabTopicProject collabID projectID + case inviteDB of + Left (_, _, inviteID) -> + insert_ $ CollabInviterLocal fulfillsID inviteID + Right (author, _, inviteID) -> do + let authorID = remoteAuthorId author + insert_ $ CollabInviterRemote fulfillsID authorID inviteID + case recipient of + Left (GrantRecipPerson (Entity personID _)) -> + insert_ $ CollabRecipLocal collabID personID + Right remoteActorID -> + insert_ $ CollabRecipRemote collabID remoteActorID -- Meaning: An actor A asked to join a resource -- Behavior: