S2S: Invite: Remove Invite-based add-component code

src/Vervis/Actor/Common.hs

@@ -1179,18 +1179,6 @@ topicReject grabResource topicResource now recipKey (Verse authorIdMsig body) re
 --          * Remember the invite in DB
 --          * Forward the Invite to my followers
 --          * Send Accept to A, B, my-followers
---      * If I'm B, i.e. I'm the one being invited:
---          * Verify the resource is some project's components collection URI
---          * For each Stem record I have for this project:
---              * Verify it's not enabled yet, i.e. I'm not already a component
---                of this project
---              * Verify it's not in Invite-Accept state, already got the
---                project's Accept and waiting for my approval
---              * Verify it's not in Add-Accept state, has my approval and
---                waiting for the project's side
---          * Create a Stem record in DB
---          * Insert the Invite to my inbox
---          * Forward the Invite to my followers
 componentInvite
     :: forall topic.
        (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic)
@@ -1204,17 +1192,11 @@ componentInvite
 componentInvite grabKomponent topicComponent now topicKey (Verse authorIdMsig body) invite = do
 
     -- Check invite
-    recipOrProject <- do
+    (role, targetByKey) <- do
         let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig
         (role, resourceOrComps, recipientOrComp) <- parseInvite author invite
-        let collabMode =
+        if Left (Left $ topicResource topicKey) == resourceOrComps
-                Left (Left $ topicResource topicKey) == resourceOrComps
+            then (role,) <$>
-            compMode =
-                Left (Right $ topicComponent topicKey) == recipientOrComp
-        case (collabMode, compMode) of
-            (False, False) -> throwE "Invite is unrelated to me"
-            (True, True) -> throwE "I'm being invited as a collaborator in myself"
-            (True, False) -> Left . (role,) <$>
                 bitraverse
                     (\case
                         Left r -> pure r
@@ -1222,20 +1204,9 @@ componentInvite grabKomponent topicComponent now topicKey (Verse authorIdMsig bo
                     )
                     pure
                     recipientOrComp
-            (False, True) -> Right <$> do
+            else throwE "Invite is unrelated to me"
-                unless (role == AP.RoleAdmin) $
-                    throwE "Invite-component role isn't admin"
-                bitraverse
-                    (\case
-                        Left _ -> throwE "Inviting me to be a collaborator doesn't make sense to me"
-                        Right j -> pure j
-                    )
-                    pure
-                    resourceOrComps
 
-    recipOrProjectDB <-
+    (capability, targetDB) <- do
-        bitraverse
-            (\ (role, targetByKey) -> do
 
         -- Check capability
         capability <- do
@@ -1282,52 +1253,7 @@ componentInvite grabKomponent topicComponent now topicKey (Verse authorIdMsig bo
                 )
                 targetByKey
 
-                return (role, capability, targetByKey, targetDB)
+        return (capability, targetDB)
-            )
-
-            -- If project is local, find it in our DB
-            -- If project is remote, HTTP GET it and store in our DB (if it's already
-            -- there, no need for HTTP)
-            --
-            -- NOTE: This is a blocking HTTP GET done right here in the handler,
-            -- which is NOT a good idea. Ideally, it would be done async, and the
-            -- handler result would be sent later in a separate (e.g. Accept) activity.
-            -- But for the PoC level, the current situation will hopefully do.
-            (bitraverse
-                (withDBExcept . flip getEntityE "Project not found in DB")
-                (\ u@(ObjURI h luComps) -> do
-                    manager <- asksEnv envHttpManager
-                    collection <-
-                        ExceptT $ first T.pack <$>
-                            AP.fetchAPID
-                                manager
-                                (AP.collectionId :: AP.Collection FedURI URIMode -> LocalURI)
-                                h
-                                luComps
-                    luProject <- fromMaybeE (AP.collectionContext collection) "Collection has no context"
-                    project <-
-                        ExceptT $ first T.pack <$>
-                            AP.fetchAPID manager (AP.actorId . AP.actorLocal . AP.projectActor) h luProject
-                    unless (AP.projectComponents project == luComps) $
-                        throwE "The collection isn't the project's components collection"
-
-                    instanceID <-
-                        lift $ withDB $ either entityKey id <$> insertBy' (Instance h)
-                    result <-
-                        ExceptT $ first (T.pack . displayException) <$>
-                            fetchRemoteActor' instanceID h luProject
-                    case result of
-                        Left Nothing -> throwE "Target @id mismatch"
-                        Left (Just err) -> throwE $ T.pack $ displayException err
-                        Right Nothing -> throwE "Target isn't an actor"
-                        Right (Just actor) -> do
-                            unless (remoteActorType (entityVal actor) == AP.ActorTypeProject) $
-                                throwE "Remote project type isn't Project"
-                            return $ entityKey actor
-                )
-            )
-
-            recipOrProject
 
     maybeNew <- withDBExcept $ do
 
@@ -1337,9 +1263,6 @@ componentInvite grabKomponent topicComponent now topicKey (Verse authorIdMsig bo
         Resource topicActorID <- lift $ getJust resourceID
         topicActor <- lift $ getJust topicActorID
 
-        case recipOrProjectDB of
-            Left (role, capability, _targetByKey, targetDB) -> do
-
         -- Verify the specified capability gives relevant access
         verifyCapability'
             capability authorIdMsig (topicResource topicKey) AP.RoleAdmin
@@ -1370,13 +1293,6 @@ componentInvite grabKomponent topicComponent now topicKey (Verse authorIdMsig bo
             [_] -> throwE "I already have a Collab for the target"
             _ -> error "Multiple collabs found for target"
 
-            Right projectDB ->
-
-                -- Find existing Stem records I have for this project
-                -- Make sure none are enabled / in Add-Accept mode / in Invite-Accept
-                -- mode
-                checkExistingStems komponentID projectDB
-
         maybeInviteDB <- lift $ insertToInbox now authorIdMsig body (actorInbox topicActor) False
         lift $ for maybeInviteDB $ \ (inboxItemID, inviteDB) -> do
 
@@ -1387,33 +1303,27 @@ componentInvite grabKomponent topicComponent now topicKey (Verse authorIdMsig bo
                         resourceToActor $ topicResource topicHash
                 return $ makeRecipientSet [] [localActorFollowers topicByHash]
 
-            -- Insert Collab or Stem record to DB
+            -- Insert Collab record to DB
-            -- In Collab mode: Prepare an Accept activity and insert to my
+            -- Prepare an Accept activity and insert to my outbox
-            -- outbox
+            (acceptID, accept) <- do
-            maybeAccept <- case recipOrProjectDB of
-                Left (role, _capability, targetByKey, targetDB) -> Just <$> do
                 acceptID <- insertEmptyOutboxItem' (actorOutbox topicActor) now
                 insertCollab resourceID role targetDB inviteDB acceptID
                 accept@(actionAccept, _, _, _) <- lift $ prepareAccept targetByKey
                 let topicByKey = resourceToActor $ topicResource topicKey
                 _luAccept <- updateOutboxItem' topicByKey acceptID actionAccept
                 return (acceptID, accept)
-                Right projectDB -> do
-                    insertStem komponentID projectDB inviteDB
-                    return Nothing
 
-            return (topicActorID, sieve, maybeAccept, inboxItemID)
+            return (topicActorID, sieve, acceptID, accept, inboxItemID)
 
     case maybeNew of
         Nothing -> done "I already have this activity in my inbox"
-        Just (topicActorID, sieve, maybeAccept, inboxItemID) -> do
+        Just (topicActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do
             let topicByID = resourceToActor $ topicResource topicKey
             forwardActivity authorIdMsig body topicByID topicActorID sieve
-            lift $ for_ maybeAccept $ \ (acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) ->
+            lift $ sendActivity
-                sendActivity
                     topicByID topicActorID localRecipsAccept remoteRecipsAccept
                     fwdHostsAccept acceptID actionAccept
-            doneDB inboxItemID "Recorded and forwarded the Invite, sent an Accept if collab"
+            doneDB inboxItemID "Recorded and forwarded the Invite, sent an Accept"
 
     where
 
@@ -1435,20 +1345,6 @@ componentInvite grabKomponent topicComponent now topicKey (Verse authorIdMsig bo
             Right remoteActorID ->
                 insert_ $ CollabRecipRemote collabID remoteActorID
 
-    insertStem komponentID projectDB inviteDB = do
-        stemID <- insert $ Stem AP.RoleAdmin komponentID
-        case projectDB of
-            Left (Entity projectID _) ->
-                insert_ $ StemProjectLocal stemID projectID
-            Right remoteActorID ->
-                insert_ $ StemProjectRemote stemID remoteActorID
-        originID <- insert $ StemOriginInvite stemID
-        case inviteDB of
-            Left (_, _, inviteID) ->
-                insert_ $ StemProjectGestureLocal originID inviteID
-            Right (author, _, inviteID) ->
-                insert_ $ StemProjectGestureRemote originID (remoteAuthorId author) inviteID
-
     prepareAccept invited = do
         encodeRouteHome <- getEncodeRouteHome
 

src/Vervis/Actor/Deck.hs

@@ -574,27 +574,6 @@ deckReject
     -> ActE (Text, Act (), Next)
 deckReject = topicReject deckResource LocalResourceDeck
 
--- Meaning: An actor A invited actor B to a resource
--- Behavior:
---      * If resource is my collaborators collection:
---          * 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
---          * Send Accept to A, B, my-followers
---      * If I'm B, i.e. I'm the one being invited:
---          * Verify the resource is some project's components collection URI
---          * For each Stem record I have for this project:
---              * Verify it's not enabled yet, i.e. I'm not already a component
---                of this project
---              * Verify it's not in Invite-Accept state, already got the
---                project's Accept and waiting for my approval
---              * Verify it's not in Add-Accept state, has my approval and
---                waiting for the project's side
---          * Create a Stem record in DB
---          * Insert the Invite to my inbox
---          * Forward the Invite to my followers
 deckInvite
     :: UTCTime
     -> DeckId

src/Vervis/Actor/Project.hs

@@ -4864,28 +4864,19 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
 
 -- Meaning: An actor A invited actor B to a resource
 -- Behavior:
---      * Verify the resource is my collabs or components list
+--      * Verify the resource is my collabs list
---      * If resource is collabs and B is local, verify it's a Person
+--      * If B is local, verify it's a Person
---      * If resource is components and B is local, verify it's a Component
 --      * Verify A isn't inviting themselves
---      * Verify A is authorized by me to invite collabs/components to me
+--      * Verify A is authorized by me to invite collabs to me
 --
---      * In collab mode,
 --      * Verify B doesn't already have an invite/join/grant for me
---      * In component mode,
---          * Verify B isn't already an active component of mine
---          * Verify B isn't already in a Add-Accept process waiting for
---            project collab to accept too
---          * Verify B isn't already in an Invite-Accept process waiting for
---            component (or its collaborator) to accept too
 --
 --      * Insert the Invite to my inbox
 --
---      * In collab mode, Insert a Collab record to DB
+--      * Insert a Collab record to DB
---      * In component mode, Create a Component record in DB
 --
 --      * Forward the Invite to my followers
---      * Send Accept to A, B (and followers if it's a component), my-followers
+--      * Send Accept to A, B, my-followers
 projectInvite
     :: UTCTime
     -> ProjectId
@@ -4920,7 +4911,6 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do
         mode <-
             case resourceOrComps of
                 Left (Left (LocalResourceProject j)) | j == projectID ->
-                    Left <$>
                     bitraverse
                         (\case
                             Left r -> pure r
@@ -4928,16 +4918,7 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do
                         )
                         pure
                         recipientOrComp
-                Left (Right j) | j == projectID ->
+                _ -> throwE "Invite topic isn't my collabs URI"
-                    Right <$>
-                        bitraverse
-                            (\case
-                                Left _ -> throwE "Not accepting local Persons as components"
-                                Right r -> pure r
-                            )
-                            pure
-                            recipientOrComp
-                _ -> throwE "Invite topic isn't my collabs or components URI"
         return (role, mode)
 
     -- If target is local, find it in our DB
@@ -4949,16 +4930,10 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do
     -- handler result (approve/disapprove the Invite) would be sent later in a
     -- separate (e.g. Accept) activity. But for the PoC level, the current
     -- situation will hopefully do.
-    invitedDB <-
+    collab <-
         bitraverse
-            (bitraverse
             (withDBExcept . flip getGrantRecip "Invitee not found in DB")
             getRemoteActorFromURI
-            )
-            (bitraverse
-                (withDBExcept . flip getComponentE "Invitee not found in DB")
-                getRemoteActorFromURI
-            )
             invited
 
     maybeNew <- withDBExcept $ do
@@ -4972,29 +4947,19 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do
         verifyCapability'
             capability authorIdMsig (LocalResourceProject projectID) AP.RoleAdmin
 
-        case invitedDB of
-
         -- Verify that target doesn't already have a Collab for me
-            Left collab -> do
         existingCollabIDs <- lift $ getExistingCollabs resourceID collab
         case existingCollabIDs of
             [] -> pure ()
             [_] -> throwE "I already have a Collab for the target"
             _ -> error "Multiple collabs found for target"
 
-            -- Find existing Component records I have for this component
-            -- Make sure none are enabled / in Add-Accept mode / in
-            -- Invite-Accept mode
-            Right component -> checkExistingComponents projectID component
-
         maybeInviteDB <- lift $ insertToInbox now authorIdMsig body (actorInbox topicActor) False
         lift $ for maybeInviteDB $ \ (inboxItemID, inviteDB) -> do
 
             -- Insert Collab or Component record to DB
             acceptID <- insertEmptyOutboxItem' (actorOutbox topicActor) now
-            case invitedDB of
+            insertCollab resourceID role collab inviteDB acceptID
-                Left collab -> insertCollab resourceID role collab inviteDB acceptID
-                Right component -> insertComponent component inviteDB acceptID
 
             -- Prepare forwarding Invite to my followers
             sieve <- do
@@ -5002,7 +4967,7 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do
                 return $ makeRecipientSet [] [LocalStageProjectFollowers projectHash]
 
             -- Prepare an Accept activity and insert to my outbox
-            accept@(actionAccept, _, _, _) <- prepareAccept invitedDB
+            accept@(actionAccept, _, _, _) <- prepareAccept collab
             _luAccept <- updateOutboxItem' (LocalActorProject projectID) acceptID actionAccept
 
             return (topicActorID, sieve, acceptID, accept, inboxItemID)
@@ -5065,42 +5030,19 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do
             Right remoteActorID ->
                 insert_ $ CollabRecipRemote collabID remoteActorID
 
-    insertComponent componentDB inviteDB acceptID = do
-        componentID <- insert $ Component projectID AP.RoleAdmin
-        originID <- insert $ ComponentOriginInvite componentID
-        case inviteDB of
-            Left (_, _, inviteID) ->
-                insert_ $ ComponentProjectGestureLocal componentID inviteID
-            Right (author, _, inviteID) ->
-                insert_ $ ComponentProjectGestureRemote componentID (remoteAuthorId author) inviteID
-        case componentDB of
-            Left l ->
-                insert_ $ ComponentLocal componentID (localComponentID l)
-            Right remoteActorID ->
-                insert_ $ ComponentRemote componentID remoteActorID
-        insert_ $ ComponentProjectAccept originID acceptID
-
     prepareAccept invitedDB = do
         encodeRouteHome <- getEncodeRouteHome
 
         audInviter <- lift $ makeAudSenderOnly authorIdMsig
         audInvited <-
             case invitedDB of
-                Left (Left (GrantRecipPerson (Entity p _))) -> do
+                Left (GrantRecipPerson (Entity p _)) -> do
                     ph <- encodeKeyHashid p
                     return $ AudLocal [LocalActorPerson ph] []
-                Left (Right remoteActorID) -> do
+                Right remoteActorID -> do
                     ra <- getJust remoteActorID
                     ObjURI h lu <- getRemoteActorURI ra
                     return $ AudRemote h [lu] []
-                Right (Left componentByEnt) -> do
-                    componentByHash <- hashComponent $ bmap entityKey componentByEnt
-                    let actor = resourceToActor $ componentResource componentByHash
-                    return $ AudLocal [actor] [localActorFollowers actor]
-                Right (Right remoteActorID) -> do
-                    ra <- getJust remoteActorID
-                    ObjURI h lu <- getRemoteActorURI ra
-                    return $ AudRemote h [lu] (maybeToList $ remoteActorFollowers ra)
         audTopic <-
             AudLocal [] . pure . LocalStageProjectFollowers <$>
                 encodeKeyHashid projectID