Person: Port Invite and Follow handlers to new system

src/Vervis/API.hs

@@ -1851,7 +1851,8 @@ inviteC
     -> AP.Invite URIMode
     -> ExceptT Text Handler OutboxItemId
 inviteC (Entity senderPersonID senderPerson) senderActor maybeCap localRecips remoteRecips fwdHosts action invite = do
-
+    error "Temporarily disabled due to switch to new actor system"
+{-
     -- Check input
     (resource, recipient) <- parseInvite (Left senderPersonID) invite
     capID <- fromMaybeE maybeCap "No capability provided"
@@ -2054,6 +2055,7 @@ inviteC (Entity senderPersonID senderPerson) senderActor maybeCap localRecips re
 
     hashGrantRecip (GrantRecipPerson k) =
         GrantRecipPerson <$> encodeKeyHashid k
+-}
 
 offerTicketC
     :: Entity Person

src/Vervis/ActivityPub.hs

@@ -1,6 +1,7 @@
 {- This file is part of Vervis.
  -
- - Written in 2019, 2020, 2021, 2022 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2019, 2020, 2021, 2022, 2023
+ - by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -26,6 +27,7 @@ module Vervis.ActivityPub
 
     , provideEmptyCollection
     , insertEmptyOutboxItem
+    , insertEmptyOutboxItem'
     , verifyContentTypeAP
     , verifyContentTypeAP_E
     , getActivity
@@ -82,9 +84,11 @@ import qualified Database.Esqueleto as E
 
 import Yesod.HttpSignature
 
+import Control.Concurrent.Actor
 import Database.Persist.JSON
 import Network.FedURI
 import Network.HTTP.Digest
+import Web.Actor (stageInstanceHost)
 import Yesod.ActivityPub
 import Yesod.MonadSite
 import Yesod.FedURI
@@ -235,6 +239,15 @@ insertEmptyOutboxItem obid now = do
         , outboxItemPublished = now
         }
 
+insertEmptyOutboxItem' obid now = do
+    h <- asksEnv stageInstanceHost
+    insert OutboxItem
+        { outboxItemOutbox    = obid
+        , outboxItemActivity  =
+            persistJSONObjectFromDoc $ AP.Doc h AP.emptyActivity
+        , outboxItemPublished = now
+        }
+
 verifyContentTypeAP :: MonadHandler m => m ()
 verifyContentTypeAP = do
     result <- runExceptT verifyContentTypeAP_E

src/Vervis/Actor.hs

@@ -293,13 +293,19 @@ data VerseRemote = VerseRemote
     }
 
 data Event
-    = EventRemoteGrantLocalRecipFwdToFollower RemoteActivityId
+    = EventRemoteInviteLocalRecipFwdToFollower RemoteActivityId
-    -- ^ A local actor has received a Grant (they're being granted some access)
+    -- ^ A local actor has received an Invite (they're being offered some access)
+    --   and forwarding it to me because I'm following this local actor
+    | EventRemoteFollowLocalRecipFwdToFollower RemoteActivityId
+    -- ^ A local actor has received an Follow where they're the target,
     --   and forwarding it to me because I'm following this local actor
     | EventRemoteFwdLocalActivity (LocalActorBy Key) OutboxItemId
     -- EventLocalFwdRemoteActivity (LocalActorBy Key) RemoteActivityId
     -- ^ A local actor is forwarding me a remote activity to add to my inbox.
     --   The data is (1) who's forwarding to me (2) the remote activity
+    | EventAcceptRemoteFollow
+    -- ^ A local actor (that I'm following) has accepted a Follow from some
+    --   remote actor
     | EventUnknown
     deriving Show
 

src/Vervis/Actor/Person.hs

@@ -14,6 +14,9 @@
  - <http://creativecommons.org/publicdomain/zero/1.0/>.
  -}
 
+-- for actorFollow
+{-# LANGUAGE RankNTypes #-}
+
 module Vervis.Actor.Person
     ( personBehavior
     )
@@ -29,6 +32,7 @@ import Control.Monad.Trans.Reader
 import Data.Bitraversable
 import Data.ByteString (ByteString)
 import Data.Foldable
+import Data.Maybe
 import Data.Text (Text)
 import Data.Time.Clock
 import Data.Traversable
@@ -40,6 +44,7 @@ import qualified Data.Text as T
 
 import Control.Concurrent.Actor
 import Network.FedURI
+import Web.Actor
 import Web.Actor.Persist
 import Yesod.MonadSite
 
@@ -48,21 +53,170 @@ import qualified Web.ActivityPub as AP
 import Control.Monad.Trans.Except.Local
 import Database.Persist.Local
 
+import Vervis.Access
+import Vervis.ActivityPub
 import Vervis.Actor
 import Vervis.Actor2
 import Vervis.Cloth
+import Vervis.Data.Actor
 import Vervis.Data.Collab
 import Vervis.Data.Discussion
 import Vervis.FedURI
 import Vervis.Federation.Util
 import Vervis.Foundation
 import Vervis.Model
-import Vervis.Recipient (makeRecipientSet, LocalStageBy (..))
+import Vervis.Recipient (makeRecipientSet, LocalStageBy (..), Aud (..), collectAudience)
 import Vervis.Persist.Actor
 import Vervis.Persist.Collab
 import Vervis.Persist.Discussion
 import Vervis.Ticket
 
+------------------------------------------------------------------------------
+-- Following
+------------------------------------------------------------------------------
+
+actorFollow
+    :: (PersistRecordBackend r SqlBackend, ToBackendKey SqlBackend r)
+    => (Route App -> ActE a)
+    -> (r -> ActorId)
+    -> Bool
+    -> (Key r -> Actor -> a -> ActDBE FollowerSetId)
+    -> (a -> ActDB RecipientRoutes)
+    -> (forall f. f r -> LocalActorBy f)
+    -> (a -> Act [Aud URIMode])
+    -> UTCTime
+    -> Key r
+    -> RemoteAuthor
+    -> ActivityBody
+    -> Maybe (RecipientRoutes, ByteString)
+    -> LocalURI
+    -> AP.Follow URIMode
+    -> ActE (Text, Act (), Next)
+actorFollow parseFollowee grabActor unread getFollowee getSieve makeLocalActor makeAudience now recipID author body mfwd luFollow (AP.Follow uObject _ hide) = do
+
+    -- Check input
+    followee <- nameExceptT "Follow object" $ do
+        route <- do
+            routeOrRemote <- parseFedURI uObject
+            case routeOrRemote of
+                Left route -> pure route
+                Right _ -> throwE "Remote, so definitely not me/mine"
+        parseFollowee route
+    verifyNothingE
+        (AP.activityCapability $ actbActivity body)
+        "Capability not needed"
+
+    maybeFollow <- withDBExcept $ do
+
+        -- Find recipient actor in DB
+        recip <- lift $ getJust recipID
+        let recipActorID = grabActor recip
+        recipActor <- lift $ getJust recipActorID
+
+        -- Insert the Follow to actor's inbox
+        mractid <- lift $ insertToInbox now author body (actorInbox recipActor) luFollow unread
+        for mractid $ \ followID -> do
+
+            -- Find followee in DB
+            followerSetID <- getFollowee recipID recipActor followee
+
+            -- Verify not already following us
+            let followerID = remoteAuthorId author
+            maybeFollow <-
+                lift $ getBy $ UniqueRemoteFollow followerID followerSetID
+            verifyNothingE maybeFollow "You're already following this object"
+
+            -- Record the new follow in DB
+            acceptID <-
+                lift $ insertEmptyOutboxItem' (actorOutbox recipActor) now
+            lift $ insert_ $ RemoteFollow followerID followerSetID (not hide) followID acceptID
+
+            -- Prepare an Accept activity and insert to actor's outbox
+            accept@(actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
+                lift $ prepareAccept followee
+            _luAccept <- lift $ updateOutboxItem' (makeLocalActor recipID) acceptID actionAccept
+
+            sieve <- lift $ getSieve followee
+            return (recipActorID, followID, acceptID, sieve, accept)
+
+    case maybeFollow of
+        Nothing -> done "I already have this activity in my inbox"
+        Just (actorID, followID, acceptID, sieve, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
+            lift $ for_ mfwd $ \ (localRecips, sig) ->
+                forwardActivity
+                    (actbBL body) localRecips sig actorID
+                    (makeLocalActor recipID) sieve
+                    (EventRemoteFollowLocalRecipFwdToFollower followID)
+            lift $ sendActivity
+                (makeLocalActor recipID) actorID localRecipsAccept
+                remoteRecipsAccept fwdHostsAccept acceptID
+                EventAcceptRemoteFollow actionAccept
+            done "Recorded Follow and published Accept"
+
+    where
+
+    prepareAccept followee = do
+        encodeRouteHome <- getEncodeRouteHome
+
+        ra <- getJust $ remoteAuthorId author
+
+        let ObjURI hAuthor luAuthor = remoteAuthorURI author
+
+            audSender =
+                AudRemote hAuthor
+                    [luAuthor]
+                    (maybeToList $ remoteActorFollowers ra)
+
+        audsRecip <- lift $ makeAudience followee
+
+        let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
+                collectAudience $ audSender : audsRecip
+
+            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   = ObjURI hAuthor luFollow
+                    , AP.acceptResult   = Nothing
+                    }
+                }
+
+        return (action, recipientSet, remoteActors, fwdHosts)
+
+-- Meaning: Someone is following someone
+-- Behavior:
+--      * Verify I'm the target
+--      * Record the follow in DB
+--      * Publish and send an Accept to the sender and its followers
+personFollow
+    :: UTCTime
+    -> PersonId
+    -> RemoteAuthor
+    -> ActivityBody
+    -> Maybe (RecipientRoutes, ByteString)
+    -> LocalURI
+    -> AP.Follow URIMode
+    -> ActE (Text, Act (), Next)
+personFollow now recipPersonID author body mfwd luFollow follow = do
+    recipPersonHash <- encodeKeyHashid recipPersonID
+    actorFollow
+        (\case
+            PersonR p | p == recipPersonHash -> pure ()
+            _ -> throwE "Asking to follow someone else"
+        )
+        personActor
+        True
+        (\ _recipPersonID recipPersonActor () ->
+            pure $ actorFollowers recipPersonActor
+        )
+        (\ () -> pure $ makeRecipientSet [] [])
+        LocalActorPerson
+        (\ () -> pure [])
+        now recipPersonID author body mfwd luFollow follow
+
 ------------------------------------------------------------------------------
 -- Commenting
 ------------------------------------------------------------------------------
@@ -147,10 +301,70 @@ personCreateNote now recipPersonID author body mfwd luCreate note = do
 -- Access
 ------------------------------------------------------------------------------
 
+-- Meaning: Someone invited someone to a resource
+-- Behavior:
+--      * Insert to my inbox
+--      * If I'm the target, forward the Invite to my followers
+personInvite
+    :: UTCTime
+    -> PersonId
+    -> RemoteAuthor
+    -> ActivityBody
+    -> Maybe (RecipientRoutes, ByteString)
+    -> LocalURI
+    -> AP.Invite URIMode
+    -> ActE (Text, Act (), Next)
+personInvite now recipPersonID author body mfwd luInvite invite = do
+
+    -- Check input
+    recipient <- do
+        (_resource, target) <-
+            parseInvite (Right $ remoteAuthorURI author) invite
+        return target
+
+    maybeInvite <- withDBExcept $ do
+
+        -- Grab recipient person from DB
+        (personRecip, actorRecip) <- lift $ do
+            p <- getJust recipPersonID
+            (p,) <$> getJust (personActor p)
+
+        mractid <- lift $ insertToInbox now author body (actorInbox actorRecip) luInvite True
+        for mractid $ \ inviteID ->
+            return (personActor personRecip, inviteID)
+
+    case maybeInvite of
+        Nothing -> done "I already have this activity in my inbox"
+        Just (actorID, inviteID) -> do
+            let targetIsRecip =
+                    case recipient of
+                        Left (GrantRecipPerson p) -> p == recipPersonID
+                        _ -> False
+            if not targetIsRecip
+                then done "I'm not the target; Inserted to inbox"
+                else case mfwd of
+                    Nothing ->
+                        done
+                            "I'm the target; Inserted to inbox; \
+                            \Forwarding not approved"
+                    Just (localRecips, sig) -> do
+                        recipHash <- encodeKeyHashid recipPersonID
+                        let sieve =
+                                makeRecipientSet
+                                    []
+                                    [LocalStagePersonFollowers recipHash]
+                        lift $ forwardActivity
+                            (actbBL body) localRecips sig
+                            actorID
+                            (LocalActorPerson recipPersonID) sieve
+                            (EventRemoteInviteLocalRecipFwdToFollower inviteID)
+                        done
+                            "I'm the target; Inserted to inbox; \
+                            \Forwarded to followers if addressed"
+
 -- Meaning: A remote actor published a Grant
 -- Behavior:
 --      * Insert to my inbox
---      * If I'm the target, forward the Grant to my followers
 personGrant
     :: UTCTime
     -> PersonId
@@ -182,45 +396,19 @@ personGrant now recipPersonID author body mfwd luGrant grant = do
             (p,) <$> getJust (personActor p)
 
         mractid <- lift $ insertToInbox now author body (actorInbox actorRecip) luGrant True
-        for mractid $ \ grantID -> do
+        for mractid $ \ grantID ->
-
-            -- If recipient is local, find it in our DB
-            _recipientDB <-
-                bitraverse
-                    (flip getGrantRecip "Grant local target not found in DB")
-                    pure
-                    recipient
-
             return (personActor personRecip, grantID)
 
     case maybeGrant of
         Nothing -> done "I already have this activity in my inbox"
-        Just (actorID, grantID) -> do
+        Just (_actorID, _grantID) -> do
             let targetIsRecip =
                     case recipient of
                         Left (GrantRecipPerson p) -> p == recipPersonID
                         _ -> False
             if not targetIsRecip
                 then done "I'm not the target; Inserted to inbox"
-                else case mfwd of
+                else done "I'm the target; Inserted to inbox"
-                    Nothing ->
-                        done
-                            "I'm the target; Inserted to inbox; \
-                            \Forwarding not approved"
-                    Just (localRecips, sig) -> do
-                        recipHash <- encodeKeyHashid recipPersonID
-                        let sieve =
-                                makeRecipientSet
-                                    []
-                                    [LocalStagePersonFollowers recipHash]
-                        lift $ forwardActivity
-                            (actbBL body) localRecips sig
-                            actorID
-                            (LocalActorPerson recipPersonID) sieve
-                            (EventRemoteGrantLocalRecipFwdToFollower grantID)
-                        done
-                            "I'm the target; Inserted to inbox; \
-                            \Forwarded to followers if addressed"
 
 ------------------------------------------------------------------------------
 -- Main behavior function
@@ -242,18 +430,18 @@ insertActivityToInbox now recipActorID outboxItemID = do
 personBehavior :: UTCTime -> PersonId -> Verse -> ActE (Text, Act (), Next)
 personBehavior now personID (Left event) =
     case event of
-        -- Meaning: Someone X received a Grant and forwarded it to me because
+        -- Meaning: Someone X received an Invite and forwarded it to me because
         --          I'm a follower of X
         -- Behavior: Insert to my inbox
-        EventRemoteGrantLocalRecipFwdToFollower grantID -> do
+        EventRemoteInviteLocalRecipFwdToFollower inviteID -> do
             lift $ withDB $ do
                 (_personRecip, actorRecip) <- do
                     p <- getJust personID
                     (p,) <$> getJust (personActor p)
                 let inboxID = actorInbox actorRecip
                 itemID <- insert $ InboxItem True now
-                insert_ $ InboxItemRemote inboxID grantID itemID
+                insert_ $ InboxItemRemote inboxID inviteID itemID
-            done "Inserted Grant to inbox"
+            done "Inserted Invite to inbox"
         -- Meaning: A remote actor has forwarded to me a remote activity
         -- Behavior: Insert it to my inbox
         EventRemoteFwdLocalActivity authorByKey outboxItemID -> withDBExcept $ do
@@ -275,15 +463,13 @@ personBehavior now personID (Right (VerseRemote author body mfwd luActivity)) =
                 AP.CreateNote _ note ->
                     personCreateNote now personID author body mfwd luActivity note
                 _ -> throwE "Unsupported create object type for people"
-        {-
         AP.FollowActivity follow ->
-            personFollowA now personID author body mfwd luActivity follow
+            personFollow now personID author body mfwd luActivity follow
-        -}
         AP.GrantActivity grant ->
             personGrant now personID author body mfwd luActivity grant
-        {-
         AP.InviteActivity invite ->
-            personInviteA now personID author body mfwd luActivity invite
+            personInvite now personID author body mfwd luActivity invite
+        {-
         AP.UndoActivity undo ->
             (,Nothing) <$> personUndoA now personID author body mfwd luActivity undo
         -}

src/Vervis/Data/Collab.hs

@@ -57,6 +57,7 @@ import Control.Monad.Trans.Except.Local
 
 import Vervis.Access
 import Vervis.Actor
+import Vervis.Actor2
 import Vervis.Data.Actor
 import Vervis.FedURI
 import Vervis.Foundation
@@ -98,15 +99,18 @@ verifyRole (Left AP.RoleAdmin) = pure ()
 verifyRole (Right _) =
     throwE "ForgeFed Admin is the only role allowed currently"
 
+parseTopic
+    :: StageRoute Env ~ Route App
+    => FedURI -> ActE (Either (GrantResourceBy Key) FedURI)
 parseTopic u = do
-    routeOrRemote <- parseFedURIOld u
+    routeOrRemote <- parseFedURI u
     bitraverse
         (\ route -> do
             resourceHash <-
                 fromMaybeE
                     (parseGrantResource route)
                     "Not a shared resource route"
-            unhashGrantResourceE
+            unhashGrantResourceE'
                 resourceHash
                 "Contains invalid hashid"
         )
@@ -114,9 +118,10 @@ parseTopic u = do
         routeOrRemote
 
 parseInvite
-    :: Either PersonId FedURI
+    :: StageRoute Env ~ Route App
+    => Either PersonId FedURI
     -> AP.Invite URIMode
-    -> ExceptT Text Handler
+    -> ActE
         ( Either (GrantResourceBy Key) FedURI
         , Either (GrantRecipBy Key) FedURI
         )
@@ -126,7 +131,7 @@ parseInvite sender (AP.Invite instrument object target) = do
         <*> nameExceptT "Invite object" (parseRecipient object)
     where
     parseRecipient u = do
-        routeOrRemote <- parseFedURIOld u
+        routeOrRemote <- parseFedURI u
         bitraverse
             (\ route -> do
                 recipHash <-
@@ -134,7 +139,7 @@ parseInvite sender (AP.Invite instrument object target) = do
                         (parseGrantRecip route)
                         "Not a grant recipient route"
                 recipKey <-
-                    unhashGrantRecipEOld
+                    unhashGrantRecipE
                         recipHash
                         "Contains invalid hashid"
                 case recipKey of
@@ -150,8 +155,8 @@ parseInvite sender (AP.Invite instrument object target) = do
             routeOrRemote
 
 parseJoin
-    :: AP.Join URIMode
+    :: StageRoute Env ~ Route App
-    -> ExceptT Text Handler (Either (GrantResourceBy Key) FedURI)
+    => AP.Join URIMode -> ActE (Either (GrantResourceBy Key) FedURI)
 parseJoin (AP.Join instrument object) = do
     verifyRole instrument
     nameExceptT "Join object" (parseTopic object)

src/Vervis/Federation/Collab.hs

@@ -100,7 +100,8 @@ topicInviteF
     -> AP.Invite URIMode
     -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
 topicInviteF now recipByHash author body mfwd luInvite invite = do
-
+    error "Temporarily disabled due to switch to new actor system"
+{-
     -- Check input
     uCap <- do
         let muCap = AP.activityCapability $ actbActivity body
@@ -227,6 +228,7 @@ topicInviteF now recipByHash author body mfwd luInvite invite = do
                 insert_ $ CollabRecipLocal collabID personID
             Right remoteActorID ->
                 insert_ $ CollabRecipRemote collabID remoteActorID
+-}
 
 topicJoinF
     :: (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic)
@@ -241,7 +243,8 @@ topicJoinF
     -> AP.Join URIMode
     -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
 topicJoinF topicActor topicResource now recipHash author body mfwd luJoin join = (,Nothing) <$> do
-
+    error "Temporarily disabled due to switch to new actor system"
+{-
     -- Check input
     recipKey <- decodeKeyHashid404 recipHash
     verifyNothingE
@@ -306,6 +309,7 @@ topicJoinF topicActor topicResource now recipHash author body mfwd luJoin join =
         let authorID = remoteAuthorId author
         recipID <- insert $ CollabRecipRemote collabID authorID
         insert_ $ CollabRecipRemoteJoin recipID fulfillsID joinID
+-}
 
 repoJoinF
     :: UTCTime

src/Vervis/Federation/Offer.hs

@@ -20,12 +20,12 @@ module Vervis.Federation.Offer
 
     --, sharerRejectF
 
-      personFollowF
+      --personFollowF
-    , deckFollowF
+    --, deckFollowF
-    , loomFollowF
+    --, loomFollowF
-    , repoFollowF
+    --, repoFollowF
 
-    , personUndoF
+      personUndoF
     , deckUndoF
     , loomUndoF
     , repoUndoF
@@ -301,137 +301,6 @@ sharerRejectF recipHash now author body mfwd luReject (Reject (ObjURI hOffer luO
         lift $ delete frrid
 -}
 
-followF
-    :: (PersistRecordBackend r SqlBackend, ToBackendKey SqlBackend r)
-    => (Route App -> ExceptT Text Handler a)
-    -> (r -> ActorId)
-    -> Bool
-    -> (Key r -> Actor -> a -> ExceptT Text AppDB FollowerSetId)
-    -> (a -> AppDB RecipientRoutes)
-    -> (forall f. f r -> LocalActorBy f)
-    -> (a -> Handler [Aud URIMode])
-    -> UTCTime
-    -> KeyHashid r
-    -> RemoteAuthor
-    -> ActivityBody
-    -> Maybe (RecipientRoutes, ByteString)
-    -> LocalURI
-    -> AP.Follow URIMode
-    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
-followF parseFollowee grabActor unread getFollowee getSieve makeLocalActor makeAudience now recipHash author body mfwd luFollow (AP.Follow uObject _ hide) = (,Nothing) <$> do
-
-    -- Check input
-    recipID <- decodeKeyHashid404 recipHash
-    followee <- nameExceptT "Follow object" $ do
-        route <- do
-            routeOrRemote <- parseFedURIOld uObject
-            case routeOrRemote of
-                Left route -> pure route
-                Right _ -> throwE "Remote, so definitely not me/mine"
-        parseFollowee route
-    verifyNothingE
-        (AP.activityCapability $ actbActivity body)
-        "Capability not needed"
-
-    maybeHttp <- runDBExcept $ do
-
-        -- Find recipient actor in DB, returning 404 if doesn't exist because
-        -- we're in the actor's inbox post handler
-        recip <- lift $ get404 recipID
-        let recipActorID = grabActor recip
-        recipActor <- lift $ getJust recipActorID
-
-        -- Insert the Follow to actor's inbox
-        mractid <- lift $ insertToInbox now author body (actorInbox recipActor) luFollow unread
-        for mractid $ \ followID -> do
-
-            -- Find followee in DB
-            followerSetID <- getFollowee recipID recipActor followee
-
-            -- Verify not already following us
-            let followerID = remoteAuthorId author
-            maybeFollow <-
-                lift $ getBy $ UniqueRemoteFollow followerID followerSetID
-            verifyNothingE maybeFollow "You're already following this object"
-
-            -- Forward the Follow activity to relevant local stages, and
-            -- schedule delivery for unavailable remote members of them
-            maybeHttpFwdFollow <- lift $ for mfwd $ \ (localRecips, sig) -> do
-                sieve <- getSieve followee
-                forwardActivityDB
-                    (actbBL body) localRecips sig recipActorID
-                    (makeLocalActor recipHash) sieve followID
-
-            -- Record the new follow in DB
-            acceptID <-
-                lift $ insertEmptyOutboxItem (actorOutbox recipActor) now
-            lift $ insert_ $ RemoteFollow followerID followerSetID (not hide) followID acceptID
-
-            -- Prepare an Accept activity and insert to actor's outbox
-            (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
-                lift $ prepareAccept followee
-            _luAccept <- lift $ updateOutboxItem (makeLocalActor recipID) acceptID actionAccept
-
-            -- Deliver the Accept to local recipients, and schedule delivery
-            -- for unavailable remote recipients
-            deliverHttpAccept <-
-                deliverActivityDB
-                    (makeLocalActor recipHash) recipActorID
-                    localRecipsAccept remoteRecipsAccept fwdHostsAccept
-                    acceptID actionAccept
-
-            -- Return instructions for HTTP inbox-forwarding of the Follow
-            -- activity, and for HTTP delivery of the Accept activity to
-            -- remote recipients
-            return (maybeHttpFwdFollow, deliverHttpAccept)
-
-    -- Launch asynchronous HTTP forwarding of the Follow activity and HTTP
-    -- delivery of the Accept activity
-    case maybeHttp of
-        Nothing ->
-            return "I already have this activity in my inbox, doing nothing"
-        Just (maybeHttpFwdFollow, deliverHttpAccept) -> do
-            for_ maybeHttpFwdFollow $ forkWorker "followF inbox-forwarding"
-            forkWorker "followF Accept HTTP delivery" deliverHttpAccept
-            return $
-                case maybeHttpFwdFollow of
-                    Nothing -> "Recorded follow, no inbox-forwarding to do"
-                    Just _ ->
-                        "Recorded follow and ran inbox-forwarding of the Follow"
-
-    where
-
-    prepareAccept followee = do
-        encodeRouteHome <- getEncodeRouteHome
-
-        ra <- getJust $ remoteAuthorId author
-
-        let ObjURI hAuthor luAuthor = remoteAuthorURI author
-
-            audSender =
-                AudRemote hAuthor
-                    [luAuthor]
-                    (maybeToList $ remoteActorFollowers ra)
-
-        audsRecip <- lift $ makeAudience followee
-
-        let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
-                collectAudience $ audSender : audsRecip
-
-            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   = ObjURI hAuthor luFollow
-                    , AP.acceptResult   = Nothing
-                    }
-                }
-
-        return (action, recipientSet, remoteActors, fwdHosts)
-
 {-
 followF
     :: (Route App -> Maybe a)
@@ -559,6 +428,7 @@ followF
         return (obiid, doc)
 -}
 
+{-
 personFollowF
     :: UTCTime
     -> KeyHashid Person
@@ -678,6 +548,7 @@ repoFollowF now recipRepoHash =
         (\ () -> pure [])
         now
         recipRepoHash
+-}
 
 personUndoF
     :: UTCTime

src/Vervis/Persist/Actor.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2022 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2022, 2023 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -21,6 +21,7 @@ module Vervis.Persist.Actor
     , getRemoteActorURI
     , insertActor
     , updateOutboxItem
+    , updateOutboxItem'
     , fillPerActorKeys
     , getPersonWidgetInfo
     )
@@ -42,6 +43,7 @@ import Database.Persist.Sql
 import qualified Data.Text as T
 import qualified Database.Esqueleto as E
 
+import Control.Concurrent.Actor
 import Crypto.ActorKey
 import Database.Persist.JSON
 import Network.FedURI
@@ -51,10 +53,13 @@ import Yesod.Hashids
 import Yesod.MonadSite
 
 import qualified Web.ActivityPub as AP
+import qualified Web.Actor as WA
+import qualified Web.Actor.Persist as WAP
 
 import Control.Monad.Trans.Except.Local
 import Database.Persist.Local
 
+import Vervis.Actor2 ()
 import Vervis.Data.Actor
 import Vervis.FedURI
 import Vervis.Foundation
@@ -62,6 +67,8 @@ import Vervis.Model
 import Vervis.Recipient
 import Vervis.Settings
 
+import qualified Vervis.Actor as VA
+
 getLocalActor
     :: MonadIO m => ActorId -> ReaderT SqlBackend m (LocalActorBy Key)
 getLocalActor = fmap (bmap entityKey) . getLocalActorEnt
@@ -154,6 +161,23 @@ updateOutboxItem actorByKey itemID action = do
     update itemID [OutboxItemActivity =. persistJSONObjectFromDoc doc]
     return luId
 
+updateOutboxItem'
+    :: WA.StageRoute VA.Env ~ Route App
+    => LocalActorBy Key
+    -> OutboxItemId
+    -> AP.Action URIMode
+    -> VA.ActDB LocalURI
+updateOutboxItem' actorByKey itemID action = do
+    encodeRouteLocal <- WA.getEncodeRouteLocal
+    hLocal <- asksEnv WA.stageInstanceHost
+    actorByHash <- VA.hashLocalActor actorByKey
+    itemHash <- WAP.encodeKeyHashid itemID
+    let luId = encodeRouteLocal $ activityRoute actorByHash itemHash
+        luActor = encodeRouteLocal $ renderLocalActor actorByHash
+        doc = AP.Doc hLocal $ AP.makeActivity luId luActor action
+    update itemID [OutboxItemActivity =. persistJSONObjectFromDoc doc]
+    return luId
+
 fillPerActorKeys :: Worker ()
 fillPerActorKeys = do
     perActor <- asksSite $ appPerActorKeys . appSettings