S2S: Copy topicAccept code into projectAccept and reorganize the comment
This is in preparation to implementing Component mode
This commit is contained in:
Pere Lev
parent
afb83b7761
commit
2920deb900
2 changed files with 290 additions and 21 deletions
|
|
@ -31,6 +31,7 @@ import Data.Barbie
|
|||
import Data.Bifunctor
|
||||
import Data.Bitraversable
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Either
|
||||
import Data.Foldable
|
||||
import Data.Maybe
|
||||
import Data.Text (Text)
|
||||
|
|
@ -53,6 +54,7 @@ import Yesod.MonadSite
|
|||
import qualified Web.ActivityPub as AP
|
||||
|
||||
import Control.Monad.Trans.Except.Local
|
||||
import Data.Either.Local
|
||||
import Database.Persist.Local
|
||||
|
||||
import Vervis.Access
|
||||
|
|
@ -68,7 +70,7 @@ import Vervis.FedURI
|
|||
import Vervis.Federation.Util
|
||||
import Vervis.Foundation
|
||||
import Vervis.Model hiding (projectCreate)
|
||||
import Vervis.Recipient (makeRecipientSet, LocalStageBy (..), Aud (..), collectAudience, localActorFollowers)
|
||||
import Vervis.Recipient (makeRecipientSet, LocalStageBy (..), Aud (..), collectAudience, localActorFollowers, renderLocalActor)
|
||||
import Vervis.RemoteActorStore
|
||||
import Vervis.Persist.Actor
|
||||
import Vervis.Persist.Collab
|
||||
|
|
@ -77,26 +79,298 @@ import Vervis.Ticket
|
|||
|
||||
-- Meaning: An actor accepted something
|
||||
-- Behavior:
|
||||
-- * If it's on an Invite where I'm the resource:
|
||||
-- * Check if I know the activity that's being Accepted:
|
||||
-- * Is it an Invite to be a collaborator in me?
|
||||
-- * Verify the Accept is by the Invite target
|
||||
-- * If it's on a Join to be a collaborator in me?
|
||||
-- * Verify the Accept is authorized
|
||||
-- * If it's none of these, respond with error
|
||||
-- * Verify the Collab isn't enabled yet
|
||||
-- * Insert the Accept to my inbox
|
||||
-- * Record the Accept and enable the Collab in DB
|
||||
-- * Forward the Accept to my followers
|
||||
-- * Send a Grant:
|
||||
-- * Send a regular collaborator-Grant:
|
||||
-- * For Invite mode:
|
||||
-- * To: Accepter (i.e. Invite target)
|
||||
-- * CC: Invite sender, Accepter's followers, my followers
|
||||
-- * If it's on a Join where I'm the resource:
|
||||
-- * Verify the Accept is authorized
|
||||
-- * Forward the Accept to my followers
|
||||
-- * Send a Grant:
|
||||
-- * For Join mode:
|
||||
-- * To: Join sender
|
||||
-- * CC: Accept sender, Join sender's followers, my followers
|
||||
-- * Otherwise respond with error
|
||||
--
|
||||
--
|
||||
--
|
||||
-- Stuff I'm about to implement for Component mode:
|
||||
--
|
||||
--
|
||||
-- * If it's on an Invite to be a component of me:
|
||||
-- * Verify the Component isn't enabled yet (same as checking if I've
|
||||
-- recorded the component's Accept)
|
||||
-- * If the sender isn't the component, just forward the Accept to my
|
||||
-- followers and done
|
||||
-- * If the sender is the component:
|
||||
-- * Enable the Component in DB
|
||||
-- * Forward the Accept to my followers
|
||||
-- * Send a delegator Grant to the component
|
||||
-- * To: Component
|
||||
-- * CC:
|
||||
-- - Component's followers
|
||||
-- - My followers
|
||||
--
|
||||
--
|
||||
-- * If it's on an Add to be a component of me:
|
||||
-- * Verify the Component isn't enabled yet (same as checking if I've
|
||||
-- recorded an Accept from a collaborator of mine)
|
||||
-- * If the sender is the component:
|
||||
-- * Verify I haven't seen a component-Accept on this Add
|
||||
-- * Record the Accept into the Component record in DB
|
||||
-- * Forward the Accept to my followers
|
||||
-- * Otherwise, i.e. sender isn't the component:
|
||||
-- * Verify I've seen the component-Accept for this Add
|
||||
-- * Verify the Accept is authorized
|
||||
-- * Record the Accept and enable the Component in DB
|
||||
-- * Forward the Accept to my followers
|
||||
-- * Send a delegator Grant to the component
|
||||
-- * To: Component
|
||||
-- * CC:
|
||||
-- - Component's followers
|
||||
-- - My followers
|
||||
-- - The Accept's sender
|
||||
projectAccept
|
||||
:: UTCTime
|
||||
-> ProjectId
|
||||
-> Verse
|
||||
-> AP.Accept URIMode
|
||||
-> ActE (Text, Act (), Next)
|
||||
projectAccept = topicAccept projectActor GrantResourceProject
|
||||
projectAccept now projectID (Verse authorIdMsig body) accept = do
|
||||
|
||||
-- Check input
|
||||
acceptee <- parseAccept accept
|
||||
|
||||
-- Verify the capability URI is one of:
|
||||
-- * Outbox item URI of a local actor, i.e. a local activity
|
||||
-- * A remote URI
|
||||
maybeCap <-
|
||||
traverse
|
||||
(nameExceptT "Accept capability" . parseActivityURI')
|
||||
(AP.activityCapability $ actbActivity body)
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
-- Grab me from DB
|
||||
(recipActorID, recipActor) <- lift $ do
|
||||
recip <- getJust projectID
|
||||
let actorID = projectActor recip
|
||||
(actorID,) <$> getJust actorID
|
||||
|
||||
-- Find the accepted activity in our DB
|
||||
accepteeDB <- do
|
||||
a <- getActivity acceptee
|
||||
fromMaybeE a "Can't find acceptee in DB"
|
||||
|
||||
-- See if the accepted activity is an Invite or Join to a local
|
||||
-- resource, grabbing the Collab record from our DB
|
||||
collab <- do
|
||||
maybeCollab <-
|
||||
lift $ runMaybeT $
|
||||
Left <$> tryInvite accepteeDB <|>
|
||||
Right <$> tryJoin accepteeDB
|
||||
fromMaybeE maybeCollab "Accepted activity isn't an Invite or Join I'm aware of"
|
||||
|
||||
-- Find the local resource and verify it's me
|
||||
collabID <-
|
||||
lift $ case collab of
|
||||
Left (fulfillsID, _) ->
|
||||
collabFulfillsInviteCollab <$> getJust fulfillsID
|
||||
Right (fulfillsID, _) ->
|
||||
collabFulfillsJoinCollab <$> getJust fulfillsID
|
||||
topic <- lift $ getCollabTopic collabID
|
||||
unless (GrantResourceProject projectID == topic) $
|
||||
throwE "Accept object is an Invite/Join for some other resource"
|
||||
|
||||
idsForAccept <-
|
||||
case collab of
|
||||
|
||||
-- If accepting an Invite, find the Collab recipient and verify
|
||||
-- it's the sender of the Accept
|
||||
Left (fulfillsID, _) -> Left <$> do
|
||||
recip <-
|
||||
lift $
|
||||
requireEitherAlt
|
||||
(getBy $ UniqueCollabRecipLocal collabID)
|
||||
(getBy $ UniqueCollabRecipRemote collabID)
|
||||
"Found Collab with no recip"
|
||||
"Found Collab with multiple recips"
|
||||
case (recip, authorIdMsig) of
|
||||
(Left (Entity crlid crl), Left (LocalActorPerson personID, _, _))
|
||||
| collabRecipLocalPerson crl == personID ->
|
||||
return (fulfillsID, Left crlid)
|
||||
(Right (Entity crrid crr), Right (author, _, _))
|
||||
| collabRecipRemoteActor crr == remoteAuthorId author ->
|
||||
return (fulfillsID, Right crrid)
|
||||
_ -> throwE "Accepting an Invite whose recipient is someone else"
|
||||
|
||||
-- If accepting a Join, verify accepter has permission
|
||||
Right (fulfillsID, _) -> Right <$> do
|
||||
capID <- fromMaybeE maybeCap "No capability provided"
|
||||
capability <-
|
||||
case capID of
|
||||
Left (capActor, _, capItem) -> return (capActor, capItem)
|
||||
Right _ -> throwE "Capability is a remote URI, i.e. not authored by the local resource"
|
||||
verifyCapability'
|
||||
capability
|
||||
authorIdMsig
|
||||
(GrantResourceProject projectID)
|
||||
AP.RoleAdmin
|
||||
return fulfillsID
|
||||
|
||||
-- Verify the Collab isn't already validated
|
||||
maybeEnabled <- lift $ getBy $ UniqueCollabEnable collabID
|
||||
verifyNothingE maybeEnabled "I already sent a Grant for this Invite/Join"
|
||||
|
||||
maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
|
||||
for maybeAcceptDB $ \ acceptDB -> do
|
||||
|
||||
-- Record the Accept on the Collab
|
||||
case (idsForAccept, acceptDB) of
|
||||
(Left (fulfillsID, Left recipID), Left (_, _, acceptID)) -> do
|
||||
maybeAccept <- lift $ insertUnique $ CollabRecipLocalAccept recipID fulfillsID acceptID
|
||||
unless (isNothing maybeAccept) $
|
||||
throwE "This Invite already has an Accept by recip"
|
||||
(Left (fulfillsID, Right recipID), Right (_, _, acceptID)) -> do
|
||||
maybeAccept <- lift $ insertUnique $ CollabRecipRemoteAccept recipID fulfillsID acceptID
|
||||
unless (isJust maybeAccept) $
|
||||
throwE "This Invite already has an Accept by recip"
|
||||
(Right fulfillsID, Left (_, _, acceptID)) -> do
|
||||
maybeAccept <- lift $ insertUnique $ CollabApproverLocal fulfillsID acceptID
|
||||
unless (isJust maybeAccept) $
|
||||
throwE "This Join already has an Accept"
|
||||
(Right fulfillsID, Right (author, _, acceptID)) -> do
|
||||
maybeAccept <- lift $ insertUnique $ CollabApproverRemote fulfillsID (remoteAuthorId author) acceptID
|
||||
unless (isJust maybeAccept) $
|
||||
throwE "This Join already has an Accept"
|
||||
_ -> error "topicAccept impossible"
|
||||
|
||||
-- Prepare forwarding of Accept to my followers
|
||||
let recipByID = grantResourceLocalActor $ GrantResourceProject projectID
|
||||
recipByHash <- hashLocalActor recipByID
|
||||
let sieve = makeRecipientSet [] [localActorFollowers recipByHash]
|
||||
|
||||
grantInfo <- do
|
||||
|
||||
-- Enable the Collab in our DB
|
||||
grantID <- lift $ insertEmptyOutboxItem' (actorOutbox recipActor) now
|
||||
lift $ insert_ $ CollabEnable collabID grantID
|
||||
|
||||
-- Prepare a Grant activity and insert to my outbox
|
||||
let inviterOrJoiner = either snd snd collab
|
||||
isInvite = isLeft collab
|
||||
grant@(actionGrant, _, _, _) <- do
|
||||
Collab role <- lift $ getJust collabID
|
||||
lift $ prepareGrant isInvite inviterOrJoiner role
|
||||
let recipByKey = grantResourceLocalActor $ GrantResourceProject projectID
|
||||
_luGrant <- lift $ updateOutboxItem' recipByKey grantID actionGrant
|
||||
return (grantID, grant)
|
||||
|
||||
return (recipActorID, sieve, grantInfo)
|
||||
|
||||
case maybeNew of
|
||||
Nothing -> done "I already have this activity in my inbox"
|
||||
Just (recipActorID, sieve, (grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant))) -> do
|
||||
let recipByID = grantResourceLocalActor $ GrantResourceProject projectID
|
||||
forwardActivity authorIdMsig body recipByID recipActorID sieve
|
||||
lift $ sendActivity
|
||||
recipByID recipActorID localRecipsGrant
|
||||
remoteRecipsGrant fwdHostsGrant grantID actionGrant
|
||||
done "Forwarded the Accept and published a Grant"
|
||||
|
||||
where
|
||||
|
||||
tryInvite (Left (actorByKey, _actorEntity, itemID)) =
|
||||
(,Left actorByKey) . collabInviterLocalCollab <$>
|
||||
MaybeT (getValBy $ UniqueCollabInviterLocalInvite itemID)
|
||||
tryInvite (Right remoteActivityID) = do
|
||||
CollabInviterRemote collab actorID _ <-
|
||||
MaybeT $ getValBy $
|
||||
UniqueCollabInviterRemoteInvite remoteActivityID
|
||||
actor <- lift $ getJust actorID
|
||||
sender <-
|
||||
lift $ (,remoteActorFollowers actor) <$> getRemoteActorURI actor
|
||||
return (collab, Right sender)
|
||||
|
||||
tryJoin (Left (actorByKey, _actorEntity, itemID)) =
|
||||
(,Left actorByKey) . collabRecipLocalJoinFulfills <$>
|
||||
MaybeT (getValBy $ UniqueCollabRecipLocalJoinJoin itemID)
|
||||
tryJoin (Right remoteActivityID) = do
|
||||
CollabRecipRemoteJoin recipID fulfillsID _ <-
|
||||
MaybeT $ getValBy $
|
||||
UniqueCollabRecipRemoteJoinJoin remoteActivityID
|
||||
remoteActorID <- lift $ collabRecipRemoteActor <$> getJust recipID
|
||||
actor <- lift $ getJust remoteActorID
|
||||
joiner <-
|
||||
lift $ (,remoteActorFollowers actor) <$> getRemoteActorURI actor
|
||||
return (fulfillsID, Right joiner)
|
||||
|
||||
prepareGrant isInvite sender role = do
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
|
||||
audAccepter <- makeAudSenderWithFollowers authorIdMsig
|
||||
audApprover <- lift $ makeAudSenderOnly authorIdMsig
|
||||
recipHash <- encodeKeyHashid projectID
|
||||
let topicByHash = grantResourceLocalActor $ GrantResourceProject recipHash
|
||||
|
||||
senderHash <- bitraverse hashLocalActor pure sender
|
||||
|
||||
uAccepter <- lift $ getActorURI authorIdMsig
|
||||
|
||||
let audience =
|
||||
if isInvite
|
||||
then
|
||||
let audInviter =
|
||||
case senderHash of
|
||||
Left actor -> AudLocal [actor] []
|
||||
Right (ObjURI h lu, _followers) ->
|
||||
AudRemote h [lu] []
|
||||
audTopic = AudLocal [] [localActorFollowers topicByHash]
|
||||
in [audInviter, audAccepter, audTopic]
|
||||
else
|
||||
let audJoiner =
|
||||
case senderHash of
|
||||
Left actor -> AudLocal [actor] [localActorFollowers actor]
|
||||
Right (ObjURI h lu, followers) ->
|
||||
AudRemote h [lu] (maybeToList followers)
|
||||
audTopic = AudLocal [] [localActorFollowers topicByHash]
|
||||
in [audJoiner, audApprover, audTopic]
|
||||
|
||||
(recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
|
||||
collectAudience audience
|
||||
|
||||
recips = map encodeRouteHome audLocal ++ audRemote
|
||||
action = AP.Action
|
||||
{ AP.actionCapability = Nothing
|
||||
, AP.actionSummary = Nothing
|
||||
, AP.actionAudience = AP.Audience recips [] [] [] [] []
|
||||
, AP.actionFulfills = [AP.acceptObject accept]
|
||||
, AP.actionSpecific = AP.GrantActivity AP.Grant
|
||||
{ AP.grantObject = role
|
||||
, AP.grantContext =
|
||||
encodeRouteLocal $ renderLocalActor topicByHash
|
||||
, AP.grantTarget =
|
||||
if isInvite
|
||||
then uAccepter
|
||||
else case senderHash of
|
||||
Left actor ->
|
||||
encodeRouteHome $ renderLocalActor actor
|
||||
Right (ObjURI h lu, _) -> ObjURI h lu
|
||||
, AP.grantResult = Nothing
|
||||
, AP.grantStart = Just now
|
||||
, AP.grantEnd = Nothing
|
||||
, AP.grantAllows = AP.Invoke
|
||||
, AP.grantDelegates = Nothing
|
||||
}
|
||||
}
|
||||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
checkExistingComponents
|
||||
:: ProjectId -> Either (ComponentBy Entity) RemoteActorId -> ActDBE ()
|
||||
|
|
|
|||
|
|
@ -136,19 +136,14 @@ parseTopic
|
|||
:: StageRoute Env ~ Route App
|
||||
=> FedURI -> ActE (Either (GrantResourceBy Key) FedURI)
|
||||
parseTopic u = do
|
||||
routeOrRemote <- parseFedURI u
|
||||
t <- parseTopic' u
|
||||
bitraverse
|
||||
(\ route -> do
|
||||
resourceHash <-
|
||||
fromMaybeE
|
||||
(parseGrantResourceCollabs route)
|
||||
"Not a shared resource collabs route"
|
||||
unhashGrantResourceE'
|
||||
resourceHash
|
||||
"Contains invalid hashid"
|
||||
(\case
|
||||
Left r -> pure r
|
||||
Right _ -> throwE "Local topic is a components route"
|
||||
)
|
||||
pure
|
||||
routeOrRemote
|
||||
t
|
||||
|
||||
parseTopic'
|
||||
:: StageRoute Env ~ Route App
|
||||
|
|
|
|||
Loading…
Reference in a new issue