diff --git a/src/Vervis/Actor/Project.hs b/src/Vervis/Actor/Project.hs index 94b764d..86408bf 100644 --- a/src/Vervis/Actor/Project.hs +++ b/src/Vervis/Actor/Project.hs @@ -31,6 +31,7 @@ import Data.Barbie import Data.Bifunctor import Data.Bitraversable import Data.ByteString (ByteString) +import Data.Either import Data.Foldable import Data.Maybe import Data.Text (Text) @@ -53,6 +54,7 @@ import Yesod.MonadSite import qualified Web.ActivityPub as AP import Control.Monad.Trans.Except.Local +import Data.Either.Local import Database.Persist.Local import Vervis.Access @@ -68,7 +70,7 @@ import Vervis.FedURI import Vervis.Federation.Util import Vervis.Foundation import Vervis.Model hiding (projectCreate) -import Vervis.Recipient (makeRecipientSet, LocalStageBy (..), Aud (..), collectAudience, localActorFollowers) +import Vervis.Recipient (makeRecipientSet, LocalStageBy (..), Aud (..), collectAudience, localActorFollowers, renderLocalActor) import Vervis.RemoteActorStore import Vervis.Persist.Actor import Vervis.Persist.Collab @@ -77,26 +79,298 @@ import Vervis.Ticket -- 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: +-- * Check if I know the activity that's being Accepted: +-- * Is it an Invite to be a collaborator in me? +-- * Verify the Accept is by the Invite target +-- * If it's on a Join to be a collaborator in me? +-- * Verify the Accept is authorized +-- * If it's none of these, respond with error +-- * Verify the Collab isn't enabled yet +-- * Insert the Accept to my inbox +-- * Record the Accept and enable the Collab in DB +-- * Forward the Accept to my followers +-- * Send a regular collaborator-Grant: +-- * For Invite mode: -- * 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: +-- * For Join mode: -- * To: Join sender -- * CC: Accept sender, Join sender's followers, my followers --- * Otherwise respond with error +-- +-- +-- +-- Stuff I'm about to implement for Component mode: +-- +-- +-- * If it's on an Invite to be a component of me: +-- * Verify the Component isn't enabled yet (same as checking if I've +-- recorded the component's Accept) +-- * If the sender isn't the component, just forward the Accept to my +-- followers and done +-- * If the sender is the component: +-- * Enable the Component in DB +-- * Forward the Accept to my followers +-- * Send a delegator Grant to the component +-- * To: Component +-- * CC: +-- - Component's followers +-- - My followers +-- +-- +-- * If it's on an Add to be a component of me: +-- * Verify the Component isn't enabled yet (same as checking if I've +-- recorded an Accept from a collaborator of mine) +-- * If the sender is the component: +-- * Verify I haven't seen a component-Accept on this Add +-- * Record the Accept into the Component record in DB +-- * Forward the Accept to my followers +-- * Otherwise, i.e. sender isn't the component: +-- * Verify I've seen the component-Accept for this Add +-- * Verify the Accept is authorized +-- * Record the Accept and enable the Component in DB +-- * Forward the Accept to my followers +-- * Send a delegator Grant to the component +-- * To: Component +-- * CC: +-- - Component's followers +-- - My followers +-- - The Accept's sender projectAccept :: UTCTime -> ProjectId -> Verse -> AP.Accept URIMode -> ActE (Text, Act (), Next) -projectAccept = topicAccept projectActor GrantResourceProject +projectAccept now projectID (Verse authorIdMsig body) accept = do + + -- Check input + acceptee <- parseAccept accept + + -- Verify the capability URI 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 + + -- Grab me from DB + (recipActorID, recipActor) <- lift $ do + recip <- getJust projectID + let actorID = projectActor recip + (actorID,) <$> getJust actorID + + -- Find the accepted activity in our DB + accepteeDB <- do + a <- getActivity acceptee + fromMaybeE a "Can't find acceptee in DB" + + -- See if the accepted activity is an Invite or Join to a local + -- resource, grabbing the Collab record from our DB + collab <- do + maybeCollab <- + lift $ runMaybeT $ + Left <$> tryInvite accepteeDB <|> + Right <$> tryJoin accepteeDB + fromMaybeE maybeCollab "Accepted activity isn't an Invite or Join I'm aware of" + + -- Find the local resource and verify it's me + collabID <- + lift $ case collab of + Left (fulfillsID, _) -> + collabFulfillsInviteCollab <$> getJust fulfillsID + Right (fulfillsID, _) -> + collabFulfillsJoinCollab <$> getJust fulfillsID + topic <- lift $ getCollabTopic collabID + unless (GrantResourceProject projectID == topic) $ + throwE "Accept object is an Invite/Join for some other resource" + + idsForAccept <- + case collab of + + -- If accepting an Invite, find the Collab recipient and verify + -- it's the sender of the Accept + Left (fulfillsID, _) -> Left <$> do + recip <- + lift $ + requireEitherAlt + (getBy $ UniqueCollabRecipLocal collabID) + (getBy $ UniqueCollabRecipRemote collabID) + "Found Collab with no recip" + "Found Collab with multiple recips" + case (recip, authorIdMsig) of + (Left (Entity crlid crl), Left (LocalActorPerson personID, _, _)) + | collabRecipLocalPerson crl == personID -> + return (fulfillsID, Left crlid) + (Right (Entity crrid crr), Right (author, _, _)) + | collabRecipRemoteActor crr == remoteAuthorId author -> + return (fulfillsID, Right crrid) + _ -> throwE "Accepting an Invite whose recipient is someone else" + + -- If accepting a Join, verify accepter has permission + Right (fulfillsID, _) -> Right <$> do + capID <- fromMaybeE maybeCap "No capability provided" + capability <- + case capID of + Left (capActor, _, capItem) -> return (capActor, capItem) + Right _ -> throwE "Capability is a remote URI, i.e. not authored by the local resource" + verifyCapability' + capability + authorIdMsig + (GrantResourceProject projectID) + AP.RoleAdmin + return fulfillsID + + -- Verify the Collab isn't already validated + maybeEnabled <- lift $ getBy $ UniqueCollabEnable collabID + verifyNothingE maybeEnabled "I already sent a Grant for this Invite/Join" + + maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False + for maybeAcceptDB $ \ acceptDB -> do + + -- Record the Accept on the Collab + case (idsForAccept, acceptDB) of + (Left (fulfillsID, Left recipID), Left (_, _, acceptID)) -> do + maybeAccept <- lift $ insertUnique $ CollabRecipLocalAccept recipID fulfillsID acceptID + unless (isNothing maybeAccept) $ + throwE "This Invite already has an Accept by recip" + (Left (fulfillsID, Right recipID), Right (_, _, acceptID)) -> do + maybeAccept <- lift $ insertUnique $ CollabRecipRemoteAccept recipID fulfillsID acceptID + unless (isJust maybeAccept) $ + throwE "This Invite already has an Accept by recip" + (Right fulfillsID, Left (_, _, acceptID)) -> do + maybeAccept <- lift $ insertUnique $ CollabApproverLocal fulfillsID acceptID + unless (isJust maybeAccept) $ + throwE "This Join already has an Accept" + (Right fulfillsID, Right (author, _, acceptID)) -> do + maybeAccept <- lift $ insertUnique $ CollabApproverRemote fulfillsID (remoteAuthorId author) acceptID + unless (isJust maybeAccept) $ + throwE "This Join already has an Accept" + _ -> error "topicAccept impossible" + + -- Prepare forwarding of Accept to my followers + let recipByID = grantResourceLocalActor $ GrantResourceProject projectID + recipByHash <- hashLocalActor recipByID + let sieve = makeRecipientSet [] [localActorFollowers recipByHash] + + grantInfo <- do + + -- Enable the Collab in our DB + grantID <- lift $ insertEmptyOutboxItem' (actorOutbox recipActor) now + lift $ insert_ $ CollabEnable collabID grantID + + -- Prepare a Grant activity and insert to my outbox + let inviterOrJoiner = either snd snd collab + isInvite = isLeft collab + grant@(actionGrant, _, _, _) <- do + Collab role <- lift $ getJust collabID + lift $ prepareGrant isInvite inviterOrJoiner role + let recipByKey = grantResourceLocalActor $ GrantResourceProject projectID + _luGrant <- lift $ updateOutboxItem' recipByKey grantID actionGrant + return (grantID, grant) + + return (recipActorID, sieve, grantInfo) + + case maybeNew of + Nothing -> done "I already have this activity in my inbox" + Just (recipActorID, sieve, (grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant))) -> do + let recipByID = grantResourceLocalActor $ GrantResourceProject projectID + forwardActivity authorIdMsig body recipByID recipActorID sieve + lift $ sendActivity + recipByID recipActorID localRecipsGrant + remoteRecipsGrant fwdHostsGrant grantID actionGrant + done "Forwarded the Accept and published a Grant" + + where + + tryInvite (Left (actorByKey, _actorEntity, itemID)) = + (,Left actorByKey) . collabInviterLocalCollab <$> + MaybeT (getValBy $ UniqueCollabInviterLocalInvite itemID) + tryInvite (Right remoteActivityID) = do + CollabInviterRemote collab actorID _ <- + MaybeT $ getValBy $ + UniqueCollabInviterRemoteInvite remoteActivityID + actor <- lift $ getJust actorID + sender <- + lift $ (,remoteActorFollowers actor) <$> getRemoteActorURI actor + return (collab, Right sender) + + tryJoin (Left (actorByKey, _actorEntity, itemID)) = + (,Left actorByKey) . collabRecipLocalJoinFulfills <$> + MaybeT (getValBy $ UniqueCollabRecipLocalJoinJoin itemID) + tryJoin (Right remoteActivityID) = do + CollabRecipRemoteJoin recipID fulfillsID _ <- + MaybeT $ getValBy $ + UniqueCollabRecipRemoteJoinJoin remoteActivityID + remoteActorID <- lift $ collabRecipRemoteActor <$> getJust recipID + actor <- lift $ getJust remoteActorID + joiner <- + lift $ (,remoteActorFollowers actor) <$> getRemoteActorURI actor + return (fulfillsID, Right joiner) + + prepareGrant isInvite sender role = do + encodeRouteHome <- getEncodeRouteHome + encodeRouteLocal <- getEncodeRouteLocal + + audAccepter <- makeAudSenderWithFollowers authorIdMsig + audApprover <- lift $ makeAudSenderOnly authorIdMsig + recipHash <- encodeKeyHashid projectID + let topicByHash = grantResourceLocalActor $ GrantResourceProject recipHash + + senderHash <- bitraverse hashLocalActor pure sender + + uAccepter <- lift $ getActorURI authorIdMsig + + let audience = + if isInvite + then + let audInviter = + case senderHash of + Left actor -> AudLocal [actor] [] + Right (ObjURI h lu, _followers) -> + AudRemote h [lu] [] + audTopic = AudLocal [] [localActorFollowers topicByHash] + in [audInviter, audAccepter, audTopic] + else + let audJoiner = + case senderHash of + Left actor -> AudLocal [actor] [localActorFollowers actor] + Right (ObjURI h lu, followers) -> + AudRemote h [lu] (maybeToList followers) + audTopic = AudLocal [] [localActorFollowers topicByHash] + in [audJoiner, audApprover, audTopic] + + (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) = + collectAudience audience + + recips = map encodeRouteHome audLocal ++ audRemote + action = AP.Action + { AP.actionCapability = Nothing + , AP.actionSummary = Nothing + , AP.actionAudience = AP.Audience recips [] [] [] [] [] + , AP.actionFulfills = [AP.acceptObject accept] + , AP.actionSpecific = AP.GrantActivity AP.Grant + { AP.grantObject = role + , AP.grantContext = + encodeRouteLocal $ renderLocalActor topicByHash + , AP.grantTarget = + if isInvite + then uAccepter + else case senderHash of + Left actor -> + encodeRouteHome $ renderLocalActor actor + Right (ObjURI h lu, _) -> ObjURI h lu + , AP.grantResult = Nothing + , AP.grantStart = Just now + , AP.grantEnd = Nothing + , AP.grantAllows = AP.Invoke + , AP.grantDelegates = Nothing + } + } + + return (action, recipientSet, remoteActors, fwdHosts) checkExistingComponents :: ProjectId -> Either (ComponentBy Entity) RemoteActorId -> ActDBE () diff --git a/src/Vervis/Data/Collab.hs b/src/Vervis/Data/Collab.hs index 22b17bb..1c9d0fe 100644 --- a/src/Vervis/Data/Collab.hs +++ b/src/Vervis/Data/Collab.hs @@ -136,19 +136,14 @@ parseTopic :: StageRoute Env ~ Route App => FedURI -> ActE (Either (GrantResourceBy Key) FedURI) parseTopic u = do - routeOrRemote <- parseFedURI u + t <- parseTopic' u bitraverse - (\ route -> do - resourceHash <- - fromMaybeE - (parseGrantResourceCollabs route) - "Not a shared resource collabs route" - unhashGrantResourceE' - resourceHash - "Contains invalid hashid" + (\case + Left r -> pure r + Right _ -> throwE "Local topic is a components route" ) pure - routeOrRemote + t parseTopic' :: StageRoute Env ~ Route App