diff --git a/src/Vervis/Actor/Project.hs b/src/Vervis/Actor/Project.hs index 197c827..ad01a8b 100644 --- a/src/Vervis/Actor/Project.hs +++ b/src/Vervis/Actor/Project.hs @@ -70,6 +70,29 @@ import Vervis.Persist.Collab import Vervis.Persist.Discussion 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: +-- * 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 +-- * Otherwise respond with error +projectAccept + :: UTCTime + -> ProjectId + -> Verse + -> AP.Accept URIMode + -> ActE (Text, Act (), Next) +projectAccept = topicAccept projectActor GrantResourceProject + -- Meaning: Someone has created a project with my ID URI -- Behavior: -- * Verify I'm in a just-been-created state @@ -135,11 +158,223 @@ projectFollow now recipProjectID verse follow = do (\ _ -> pure []) now recipProjectID verse follow +-- Meaning: An actor A invited actor B to a resource +-- Behavior: +-- * Verify the resource is me +-- * 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 +projectInvite + :: UTCTime + -> ProjectId + -> Verse + -> AP.Invite URIMode + -> ActE (Text, Act (), Next) +projectInvite = + topicInvite + projectActor GrantResourceProject + CollabTopicProjectProject CollabTopicProjectCollab CollabTopicProject + +-- Meaning: An actor A asked to join a resource +-- Behavior: +-- * Verify the resource is me +-- * Verify A doesn't already have an invite/join/grant for me +-- * Remember the join in DB +-- * Forward the Join to my followers +projectJoin + :: UTCTime + -> ProjectId + -> Verse + -> AP.Join URIMode + -> ActE (Text, Act (), Next) +projectJoin = + topicJoin + projectActor GrantResourceProject + CollabTopicProjectProject CollabTopicProjectCollab CollabTopicProject + +-- Meaning: An actor rejected something +-- Behavior: +-- * If it's on an Invite where I'm the resource: +-- * Verify the Reject is by the Invite target +-- * Remove the relevant Collab record from DB +-- * Forward the Reject to my followers +-- * Send a Reject on the Invite: +-- * To: Rejecter (i.e. Invite target) +-- * CC: Invite sender, Rejecter's followers, my followers +-- * If it's on a Join where I'm the resource: +-- * Verify the Reject is authorized +-- * Remove the relevant Collab record from DB +-- * Forward the Reject to my followers +-- * Send a Reject: +-- * To: Join sender +-- * CC: Reject sender, Join sender's followers, my followers +-- * Otherwise respond with error +projectReject + :: UTCTime + -> ProjectId + -> Verse + -> AP.Reject URIMode + -> ActE (Text, Act (), Next) +projectReject = topicReject projectActor GrantResourceProject + +-- Meaning: An actor A is removing actor B from a resource +-- Behavior: +-- * Verify the resource is me +-- * Verify A isn't removing themselves +-- * Verify A is authorized by me to remove actors from me +-- * Verify B already has a Grant for me +-- * Remove the whole Collab record from DB +-- * Forward the Remove to my followers +-- * Send a Revoke: +-- * To: Actor B +-- * CC: Actor A, B's followers, my followers +projectRemove + :: UTCTime + -> ProjectId + -> Verse + -> AP.Remove URIMode + -> ActE (Text, Act (), Next) +projectRemove = + topicRemove + projectActor GrantResourceProject + CollabTopicProjectProject CollabTopicProjectCollab + +-- Meaning: An actor is undoing some previous action +-- Behavior: +-- * If they're undoing their Following of me: +-- * Record it in my DB +-- * Publish and send an Accept only to the sender +-- * Otherwise respond with an error +projectUndo + :: UTCTime + -> ProjectId + -> Verse + -> AP.Undo URIMode + -> ActE (Text, Act (), Next) +projectUndo now recipProjectID (Verse authorIdMsig body) (AP.Undo uObject) = do + + -- Check input + undone <- + first (\ (actor, _, item) -> (actor, item)) <$> + parseActivityURI' uObject + + -- Verify the capability URI, if provided, is one of: + -- * Outbox item URI of a local actor, i.e. a local activity + -- * A remote URI + maybeCapability <- + for (AP.activityCapability $ actbActivity body) $ \ uCap -> + nameExceptT "Undo capability" $ + first (\ (actor, _, item) -> (actor, item)) <$> + parseActivityURI' uCap + + maybeNew <- withDBExcept $ do + + -- Grab me from DB + (projectRecip, actorRecip) <- lift $ do + p <- getJust recipProjectID + (p,) <$> getJust (projectActor p) + + -- Insert the Undo to my inbox + mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False + for mractid $ \ _undoDB -> do + + maybeUndo <- runMaybeT $ do + + -- Find the undone activity in our DB + undoneDB <- MaybeT $ getActivity undone + + let followers = actorFollowers actorRecip + asum + [ tryUnfollow followers undoneDB authorIdMsig + ] + + (sieve, audience) <- + fromMaybeE + maybeUndo + "Undone activity isn't a Follow related to me" + + -- Prepare an Accept activity and insert to project's outbox + acceptID <- lift $ insertEmptyOutboxItem' (actorOutbox actorRecip) now + accept@(actionAccept, _, _, _) <- lift $ lift $ prepareAccept audience + _luAccept <- lift $ updateOutboxItem' (LocalActorProject recipProjectID) acceptID actionAccept + + return (projectActor projectRecip, sieve, acceptID, accept) + + case maybeNew of + Nothing -> done "I already have this activity in my inbox" + Just (actorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do + forwardActivity + authorIdMsig body (LocalActorProject recipProjectID) actorID sieve + lift $ sendActivity + (LocalActorProject recipProjectID) actorID localRecipsAccept + remoteRecipsAccept fwdHostsAccept acceptID actionAccept + done + "Undid the Follow, forwarded the Undo and published Accept" + + where + + tryUnfollow projectFollowersID (Left (_actorByKey, _actorE, outboxItemID)) (Left (_, actorID, _)) = do + Entity followID follow <- + MaybeT $ lift $ getBy $ UniqueFollowFollow outboxItemID + let followerID = followActor follow + followerSetID = followTarget follow + verifyTargetMe followerSetID + unless (followerID == actorID) $ + lift $ throwE "You're trying to Undo someone else's Follow" + lift $ lift $ delete followID + audSenderOnly <- lift $ lift $ lift $ makeAudSenderOnly authorIdMsig + return (makeRecipientSet [] [], [audSenderOnly]) + where + verifyTargetMe followerSetID = guard $ followerSetID == projectFollowersID + tryUnfollow projectFollowersID (Right remoteActivityID) (Right (author, _, _)) = do + Entity remoteFollowID remoteFollow <- + MaybeT $ lift $ getBy $ UniqueRemoteFollowFollow remoteActivityID + let followerID = remoteFollowActor remoteFollow + followerSetID = remoteFollowTarget remoteFollow + verifyTargetMe followerSetID + unless (followerID == remoteAuthorId author) $ + lift $ throwE "You're trying to Undo someone else's Follow" + lift $ lift $ delete remoteFollowID + audSenderOnly <- lift $ lift $ lift $ makeAudSenderOnly authorIdMsig + return (makeRecipientSet [] [], [audSenderOnly]) + where + verifyTargetMe followerSetID = guard $ followerSetID == projectFollowersID + tryUnfollow _ _ _ = mzero + + prepareAccept audience = do + encodeRouteHome <- getEncodeRouteHome + + uUndo <- getActivityURI authorIdMsig + let (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.actionSpecific = AP.AcceptActivity AP.Accept + { AP.acceptObject = uUndo + , AP.acceptResult = Nothing + } + } + + return (action, recipientSet, remoteActors, fwdHosts) + projectBehavior :: UTCTime -> ProjectId -> VerseExt -> ActE (Text, Act (), Next) projectBehavior now projectID (Left verse@(Verse _authorIdMsig body)) = case AP.activitySpecific $ actbActivity body of + AP.AcceptActivity accept -> projectAccept now projectID verse accept AP.CreateActivity create -> projectCreate now projectID verse create AP.FollowActivity follow -> projectFollow now projectID verse follow + AP.InviteActivity invite -> projectInvite now projectID verse invite + AP.JoinActivity join -> projectJoin now projectID verse join + AP.RejectActivity reject -> projectReject now projectID verse reject + AP.RemoveActivity remove -> projectRemove now projectID verse remove + AP.UndoActivity undo -> projectUndo now projectID verse undo _ -> throwE "Unsupported activity type for Project" projectBehavior _ _ (Right _) = throwE "ClientMsgs aren't supported for Project"