S2S: Implement project handlers, based on the Deck ones

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"