S2S: topicInvite, projectInvite: If approved, send an Accept

migrations/547_2023-06-28_invite_accept.model

@@ -0,0 +1,88 @@
+Inbox
+FollowerSet
+Workflow
+Collab
+
+Outbox
+
+OutboxItem
+    outbox    OutboxId
+    activity  PersistJSONObject
+    published UTCTime
+
+Actor
+    name      Text
+    desc      Text
+    createdAt UTCTime
+    inbox     InboxId
+    outbox    OutboxId
+    followers FollowerSetId
+    justCreatedBy ActorId Maybe
+
+Project
+    actor  ActorId
+    create OutboxItemId
+
+    UniqueProjectActor  actor
+    UniqueProjectCreate create
+
+Deck
+    actor      ActorId
+    workflow   WorkflowId
+    nextTicket Int
+    wiki       RepoId        Maybe
+    create     OutboxItemId
+
+    UniqueDeckActor  actor
+    UniqueDeckCreate create
+
+Loom
+    nextTicket Int
+    actor      ActorId
+    repo       RepoId
+    create     OutboxItemId
+
+    UniqueLoomActor  actor
+    UniqueLoomRepo   repo
+    UniqueLoomCreate create
+
+Repo
+    vcs        VersionControlSystem
+    project    DeckId               Maybe
+    mainBranch Text
+    actor      ActorId
+    create     OutboxItemId
+    loom       LoomId               Maybe
+
+    UniqueRepoActor  actor
+    UniqueRepoCreate create
+
+CollabFulfillsInvite
+    collab CollabId
+    accept OutboxItemId
+
+    UniqueCollabFulfillsInvite collab
+
+CollabTopicRepo
+    collab CollabId
+    repo   RepoId
+
+    UniqueCollabTopicRepo collab
+
+CollabTopicDeck
+    collab CollabId
+    deck   DeckId
+
+    UniqueCollabTopicDeck collab
+
+CollabTopicLoom
+    collab CollabId
+    loom   LoomId
+
+    UniqueCollabTopicLoom collab
+
+CollabTopicProject
+    collab  CollabId
+    project ProjectId
+
+    UniqueCollabTopicProject collab

src/Vervis/Actor/Common.hs

@@ -786,7 +786,8 @@ topicInvite grabActor topicResource topicField topicCollabField collabTopicCtor
         lift $ for maybeInviteDB $ \ inviteDB -> do
 
             -- Insert Collab record to DB
-            insertCollab role targetDB inviteDB
+            acceptID <- insertEmptyOutboxItem' (actorOutbox topicActor) now
+            insertCollab role targetDB inviteDB acceptID
 
             -- Prepare forwarding Invite to my followers
             sieve <- do
@@ -794,20 +795,29 @@ topicInvite grabActor topicResource topicField topicCollabField collabTopicCtor
                 let topicByHash =
                         grantResourceLocalActor $ topicResource topicHash
                 return $ makeRecipientSet [] [localActorFollowers topicByHash]
-            return (topicActorID, sieve)
+
+            -- Prepare an Accept activity and inser to my outbox
+            accept@(actionAccept, _, _, _) <- lift $ prepareAccept targetByKey
+            let topicByKey = grantResourceLocalActor $ topicResource topicKey
+            _luAccept <- updateOutboxItem' topicByKey acceptID actionAccept
+
+            return (topicActorID, sieve, acceptID, accept)
 
     case maybeNew of
         Nothing -> done "I already have this activity in my inbox"
-        Just (topicActorID, sieve) -> do
+        Just (topicActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
             let topicByID = grantResourceLocalActor $ topicResource topicKey
             forwardActivity authorIdMsig body topicByID topicActorID sieve
-            done "Recorded and forwarded the Invite"
+            lift $ sendActivity
+                topicByID topicActorID localRecipsAccept remoteRecipsAccept
+                fwdHostsAccept acceptID actionAccept
+            done "Recorded and forwarded the Invite, sent an Accept"
 
     where
 
-    insertCollab role recipient inviteDB = do
+    insertCollab role recipient inviteDB acceptID = do
         collabID <- insert $ Collab role
-        fulfillsID <- insert $ CollabFulfillsInvite collabID
+        fulfillsID <- insert $ CollabFulfillsInvite collabID acceptID
         insert_ $ collabTopicCtor collabID topicKey
         case inviteDB of
             Left (_, _, inviteID) ->
@@ -821,6 +831,38 @@ topicInvite grabActor topicResource topicField topicCollabField collabTopicCtor
             Right remoteActorID ->
                 insert_ $ CollabRecipRemote collabID remoteActorID
 
+    prepareAccept invited = do
+        encodeRouteHome <- getEncodeRouteHome
+
+        audInviter <- makeAudSenderOnly authorIdMsig
+        audInvited <-
+            case invited of
+                Left (GrantRecipPerson p) -> do
+                    ph <- encodeKeyHashid p
+                    return $ AudLocal [LocalActorPerson ph] []
+                Right (ObjURI h lu) -> return $ AudRemote h [lu] []
+        audTopic <-
+            flip AudLocal [] . pure . grantResourceLocalActor . topicResource <$>
+                encodeKeyHashid topicKey
+        uInvite <- getActivityURI authorIdMsig
+
+        let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
+                collectAudience [audInviter, audInvited, audTopic]
+
+            recips = map encodeRouteHome audLocal ++ audRemote
+            action = AP.Action
+                { AP.actionCapability = Nothing
+                , AP.actionSummary    = Nothing
+                , AP.actionAudience   = AP.Audience recips [] [] [] [] []
+                , AP.actionFulfills   = [uInvite]
+                , AP.actionSpecific   = AP.AcceptActivity AP.Accept
+                    { AP.acceptObject   = uInvite
+                    , AP.acceptResult   = Nothing
+                    }
+                }
+
+        return (action, recipientSet, remoteActors, fwdHosts)
+
 topicRemove
     :: ( PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic
        , PersistRecordBackend ct SqlBackend

src/Vervis/Actor/Deck.hs

@@ -208,6 +208,7 @@ deckReject = topicReject deckActor GrantResourceDeck
 --      * 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
 deckInvite
     :: UTCTime
     -> DeckId

src/Vervis/Actor/Project.hs

@@ -99,8 +99,8 @@ projectAccept = topicAccept projectActor GrantResourceProject
 
 -- Meaning: An actor is adding some object to some target
 -- Behavior:
---     * Verify I'm the target
+--     * Verify my components list is the target
---     * Verify the object is a component, find in DB if local
+--     * Verify the object is a component, find in DB/HTTP
 --     * Verify it's not already an active component of mine
 --     * Verify it's not already in a Add-Accept process waiting for project
 --       collab to accept too
@@ -359,12 +359,19 @@ projectFollow now recipProjectID verse follow = do
 
 -- Meaning: An actor A invited actor B to a resource
 -- Behavior:
---      * Verify the resource is me
+--      * Verify the resource is my collabs list
+--      * If invitee is local, verify it's a Person and not a Component
 --      * Verify A isn't inviting themselves
---      * Verify A is authorized by me to invite actors to me
+--      * Verify A is authorized by me to invite collabs to me
+--
 --      * Verify B doesn't already have an invite/join/grant for me
---      * Remember the invite in DB
+--
+--      * Insert the Invite to my inbox
+--
+--      * Insert a Collab record to DB
+--
 --      * Forward the Invite to my followers
+--      * Send Accept to A, B (and followers if it's a component), my-followers
 projectInvite
     :: UTCTime
     -> ProjectId
@@ -476,26 +483,35 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do
         lift $ for maybeInviteDB $ \ inviteDB -> do
 
             -- Insert Collab record to DB
-            insertCollab role targetDB inviteDB
+            acceptID <- insertEmptyOutboxItem' (actorOutbox topicActor) now
+            insertCollab role targetDB inviteDB acceptID
 
             -- Prepare forwarding Invite to my followers
             sieve <- do
                 projectHash <- encodeKeyHashid projectID
                 return $ makeRecipientSet [] [LocalStageProjectFollowers projectHash]
-            return (topicActorID, sieve)
+
+            -- Prepare an Accept activity and insert to my outbox
+            accept@(actionAccept, _, _, _) <- lift $ prepareAccept targetByKey
+            _luAccept <- updateOutboxItem' (LocalActorProject projectID) acceptID actionAccept
+
+            return (topicActorID, sieve, acceptID, accept)
 
     case maybeNew of
         Nothing -> done "I already have this activity in my inbox"
-        Just (projectActorID, sieve) -> do
+        Just (projectActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
             forwardActivity
                 authorIdMsig body (LocalActorProject projectID) projectActorID sieve
-            done "Recorded and forwarded the Invite"
+            lift $ sendActivity
+                (LocalActorProject projectID) projectActorID localRecipsAccept
+                remoteRecipsAccept fwdHostsAccept acceptID actionAccept
+            done "Recorded and forwarded the Invite, sent an Accept"
 
     where
 
-    insertCollab role recipient inviteDB = do
+    insertCollab role recipient inviteDB acceptID = do
         collabID <- insert $ Collab role
-        fulfillsID <- insert $ CollabFulfillsInvite collabID
+        fulfillsID <- insert $ CollabFulfillsInvite collabID acceptID
         insert_ $ CollabTopicProject collabID projectID
         case inviteDB of
             Left (_, _, inviteID) ->
@@ -509,6 +525,38 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do
             Right remoteActorID ->
                 insert_ $ CollabRecipRemote collabID remoteActorID
 
+    prepareAccept invited = do
+        encodeRouteHome <- getEncodeRouteHome
+
+        audInviter <- makeAudSenderOnly authorIdMsig
+        audInvited <-
+            case invited of
+                Left (GrantRecipPerson p) -> do
+                    ph <- encodeKeyHashid p
+                    return $ AudLocal [LocalActorPerson ph] []
+                Right (ObjURI h lu) -> return $ AudRemote h [lu] []
+        audTopic <-
+            flip AudLocal [] . pure . LocalActorProject <$>
+                encodeKeyHashid projectID
+        uInvite <- getActivityURI authorIdMsig
+
+        let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
+                collectAudience [audInviter, audInvited, audTopic]
+
+            recips = map encodeRouteHome audLocal ++ audRemote
+            action = AP.Action
+                { AP.actionCapability = Nothing
+                , AP.actionSummary    = Nothing
+                , AP.actionAudience   = AP.Audience recips [] [] [] [] []
+                , AP.actionFulfills   = [uInvite]
+                , AP.actionSpecific   = AP.AcceptActivity AP.Accept
+                    { AP.acceptObject   = uInvite
+                    , AP.acceptResult   = Nothing
+                    }
+                }
+
+        return (action, recipientSet, remoteActors, fwdHosts)
+
 -- Meaning: An actor A asked to join a resource
 -- Behavior:
 --      * Verify the resource is me

src/Vervis/Migration.hs

@@ -2968,6 +2968,57 @@ changes hLocal ctx =
     , addFieldPrimRequired "Component" ("RoleAdmin" :: String) "role"
       -- 546
     , addFieldPrimRequired "Stem" ("RoleAdmin" :: String) "role"
+      -- 547
+    , addFieldRefRequired''
+        "CollabFulfillsInvite"
+        (do outboxID <- insert Outbox547
+            let doc = persistJSONObjectFromDoc $ Doc hLocal emptyActivity
+            insertEntity $ OutboxItem547 outboxID doc defaultTime
+        )
+        (Just $ \ (Entity obiidTemp obiTemp) -> do
+            let doc = persistJSONObjectFromDoc $ Doc hLocal emptyActivity
+
+            rs <- selectList ([] :: [Filter CollabTopicRepo547]) []
+            for_ rs $ \ (Entity _ (CollabTopicRepo547 cid tid)) -> do
+                mfi <- getBy $ UniqueCollabFulfillsInvite547 cid
+                for_ mfi $ \ (Entity fiid _) -> do
+                    aid <- repo547Actor <$> getJust tid
+                    obid <- actor547Outbox <$> getJust aid
+                    acceptID <- insert $ OutboxItem547 obid doc defaultTime
+                    update fiid [CollabFulfillsInvite547Accept =. acceptID]
+
+            ds <- selectList ([] :: [Filter CollabTopicDeck547]) []
+            for_ ds $ \ (Entity _ (CollabTopicDeck547 cid tid)) -> do
+                mfi <- getBy $ UniqueCollabFulfillsInvite547 cid
+                for_ mfi $ \ (Entity fiid _) -> do
+                    aid <- deck547Actor <$> getJust tid
+                    obid <- actor547Outbox <$> getJust aid
+                    acceptID <- insert $ OutboxItem547 obid doc defaultTime
+                    update fiid [CollabFulfillsInvite547Accept =. acceptID]
+
+            ls <- selectList ([] :: [Filter CollabTopicLoom547]) []
+            for_ ls $ \ (Entity _ (CollabTopicLoom547 cid tid)) -> do
+                mfi <- getBy $ UniqueCollabFulfillsInvite547 cid
+                for_ mfi $ \ (Entity fiid _) -> do
+                    aid <- loom547Actor <$> getJust tid
+                    obid <- actor547Outbox <$> getJust aid
+                    acceptID <- insert $ OutboxItem547 obid doc defaultTime
+                    update fiid [CollabFulfillsInvite547Accept =. acceptID]
+
+            js <- selectList ([] :: [Filter CollabTopicProject547]) []
+            for_ js $ \ (Entity _ (CollabTopicProject547 cid tid)) -> do
+                mfi <- getBy $ UniqueCollabFulfillsInvite547 cid
+                for_ mfi $ \ (Entity fiid _) -> do
+                    aid <- project547Actor <$> getJust tid
+                    obid <- actor547Outbox <$> getJust aid
+                    acceptID <- insert $ OutboxItem547 obid doc defaultTime
+                    update fiid [CollabFulfillsInvite547Accept =. acceptID]
+
+            delete obiidTemp
+            delete $ outboxItem547Outbox obiTemp
+        )
+        "accept"
+        "OutboxItem"
     ]
 
 migrateDB

src/Vervis/Migration/Model.hs

@@ -1,6 +1,7 @@
 {- This file is part of Vervis.
  -
- - Written in 2018, 2019, 2020, 2022 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2018, 2019, 2020, 2022, 2023
+ - by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -524,3 +525,6 @@ makeEntitiesMigration "525"
 
 makeEntitiesMigration "527"
     $(modelFile "migrations/527_2022-10-20_collab_accept_remote.model")
+
+makeEntitiesMigration "547"
+    $(modelFile "migrations/547_2023-06-28_invite_accept.model")

th/models

@@ -590,6 +590,7 @@ CollabFulfillsLocalTopicCreation
 
 CollabFulfillsInvite
     collab CollabId
+    accept OutboxItemId
 
     UniqueCollabFulfillsInvite collab