S2S: Project Add handler: Rearrange code in preparation for Component mode

Also add Component mode details into the behavior comment (but haven't
yet implemented the newly described Component-mode behavior)

src/Vervis/Actor/Project.hs

@@ -82,59 +82,60 @@ import Vervis.Ticket
 --     * 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?
+--         * Is it a Join to be a collaborator in me?
 --             * Verify the Accept is authorized
+--         * Is it an Invite to be a component of me?
+--             * Nothing to check at this point
+--         * Is it an Add to be a component of me?
+--             * If the sender is the component:
+--                 * Verify I haven't seen a component-Accept on this Add
+--             * Otherwise, i.e. sender isn't the component:
+--                 * Verify I've seen the component-Accept for this Add
+--                 * Verify the Accept is authorized
 --         * If it's none of these, respond with error
---     * Verify the Collab isn't enabled yet
+--
+--     * In collab mode, verify the Collab isn't enabled yet
+--     * In component mode, verify the Component isn't enabled yet
+--
 --     * Insert the Accept to my inbox
---     * Record the Accept and enable the Collab in DB
+--
+--     * In collab mode, record the Accept and enable the Collab in DB
+--     * In Invite-component mode,
+--         * If sender is component, record the Accept and enable the Component
+--           in DB
+--         * Otherwise, nothing at this point
+--     * In Add-component mode,
+--         * If the sender is the component, record the Accept into the
+--           Component record in DB
+--         * Otherwise, i.e. sender isn't the component, record the Accept and
+--           enable the Component in DB
+--
 --     * Forward the Accept to my followers
---     * Send a regular collaborator-Grant:
+--
---         * For Invite mode:
+--     * Possibly send a Grant:
+--         * For Invite-collab mode:
+--             * Regular collaborator-Grant
 --             * To: Accepter (i.e. Invite target)
 --             * CC: Invite sender, Accepter's followers, my followers
---         * For Join mode:
+--         * For Join-as-collab mode:
+--             * Regular collaborator-Grant
 --             * To: Join sender
 --             * CC: Accept sender, Join sender's followers, my followers
---
+--         * For Invite-component mode:
---
+--             * Only if sender is the component
---
+--             * delegator-Grant with a result URI
--- Stuff I'm about to implement for Component mode:
+--             * To: Component
---
+--             * CC:
---
+--                 - Component's followers
---     * If it's on an Invite to be a component of me:
+--                 - My followers
---         * Verify the Component isn't enabled yet (same as checking if I've
+--         * For Add-component mode:
---           recorded the component's Accept)
+--             * Only if sender isn't the component
---         * If the sender isn't the component, just forward the Accept to my
+--             * delegator-Grant with a result URI
---           followers and done
+--             * To: Component
---         * If the sender is the component:
+--             * CC:
---             * Enable the Component in DB
+--                 - Component's followers
---             * Forward the Accept to my followers
+--                 - My followers
---             * Send a delegator Grant to the component
+--                 - The Accept's sender
---                 * 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
@@ -146,7 +147,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
     -- Check input
     acceptee <- parseAccept accept
 
-    -- Verify the capability URI is one of:
+    -- Verify that the capability URI, if specified, is one of:
     --   * Outbox item URI of a local actor, i.e. a local activity
     --   * A remote URI
     maybeCap <-
@@ -167,32 +168,22 @@ projectAccept now projectID (Verse authorIdMsig body) accept = 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
+        -- See if the accepted activity is an Invite or Join where my collabs
-        -- resource, grabbing the Collab record from our DB
+        -- URI is the resource, grabbing the Collab record from our DB
-        collab <- do
+        (collabID, fulfills, inviterOrJoiner) <- do
+            let adapt = maybe (Right Nothing) (either Left (Right . Just))
             maybeCollab <-
-                lift $ runMaybeT $
+                ExceptT $ fmap adapt $ runMaybeT $
-                    Left <$> tryInvite accepteeDB <|>
+                    runExceptT (tryInviteCollab accepteeDB) <|>
-                    Right <$> tryJoin accepteeDB
+                    runExceptT (tryJoinCollab 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
+            bitraverse
 
                 -- If accepting an Invite, find the Collab recipient and verify
                 -- it's the sender of the Accept
-                Left (fulfillsID, _) -> Left <$> do
+                (\ fulfillsID -> do
                     recip <-
                         lift $
                         requireEitherAlt
@@ -208,9 +199,10 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
                             | 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
+                (\ fulfillsID -> do
                     capID <- fromMaybeE maybeCap "No capability provided"
                     capability <-
                         case capID of
@@ -222,6 +214,9 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
                         (GrantResourceProject projectID)
                         AP.RoleAdmin
                     return fulfillsID
+                )
+
+                fulfills
 
         -- Verify the Collab isn't already validated
         maybeEnabled <- lift $ getBy $ UniqueCollabEnable collabID
@@ -262,8 +257,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
                 lift $ insert_ $ CollabEnable collabID grantID
 
                 -- Prepare a Grant activity and insert to my outbox
-                let inviterOrJoiner = either snd snd collab
+                let isInvite = isLeft fulfills
-                    isInvite = isLeft collab
                 grant@(actionGrant, _, _, _) <- do
                     Collab role <- lift $ getJust collabID
                     lift $ prepareGrant isInvite inviterOrJoiner role
@@ -285,30 +279,66 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
 
     where
 
-    tryInvite (Left (actorByKey, _actorEntity, itemID)) =
+    verifyCollabTopic collabID = do
-        (,Left actorByKey) . collabInviterLocalCollab <$>
+        topic <- lift $ getCollabTopic collabID
-            MaybeT (getValBy $ UniqueCollabInviterLocalInvite itemID)
+        unless (GrantResourceProject projectID == topic) $
-    tryInvite (Right remoteActivityID) = do
+            throwE "Accept object is an Invite/Join for some other resource"
-        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)) =
+    verifyInviteCollabTopic fulfillsID = do
-        (,Left actorByKey) . collabRecipLocalJoinFulfills <$>
+        collabID <- lift $ collabFulfillsInviteCollab <$> getJust fulfillsID
-            MaybeT (getValBy $ UniqueCollabRecipLocalJoinJoin itemID)
+        verifyCollabTopic collabID
-    tryJoin (Right remoteActivityID) = do
+        return collabID
+
+    verifyJoinCollabTopic fulfillsID = do
+        collabID <- lift $ collabFulfillsJoinCollab <$> getJust fulfillsID
+        verifyCollabTopic collabID
+        return collabID
+
+    tryInviteCollab (Left (actorByKey, _actorEntity, itemID)) = do
+        fulfillsID <-
+            lift $ collabInviterLocalCollab <$>
+                MaybeT (getValBy $ UniqueCollabInviterLocalInvite itemID)
+        collabID <-
+            ExceptT $ lift $ runExceptT $ verifyInviteCollabTopic fulfillsID
+        return (collabID, Left fulfillsID, Left actorByKey)
+    tryInviteCollab (Right remoteActivityID) = do
+        CollabInviterRemote fulfillsID actorID _ <-
+            lift $ MaybeT $ getValBy $
+                UniqueCollabInviterRemoteInvite remoteActivityID
+        collabID <-
+            ExceptT $ lift $ runExceptT $ verifyInviteCollabTopic fulfillsID
+        sender <- lift $ lift $ do
+            actor <- getJust actorID
+            (,remoteActorFollowers actor) <$> getRemoteActorURI actor
+        return (collabID, Left fulfillsID, Right sender)
+
+    tryJoinCollab (Left (actorByKey, _actorEntity, itemID)) = do
+        fulfillsID <-
+            lift $ collabRecipLocalJoinFulfills <$>
+                MaybeT (getValBy $ UniqueCollabRecipLocalJoinJoin itemID)
+        collabID <-
+            ExceptT $ lift $ runExceptT $ verifyJoinCollabTopic fulfillsID
+        return (collabID, Right fulfillsID, Left actorByKey)
+    tryJoinCollab (Right remoteActivityID) = do
         CollabRecipRemoteJoin recipID fulfillsID _ <-
-            MaybeT $ getValBy $
+            lift $ MaybeT $ getValBy $
                 UniqueCollabRecipRemoteJoinJoin remoteActivityID
-        remoteActorID <- lift $ collabRecipRemoteActor <$> getJust recipID
+        collabID <-
-        actor <- lift $ getJust remoteActorID
+            ExceptT $ lift $ runExceptT $ verifyJoinCollabTopic fulfillsID
-        joiner <-
+        joiner <- lift $ lift $ do
-            lift $ (,remoteActorFollowers actor) <$> getRemoteActorURI actor
+            remoteActorID <- collabRecipRemoteActor <$> getJust recipID
-        return (fulfillsID, Right joiner)
+            actor <- getJust remoteActorID
+            (,remoteActorFollowers actor) <$> getRemoteActorURI actor
+        return (collabID, Right fulfillsID, Right joiner)
+
+    {-
+    tryInviteComp (Left (actorByKey, _actorEntity, itemID)) = do
+        ComponentOriginInvite
+        ComponentProjectGestureLocal
+    tryInviteCollab (Right remoteActivityID) = do
+        ComponentOriginInvite
+        ComponentProjectGestureRemote
+    -}
 
     prepareGrant isInvite sender role = do
         encodeRouteHome <- getEncodeRouteHome