mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-27 04:04:52 +09:00
Person: Port Invite and Follow handlers to new system
This commit is contained in:
Pere Lev
parent
cc135692c0
commit
4d8e5de8b8
8 changed files with 302 additions and 191 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -293,13 +293,19 @@ data VerseRemote = VerseRemote
|
|||
}
|
||||
|
||||
data Event
|
||||
= EventRemoteGrantLocalRecipFwdToFollower RemoteActivityId
|
||||
-- ^ A local actor has received a Grant (they're being granted some access)
|
||||
= EventRemoteInviteLocalRecipFwdToFollower RemoteActivityId
|
||||
-- ^ 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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
-- If recipient is local, find it in our DB
|
||||
_recipientDB <-
|
||||
bitraverse
|
||||
(flip getGrantRecip "Grant local target not found in DB")
|
||||
pure
|
||||
recipient
|
||||
|
||||
for mractid $ \ grantID ->
|
||||
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
|
||||
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"
|
||||
else done "I'm the target; Inserted to inbox"
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- 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
|
||||
done "Inserted Grant to inbox"
|
||||
insert_ $ InboxItemRemote inboxID inviteID itemID
|
||||
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
|
||||
-}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
-> ExceptT Text Handler (Either (GrantResourceBy Key) FedURI)
|
||||
:: StageRoute Env ~ Route App
|
||||
=> AP.Join URIMode -> ActE (Either (GrantResourceBy Key) FedURI)
|
||||
parseJoin (AP.Join instrument object) = do
|
||||
verifyRole instrument
|
||||
nameExceptT "Join object" (parseTopic object)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -20,12 +20,12 @@ module Vervis.Federation.Offer
|
|||
|
||||
--, sharerRejectF
|
||||
|
||||
personFollowF
|
||||
, deckFollowF
|
||||
, loomFollowF
|
||||
, repoFollowF
|
||||
--personFollowF
|
||||
--, deckFollowF
|
||||
--, loomFollowF
|
||||
--, 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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue