S2S: Deck Accept handler: Implement component mode

src/Vervis/Actor/Common.hs

@@ -193,21 +193,54 @@ actorFollow parseFollowee grabActor unread getFollowee getSieve makeLocalActor m
 
         return (action, recipientSet, remoteActors, fwdHosts)
 
+-- 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
+--     * If it's an Invite (that I know about) where I'm invited to a project:
+--          * If I haven't yet seen the project's approval:
+--              * Verify the author is the project
+--              * Record the approval in the Stem record in DB
+--          * If I saw project's approval, but not my collaborators' approval:
+--              * Verify the Accept is authorized
+--              * Record the approval in the Stem record in DB
+--              * Forward to my followers
+--              * Publish and send an Accept:
+--                  * To: Inviter, project, Accept author
+--                  * CC: Project followers, my followers
+--              * Record it in the Stem record in DB as well
+--          * If I already saw both approvals, respond with error
+--     * If it's an Add (that I know about and already Accepted) where I'm
+--       invited to a project:
+--          * If I've already seen the project's accept, respond with error
+--          * Otherwise, just ignore the Accept
+--     * Otherwise respond with error
 topicAccept
     :: (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic)
     => (topic -> ActorId)
     -> (forall f. f topic -> GrantResourceBy f)
+    -> (forall f. f topic -> ComponentBy f)
     -> UTCTime
     -> Key topic
     -> Verse
     -> AP.Accept URIMode
     -> ActE (Text, Act (), Next)
-topicAccept topicActor topicResource now recipKey (Verse authorIdMsig body) accept = do
+topicAccept topicActor topicResource topicComponent now recipKey (Verse authorIdMsig body) accept = do
 
     -- Check input
     acceptee <- parseAccept accept
 
-    -- Verify the capability URI is one of:
+    -- Verify the capability URI, if provided, is one of:
     --   * Outbox item URI of a local actor, i.e. a local activity
     --   * A remote URI
     maybeCap <-
@@ -215,13 +248,13 @@ topicAccept topicActor topicResource now recipKey (Verse authorIdMsig body) acce
             (nameExceptT "Accept capability" . parseActivityURI')
             (AP.activityCapability $ actbActivity body)
 
-    maybeNew <- withDBExcept $ do
+    -- Grab me from DB
+    (recipActorID, recipActor) <- lift $ withDB $ do
+        recip <- getJust recipKey
+        let actorID = topicActor recip
+        (actorID,) <$> getJust actorID
 
-        -- Grab me from DB
+    collabOrStem <- withDBExcept $ do
-        (recipActorID, recipActor) <- lift $ do
-            recip <- getJust recipKey
-            let actorID = topicActor recip
-            (actorID,) <$> getJust actorID
 
         -- Find the accepted activity in our DB
         accepteeDB <- do
@@ -230,126 +263,28 @@ topicAccept topicActor topicResource now recipKey (Verse authorIdMsig body) acce
 
         -- See if the accepted activity is an Invite or Join to a local
         -- resource, grabbing the Collab record from our DB
-        collab <- do
+        -- See if the accepted activity is an Invite or Add on a local
-            maybeCollab <-
+        -- component, grabbing the Stem record from our DB
-                lift $ runMaybeT $
+        maybeCollabOrStem <-
-                    Left <$> tryInvite accepteeDB <|>
+            lift $ runMaybeT $
-                    Right <$> tryJoin accepteeDB
+                Left . Left <$> tryInviteCollab accepteeDB <|>
-            fromMaybeE maybeCollab "Accepted activity isn't an Invite or Join I'm aware of"
+                Left . Right <$> tryJoinCollab accepteeDB <|>
+                Right . Left <$> tryInviteComp accepteeDB <|>
+                Right . Right <$> tryAddComp accepteeDB
+        fromMaybeE maybeCollabOrStem "Accepted activity isn't an Invite/Join/Add I'm aware of"
 
-        -- Find the local resource and verify it's me
+    case collabOrStem of
-        collabID <-
+        Left collab ->
-            lift $ case collab of
+            topicAcceptCollab maybeCap recipActorID recipActor collab
-                Left (fulfillsID, _) ->
+        Right stem ->
-                    collabFulfillsInviteCollab <$> getJust fulfillsID
+            topicAcceptStem maybeCap recipActorID recipActor stem
-                Right (fulfillsID, _) ->
-                    collabFulfillsJoinCollab <$> getJust fulfillsID
-        topic <- lift $ getCollabTopic collabID
-        unless (topicResource recipKey == 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
-                        (topicResource recipKey)
-                        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 $ topicResource recipKey
-            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 $ topicResource recipKey
-                _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 $ topicResource recipKey
-            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)) =
+    tryInviteCollab (Left (actorByKey, _actorEntity, itemID)) =
         (,Left actorByKey) . collabInviterLocalCollab <$>
             MaybeT (getValBy $ UniqueCollabInviterLocalInvite itemID)
-    tryInvite (Right remoteActivityID) = do
+    tryInviteCollab (Right remoteActivityID) = do
         CollabInviterRemote collab actorID _ <-
             MaybeT $ getValBy $
                 UniqueCollabInviterRemoteInvite remoteActivityID
@@ -358,10 +293,10 @@ topicAccept topicActor topicResource now recipKey (Verse authorIdMsig body) acce
             lift $ (,remoteActorFollowers actor) <$> getRemoteActorURI actor
         return (collab, Right sender)
 
-    tryJoin (Left (actorByKey, _actorEntity, itemID)) =
+    tryJoinCollab (Left (actorByKey, _actorEntity, itemID)) =
         (,Left actorByKey) . collabRecipLocalJoinFulfills <$>
             MaybeT (getValBy $ UniqueCollabRecipLocalJoinJoin itemID)
-    tryJoin (Right remoteActivityID) = do
+    tryJoinCollab (Right remoteActivityID) = do
         CollabRecipRemoteJoin recipID fulfillsID _ <-
             MaybeT $ getValBy $
                 UniqueCollabRecipRemoteJoinJoin remoteActivityID
@@ -371,6 +306,33 @@ topicAccept topicActor topicResource now recipKey (Verse authorIdMsig body) acce
             lift $ (,remoteActorFollowers actor) <$> getRemoteActorURI actor
         return (fulfillsID, Right joiner)
 
+    tryInviteComp (Left (actorByKey, _actorEntity, itemID)) =
+        (,Left (actorByKey, itemID)) . stemProjectGestureLocalOrigin <$>
+            MaybeT (getValBy $ UniqueStemProjectGestureLocalInvite itemID)
+    tryInviteComp (Right remoteActivityID) = do
+        StemProjectGestureRemote originID actorID _ <-
+            MaybeT $ getValBy $
+                UniqueStemProjectGestureRemoteInvite remoteActivityID
+        actor <- lift $ getJust actorID
+        inviter <-
+            lift $ (,remoteActorFollowers actor, remoteActivityID) <$> getRemoteActorURI actor
+        return (originID, Right inviter)
+
+    tryAddComp (Left (actorByKey, _actorEntity, itemID)) = do
+        StemComponentGestureLocal stemID _ <-
+            MaybeT $ getValBy $ UniqueStemComponentGestureLocalActivity itemID
+        originID <- MaybeT $ getKeyBy $ UniqueStemOriginAdd stemID
+        return (stemID, originID, Left (actorByKey, itemID))
+    tryAddComp (Right remoteActivityID) = do
+        StemComponentGestureRemote stemID actorID _ <-
+            MaybeT $ getValBy $
+                UniqueStemComponentGestureRemoteActivity remoteActivityID
+        originID <- MaybeT $ getKeyBy $ UniqueStemOriginAdd stemID
+        actor <- lift $ getJust actorID
+        adder <-
+            lift $ (,remoteActorFollowers actor,remoteActivityID) <$> getRemoteActorURI actor
+        return (stemID, originID, Right adder)
+
     prepareGrant isInvite sender role = do
         encodeRouteHome <- getEncodeRouteHome
         encodeRouteLocal <- getEncodeRouteLocal
@@ -433,6 +395,296 @@ topicAccept topicActor topicResource now recipKey (Verse authorIdMsig body) acce
 
         return (action, recipientSet, remoteActors, fwdHosts)
 
+    topicAcceptCollab maybeCap recipActorID recipActor collab = do
+
+        maybeNew <- withDBExcept $ do
+
+            -- 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 (topicResource recipKey == 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
+                            (topicResource recipKey)
+                            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 $ topicResource recipKey
+                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 $ topicResource recipKey
+                    _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 $ topicResource recipKey
+                forwardActivity authorIdMsig body recipByID recipActorID sieve
+                lift $ sendActivity
+                    recipByID recipActorID localRecipsGrant
+                    remoteRecipsGrant fwdHostsGrant grantID actionGrant
+                done "Forwarded the Accept and published a Grant"
+
+    prepareReact project inviter = do
+        encodeRouteHome <- getEncodeRouteHome
+
+        (audInviter, uInvite) <-
+            case inviter of
+                Left (byKey, itemID) -> do
+                    byHash <- hashLocalActor byKey
+                    itemHash <- encodeKeyHashid itemID
+                    return
+                        ( AudLocal [byHash] []
+                        , encodeRouteHome $ activityRoute byHash itemHash
+                        )
+                Right (ObjURI h lu, _followers, activityID) -> do
+                    objectID <- remoteActivityIdent <$> getJust activityID
+                    luAct <- remoteObjectIdent <$> getJust objectID
+                    return (AudRemote h [lu] [], ObjURI h luAct)
+        audProject <-
+            case project of
+                Left (Entity _ (StemProjectLocal _ projectID)) -> do
+                    projectHash <- encodeKeyHashid projectID
+                    return $
+                        AudLocal
+                            [LocalActorProject projectHash]
+                            [LocalStageProjectFollowers projectHash]
+                Right (Entity _ (StemProjectRemote _ actorID)) -> do
+                    actor <- getJust actorID
+                    ObjURI h lu <- getRemoteActorURI actor
+                    let followers = remoteActorFollowers actor
+                    return $ AudRemote h [lu] (maybeToList followers)
+        audAccepter <- lift $ makeAudSenderOnly authorIdMsig
+        audMe <-
+            AudLocal [] . pure . localActorFollowers .
+            grantResourceLocalActor . topicResource <$>
+                encodeKeyHashid recipKey
+
+        let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
+                collectAudience [audInviter, audProject, audAccepter, audMe]
+
+            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   = uInvite
+                    , AP.acceptResult   = Nothing
+                    }
+                }
+
+        return (action, recipientSet, remoteActors, fwdHosts)
+
+    topicAcceptStem maybeCap recipActorID recipActor stem = do
+
+        maybeNew <- withDBExcept $ do
+
+            -- Find the local component and verify it's me
+            stemID <-
+                lift $ case stem of
+                    Left (originInviteID, _inviter) ->
+                        stemOriginInviteStem <$> getJust originInviteID
+                    Right (stemID, _originAddID, _adder) ->
+                        return stemID
+            ident <- lift $ getStemIdent stemID
+            unless (topicComponent recipKey == ident) $
+                throwE "Accept object is an Invite/Add for some other component"
+
+            project <-
+                lift $
+                requireEitherAlt
+                    (getBy $ UniqueStemProjectLocal stemID)
+                    (getBy $ UniqueStemProjectRemote stemID)
+                    "Found Stem with no project"
+                    "Found Stem with multiple projects"
+
+            idsForLater <- bitraverse
+
+                -- Accepting an Invite
+                -- If I haven't seen the project's approval, verify
+                -- the author is the project
+                -- Otherwise, verify the Accept is authorized
+                (\ (originInviteID, inviter) -> do
+                    scgl <- lift $ getBy $ UniqueStemComponentGestureLocal stemID
+                    scgr <- lift $ getBy $ UniqueStemComponentGestureRemote stemID
+                    unless (isNothing scgl && isNothing scgr) $
+                        throwE "I've already recorded my collaborator's Accept on the Invite, no need for further Accepts from anyone"
+                    seen <-
+                        lift $ case project of
+                            Left (Entity k _) -> isJust <$> getBy (UniqueStemProjectAcceptLocalProject k)
+                            Right (Entity k _) -> isJust <$> getBy (UniqueStemProjectAcceptRemoteProject k)
+                    if seen
+                        then 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
+                                (topicResource recipKey)
+                                AP.RoleAdmin
+                        else case (project, authorIdMsig) of
+                            (Left (Entity _ sjl), Left (LocalActorProject projectID, _, _))
+                                | stemProjectLocalProject sjl == projectID ->
+                                    return ()
+                            (Right (Entity _ sjr), Right (author, _, _))
+                                | stemProjectRemoteProject sjr == remoteAuthorId author ->
+                                    return ()
+                            _ -> throwE "The Accept I'm waiting for is by the project"
+                    return (originInviteID, seen, inviter)
+                )
+
+                (\ (_stemID, _originAddID, _adder) -> do
+                    seen <-
+                        lift $ case project of
+                            Left (Entity k _) -> isJust <$> getBy (UniqueStemProjectGrantLocalProject k)
+                            Right (Entity k _) -> isJust <$> getBy (UniqueStemProjectGrantRemoteProject k)
+                    when seen $
+                        throwE "Already saw project's Grant, no need for any Accepts"
+                )
+
+                stem
+
+            maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
+            for maybeAcceptDB $ \ acceptDB ->
+
+                case idsForLater of
+
+                    Left (originInviteID, seen, inviter) -> do
+
+                        if not seen
+                            then do
+                                lift $ case (project, acceptDB) of
+                                    (Left (Entity j _), Left (_, _, acceptID)) ->
+                                        insert_ $ StemProjectAcceptLocal originInviteID j acceptID
+                                    (Right (Entity j _), Right (_, _, acceptID)) ->
+                                        insert_ $ StemProjectAcceptRemote originInviteID j acceptID
+                                    _ -> error "topicAccept Impossible"
+                                return Nothing
+                            else do
+                                lift $ case acceptDB of
+                                    Left (_, _, acceptID) ->
+                                        insert_ $ StemComponentGestureLocal stemID acceptID
+                                    Right (author, _, acceptID) ->
+                                        insert_ $ StemComponentGestureRemote stemID (remoteAuthorId author) acceptID
+
+                                -- Prepare forwarding of Accept to my followers
+                                let recipByID = grantResourceLocalActor $ topicResource recipKey
+                                recipByHash <- hashLocalActor recipByID
+                                let sieve = makeRecipientSet [] [localActorFollowers recipByHash]
+
+                                reactInfo <- do
+
+                                    -- Record the fresh Accept in our DB
+                                    reactID <- lift $ insertEmptyOutboxItem' (actorOutbox recipActor) now
+                                    lift $ insert_ $ StemComponentAccept stemID reactID
+
+                                    -- Prepare an Accept activity and insert to my outbox
+                                    react@(actionReact, _, _, _) <- lift $ prepareReact project inviter
+                                    let recipByKey = grantResourceLocalActor $ topicResource recipKey
+                                    _luReact <- lift $ updateOutboxItem' recipByKey reactID actionReact
+                                    return (reactID, react)
+
+                                return $ Just (sieve, reactInfo)
+
+                    Right () -> return Nothing
+
+        case maybeNew of
+            Nothing -> done "I already have this activity in my inbox"
+            Just Nothing -> done "Done"
+            Just (Just (sieve, (reactID, (actionReact, localRecipsReact, remoteRecipsReact, fwdHostsReact)))) -> do
+                let recipByID = grantResourceLocalActor $ topicResource recipKey
+                forwardActivity authorIdMsig body recipByID recipActorID sieve
+                lift $ sendActivity
+                    recipByID recipActorID localRecipsReact
+                    remoteRecipsReact fwdHostsReact reactID actionReact
+                done "Forwarded the Accept and published an Accept"
+
 topicReject
     :: (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic)
     => (topic -> ActorId)

src/Vervis/Actor/Deck.hs

@@ -372,6 +372,23 @@ deckFollow now recipDeckID verse follow = do
 --         * Send a Grant:
 --             * To: Join sender
 --             * CC: Accept sender, Join sender's followers, my followers
+--     * If it's an Invite (that I know about) where I'm invited to a project:
+--          * If I haven't yet seen the project's approval:
+--              * Verify the author is the project
+--              * Record the approval in the Stem record in DB
+--          * If I saw project's approval, but not my collaborators' approval:
+--              * Verify the Accept is authorized
+--              * Record the approval in the Stem record in DB
+--              * Forward to my followers
+--              * Publish and send an Accept:
+--                  * To: Inviter, project, Accept author
+--                  * CC: Project followers, my followers
+--              * Record it in the Stem record in DB as well
+--          * If I already saw both approvals, respond with error
+--     * If it's an Add (that I know about and already Accepted) where I'm
+--       invited to a project:
+--          * If I've already seen the project's accept, respond with error
+--          * Otherwise, just ignore the Accept
 --     * Otherwise respond with error
 deckAccept
     :: UTCTime
@@ -379,7 +396,7 @@ deckAccept
     -> Verse
     -> AP.Accept URIMode
     -> ActE (Text, Act (), Next)
-deckAccept = topicAccept deckActor GrantResourceDeck
+deckAccept = topicAccept deckActor GrantResourceDeck ComponentDeck
 
 -- Meaning: An actor rejected something
 -- Behavior:

src/Vervis/Persist/Collab.hs

@@ -16,6 +16,7 @@
 module Vervis.Persist.Collab
     ( getCollabTopic
     , getCollabTopic'
+    , getStemIdent
     , getGrantRecip
     , getComponentE
     , getTopicGrants
@@ -107,6 +108,19 @@ getCollabTopic' collabID = do
                 (delete k, GrantResourceProject $ collabTopicProjectProject l)
             _ -> error "Found Collab with multiple topics"
 
+getStemIdent :: MonadIO m => StemId -> ReaderT SqlBackend m (ComponentBy Key)
+getStemIdent stemID = do
+    maybeRepo <- getValBy $ UniqueStemIdentRepo stemID
+    maybeDeck <- getValBy $ UniqueStemIdentDeck stemID
+    maybeLoom <- getValBy $ UniqueStemIdentLoom stemID
+    return $
+        case (maybeRepo, maybeDeck, maybeLoom) of
+            (Nothing, Nothing, Nothing) -> error "Found Stem without ident"
+            (Just r, Nothing, Nothing) -> ComponentRepo $ stemIdentRepoRepo r
+            (Nothing, Just d, Nothing) -> ComponentDeck $ stemIdentDeckDeck d
+            (Nothing, Nothing, Just l) -> ComponentLoom $ stemIdentLoomLoom l
+            _ -> error "Found Stem with multiple idents"
+
 getGrantRecip (GrantRecipPerson k) e = GrantRecipPerson <$> getEntityE k e
 
 getComponentE (ComponentRepo k) e = ComponentRepo <$> getEntityE k e