diff --git a/src/Vervis/Actor/Project.hs b/src/Vervis/Actor/Project.hs index ec1205d..eedaf25 100644 --- a/src/Vervis/Actor/Project.hs +++ b/src/Vervis/Actor/Project.hs @@ -94,6 +94,24 @@ import Vervis.Web.Collab -- * Otherwise, i.e. sender isn't the component: -- * Verify I've seen the component-Accept for this Add -- * Verify the new Accept is authorized +-- +-- * Give me a new child active SourceOriginUs +-- * Verify we haven't yet seen child's Accept +-- * Give me a new child passive SourceOriginThem +-- * Option 1: We haven't seen child's Accept yet +-- * Verify sender is the child +-- * Option 2: We saw it, but not my collaborator's Accept +-- * Verify the Accept is authorized +-- * Otherwise respond with error, no Accept is needed +-- * Give me a new parent active DestOriginUs +-- * Respond with error, we aren't supposed to get any Accept +-- * Give me a new parent passive DestOriginThem +-- * Option 1: I haven't yet seen parent's Accept +-- * Verify sender is the parent +-- * Option 2: I saw it, but not my collaborator's Accept +-- * Verify the accept is authorized +-- * Otherwise respond with error, no Accept is needed +-- -- * If it's none of these, respond with error -- -- * In collab mode, verify the Collab isn't enabled yet @@ -112,9 +130,22 @@ import Vervis.Web.Collab -- * Otherwise, i.e. sender isn't the component, record the Accept and -- enable the Component in DB -- +-- * In child-active mode, +-- * If sender is the child, record the Accept into the Source record +-- * Prepare to send degelator-Grant +-- * Otherwise nothing to do +-- * In child-passive mode, +-- * Option 1: Record child's Accept in Source record +-- * Option 2: Record my collaborator's Accept +-- * Prepare to send delegator-Grant +-- * In parent-passive mode, +-- * Option 1: Record parent's Accept in the Dest record +-- * Option 2: Record my collaborator's Accept in the Dest record +-- * Prepare to send my own Accept +-- -- * Forward the Accept to my followers -- --- * Possibly send a Grant: +-- * Possibly send a Grant/Accept: -- * For Invite-collab mode: -- * Regular collaborator-Grant -- * To: Accepter (i.e. Invite target) @@ -138,6 +169,32 @@ import Vervis.Web.Collab -- - Component's followers -- - My followers -- - The Accept's sender +-- +-- * Child-active +-- * If sender is the child +-- * delegator-Grant +-- * To: Child +-- * CC: +-- - Child's followers +-- - My followers +-- * Child-passive +-- * In option 2 +-- * delegator-Grant +-- * To: Child +-- * CC: +-- - Child's followers +-- - My followers +-- - The Accept sender (my collaborator) +-- * Parent-passive +-- * In option 2 +-- * Accept +-- * Object: The Add +-- * Fulfills: My collaborator's Accept +-- * To: Parent +-- * CC: +-- - Parent's followers +-- - My followers +-- - The Accept sender (my collaborator) projectAccept :: UTCTime -> ProjectId @@ -148,22 +205,9 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do -- Check input acceptee <- parseAccept accept + let muCap = AP.activityCapability $ actbActivity body - -- Verify that the capability URI, if specified, 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 + collabOrComp <- withDBExcept $ do -- Find the accepted activity in our DB accepteeDB <- do @@ -174,104 +218,103 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do -- URI is the resource, grabbing the Collab record from our DB, -- Or if the accepted activity is an Invite or Add where my components -- URI is the resource, grabbing the Component record from our DB - collabOrComp <- do - let adapt = maybe (Right Nothing) (either Left (Right . Just)) - maybeCollab <- - ExceptT $ fmap adapt $ runMaybeT $ - runExceptT (Left <$> tryInviteCollab accepteeDB) <|> - runExceptT (Left <$> tryJoinCollab accepteeDB) <|> - runExceptT (Right <$> tryInviteComp accepteeDB) <|> - runExceptT (Right <$> tryAddComp accepteeDB) - fromMaybeE - maybeCollab - "Accepted activity isn't an Invite/Join/Add I'm aware of" + let adapt = maybe (Right Nothing) (either Left (Right . Just)) + maybeCollab <- + ExceptT $ fmap adapt $ runMaybeT $ + runExceptT (Left <$> tryInviteCollab accepteeDB) <|> + runExceptT (Left <$> tryJoinCollab accepteeDB) <|> + runExceptT (Right <$> tryInviteComp accepteeDB) <|> + runExceptT (Right <$> tryAddComp accepteeDB) + fromMaybeE + maybeCollab + "Accepted activity isn't an Invite/Join/Add I'm aware of" - idsForAccept <- bitraverse + idsForAccept <- bitraverse - (\ (collabID, fulfills, inviterOrJoiner) -> (collabID,inviterOrJoiner,) <$> bitraverse + (\ (collabID, fulfills, inviterOrJoiner) -> (collabID,inviterOrJoiner,) <$> bitraverse - -- If accepting an Invite, find the Collab recipient and verify - -- it's the sender of the Accept - (\ fulfillsID -> 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 - (\ fulfillsID -> 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 - (LocalActorProject projectID) - AP.RoleAdmin - return fulfillsID - ) - - fulfills + -- If accepting an Invite, find the Collab recipient and verify + -- it's the sender of the Accept + (\ fulfillsID -> withDBExcept $ 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" ) - (\ (componentID, ident, inviteOrAdd) -> (componentID, ident,) <$> bitraverse - - -- If accepting an Invite-component, there's nothing to check - -- at this point - pure - - -- If accepting an Add-component: - -- * If the sender is the component, verify I haven't seen - -- a component-Accept on this Add - -- * Otherwise, verify I've seen the component-Accept for - -- this Add and that the new Accept is authorized - (\ () -> do - maybeComponentAccept <- - lift $ - case bimap fst fst ident of - Left localID -> (() <$) <$> getBy (UniqueComponentAcceptLocal localID) - Right remoteID -> (() <$) <$> getBy (UniqueComponentAcceptRemote remoteID) - if componentIsAuthor ident - then - verifyNothingE - maybeComponentAccept - "I've already seen a ComponentAccept* on \ - \that Add" - else do - fromMaybeE - maybeComponentAccept - "I haven't yet seen the Component's Accept on \ - \the Add" - 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 me" - verifyCapability' - capability - authorIdMsig - (LocalActorProject projectID) - AP.RoleAdmin - ) - - inviteOrAdd + -- If accepting a Join, verify accepter has permission + (\ fulfillsID -> do + uCap <- fromMaybeE muCap "No capability provided" + verifyCapability'' + uCap + authorIdMsig + (LocalActorProject projectID) + AP.RoleAdmin + return fulfillsID ) - collabOrComp + fulfills + ) + + (\ (componentID, ident, inviteOrAdd) -> (componentID, ident,) <$> bitraverse + + -- If accepting an Invite-component, there's nothing to check + -- at this point + pure + + -- If accepting an Add-component: + -- * If the sender is the component, verify I haven't seen + -- a component-Accept on this Add + -- * Otherwise, verify I've seen the component-Accept for + -- this Add and that the new Accept is authorized + (\ () -> do + maybeComponentAccept <- + lift $ withDB $ + case bimap fst fst ident of + Left localID -> (() <$) <$> getBy (UniqueComponentAcceptLocal localID) + Right remoteID -> (() <$) <$> getBy (UniqueComponentAcceptRemote remoteID) + if componentIsAuthor ident + then + verifyNothingE + maybeComponentAccept + "I've already seen a ComponentAccept* on \ + \that Add" + else do + fromMaybeE + maybeComponentAccept + "I haven't yet seen the Component's Accept on \ + \the Add" + uCap <- fromMaybeE muCap "No capability provided" + verifyCapability'' + uCap + authorIdMsig + (LocalActorProject projectID) + AP.RoleAdmin + ) + + inviteOrAdd + ) + + collabOrComp + + maybeNew <- withDBExcept $ do + + -- Grab me from DB + (recipActorID, recipActor) <- lift $ do + recip <- getJust projectID + let actorID = projectActor recip + (actorID,) <$> getJust actorID -- In collab mode, verify the Collab isn't already validated -- In component mode, verify the Component isn't already validated