From b2657589dd0a141cf59d2e7b808971966efc63a0 Mon Sep 17 00:00:00 2001 From: Pere Lev Date: Wed, 28 Jun 2023 00:30:35 +0300 Subject: [PATCH] Switch Invite/Join/Remove to use resource collabs URI Until now, the resource object itself would be specified. This no longer works, because it's unclear whether we're adding/removing a collaborator or a component. From now on, adding a collaborator is done by pointing to the resource's 'collaborators' URI, not to the resource itself --- src/Vervis/Actor/Common.hs | 8 +++---- src/Vervis/Actor/Person/Client.hs | 29 ++++++++++++++++++----- src/Vervis/Client.hs | 39 ++++++++++++++++++++++++------- src/Vervis/Data/Collab.hs | 10 ++++++-- src/Vervis/Foundation.hs | 4 ++++ src/Vervis/Handler/Client.hs | 12 +++++----- src/Vervis/Handler/Deck.hs | 8 +++---- src/Vervis/Handler/Loom.hs | 5 ++++ src/Vervis/Handler/Project.hs | 8 +++---- src/Vervis/Handler/Repo.hs | 5 ++++ th/routes | 4 ++++ 11 files changed, 98 insertions(+), 34 deletions(-) diff --git a/src/Vervis/Actor/Common.hs b/src/Vervis/Actor/Common.hs index d8ea4a0..410c713 100644 --- a/src/Vervis/Actor/Common.hs +++ b/src/Vervis/Actor/Common.hs @@ -707,7 +707,7 @@ topicInvite grabActor topicResource topicField topicCollabField collabTopicCtor let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig (role, resource, recipient) <- parseInvite author invite unless (Left (topicResource topicKey) == resource) $ - throwE "Invite topic isn't me" + throwE "Invite topic isn't my collabs URI" return (role, recipient) -- If target is local, find it in our DB @@ -839,7 +839,7 @@ topicRemove grabActor topicResource topicField topicCollabField now topicKey (Ve -- Verify the capability URI is one of: -- * Outbox item URI of a local actor, i.e. a local activity -- * A remote URI - cap <- nameExceptT "Invite capability" $ parseActivityURI' uCap + cap <- nameExceptT "Remove.capability" $ parseActivityURI' uCap -- Verify the capability is local case cap of @@ -852,7 +852,7 @@ topicRemove grabActor topicResource topicField topicCollabField now topicKey (Ve let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig (resource, member) <- parseRemove author remove unless (Left (topicResource topicKey) == resource) $ - throwE "Remove topic isn't me" + throwE "Remove topic isn't my collabs URI" return member maybeNew <- withDBExcept $ do @@ -1056,7 +1056,7 @@ topicJoin grabActor topicResource topicField topicCollabField collabTopicCtor no -- Check input (role, resource) <- parseJoin join unless (resource == Left (topicResource topicKey)) $ - throwE "Join's object isn't me, don't need this Join" + throwE "Join's object isn't my collabs URI, don't need this Join" maybeNew <- withDBExcept $ do diff --git a/src/Vervis/Actor/Person/Client.hs b/src/Vervis/Actor/Person/Client.hs index 4756a6c..17c4f51 100644 --- a/src/Vervis/Actor/Person/Client.hs +++ b/src/Vervis/Actor/Person/Client.hs @@ -481,12 +481,17 @@ clientInvite now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost (_role, resource, recipient) <- parseInvite (Left $ LocalActorPerson personMeID) invite _capID <- fromMaybeE maybeCap "No capability provided" - -- If resource is remote, HTTP GET it and its managing actor, and insert to - -- our DB. If resource is local, find it in our DB. + -- If resource collabs URI is remote, HTTP GET it and its resource and its + -- managing actor, and insert to our DB. If resource is local, find it in + -- our DB. resourceDB <- bitraverse (withDBExcept . flip getGrantResource "Grant context not found in DB") - (\ u@(ObjURI h lu) -> do + (\ u@(ObjURI h luColl) -> do + manager <- asksEnv envHttpManager + coll <- ExceptT $ liftIO $ first T.pack <$> AP.fetchAPID manager AP.collectionId h luColl + lu <- fromMaybeE (AP.collectionContext (coll :: AP.Collection FedURI URIMode)) "Remote topic collabs has no 'context'" + instanceID <- lift $ withDB $ either entityKey id <$> insertBy' (Instance h) result <- @@ -605,11 +610,23 @@ clientRemove now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost (resource, member) <- parseRemove (Left $ LocalActorPerson personMeID) remove _capID <- fromMaybeE maybeCap "No capability provided" + -- If resource collabs is remote, HTTP GET it to determine resource + resource' <- + bitraverse + pure + (\ (ObjURI h luColl) -> do + manager <- asksEnv envHttpManager + coll <- ExceptT $ liftIO $ first T.pack <$> AP.fetchAPID manager AP.collectionId h luColl + lu <- fromMaybeE (AP.collectionContext (coll :: AP.Collection FedURI URIMode)) "Remote topic collabs has no 'context'" + return $ ObjURI h lu + ) + resource + -- Verify that resource is addressed by the Remove bitraverse_ (verifyResourceAddressed localRecips) (verifyRemoteAddressed remoteRecips) - resource + resource' -- Verify that member is addressed by the Remove bitraverse_ @@ -624,7 +641,7 @@ clientRemove now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost bitraverse (flip getGrantResource "Resource not found in DB") pure - resource + resource' -- If member is local, find it in our DB _memberDB <- @@ -644,7 +661,7 @@ clientRemove now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost -- Prepare local recipients for Remove delivery sieve <- lift $ do - resourceHash <- bitraverse hashGrantResource' pure resource + resourceHash <- bitraverse hashGrantResource' pure resource' recipientHash <- bitraverse hashGrantRecip pure member senderHash <- encodeKeyHashid personMeID let sieveActors = catMaybes diff --git a/src/Vervis/Client.hs b/src/Vervis/Client.hs index df638fa..1cee9a7 100644 --- a/src/Vervis/Client.hs +++ b/src/Vervis/Client.hs @@ -977,17 +977,27 @@ invite -> FedURI -> AP.Role -> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Invite URIMode) -invite personID uRecipient uResource role = do +invite personID uRecipient uResourceCollabs role = do theater <- asksSite appTheater env <- asksSite appEnv - let activity = AP.Invite role uRecipient uResource + let activity = AP.Invite role uRecipient uResourceCollabs (_role, resource, recipient) <- runActE $ parseInvite (Left $ LocalActorPerson personID) activity - -- If resource is remote, we need to get it from DB/HTTP to determine its - -- managing actor & followers collection + -- If resource collabs is remote, we need to get it from DB/HTTP to + -- determine the resourc & its managing actor & followers collection + resource' <- + bitraverse + pure + (\ (ObjURI h luColl) -> do + manager <- asksSite appHttpManager + coll <- ExceptT $ liftIO $ first T.pack <$> AP.fetchAPID manager AP.collectionId h luColl + lu <- fromMaybeE (AP.collectionContext (coll :: AP.Collection FedURI URIMode)) "Remote topic collabs has no 'context'" + return $ ObjURI h lu + ) + resource resourceDB <- bitraverse hashGrantResource @@ -1003,7 +1013,7 @@ invite personID uRecipient uResource role = do Right (_objectID, luManager, (Entity _ actor)) -> return (actor, ObjURI h luManager) ) - resource + resource' -- If target is remote, get it via HTTP/DB to determine its followers -- collection @@ -1060,15 +1070,28 @@ remove -> FedURI -> FedURI -> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Remove URIMode) -remove personID uRecipient uResource = do +remove personID uRecipient uResourceCollabs = do theater <- asksSite appTheater env <- asksSite appEnv - let activity = AP.Remove uRecipient uResource + let activity = AP.Remove uRecipient uResourceCollabs (resource, recipient) <- runActE $ parseRemove (Left $ LocalActorPerson personID) activity + -- If resource collabs is remote, we need to HTTP GET it to determine the + -- resource via collection 'context' + resource' <- + bitraverse + pure + (\ (ObjURI h luColl) -> do + manager <- asksSite appHttpManager + coll <- ExceptT $ liftIO $ first T.pack <$> AP.fetchAPID manager AP.collectionId h luColl + lu <- fromMaybeE (AP.collectionContext (coll :: AP.Collection FedURI URIMode)) "Remote topic collabs has no 'context'" + return $ ObjURI h lu + ) + resource + -- If resource is remote, we need to get it from DB/HTTP to determine its -- managing actor & followers collection resourceDB <- @@ -1086,7 +1109,7 @@ remove personID uRecipient uResource = do Right (_objectID, luManager, (Entity _ actor)) -> return (actor, ObjURI h luManager) ) - resource + resource' -- If target is remote, get it via HTTP/DB to determine its followers -- collection diff --git a/src/Vervis/Data/Collab.hs b/src/Vervis/Data/Collab.hs index 281dd99..d61e63f 100644 --- a/src/Vervis/Data/Collab.hs +++ b/src/Vervis/Data/Collab.hs @@ -92,6 +92,12 @@ parseGrantResource (LoomR l) = Just $ GrantResourceLoom l parseGrantResource (ProjectR l) = Just $ GrantResourceProject l parseGrantResource _ = Nothing +parseGrantResourceCollabs (RepoCollabsR r) = Just $ GrantResourceRepo r +parseGrantResourceCollabs (DeckCollabsR d) = Just $ GrantResourceDeck d +parseGrantResourceCollabs (LoomCollabsR l) = Just $ GrantResourceLoom l +parseGrantResourceCollabs (ProjectCollabsR l) = Just $ GrantResourceProject l +parseGrantResourceCollabs _ = Nothing + data GrantRecipBy f = GrantRecipPerson (f Person) deriving (Generic, FunctorB, TraversableB, ConstraintsB) @@ -133,8 +139,8 @@ parseTopic u = do (\ route -> do resourceHash <- fromMaybeE - (parseGrantResource route) - "Not a shared resource route" + (parseGrantResourceCollabs route) + "Not a shared resource collabs route" unhashGrantResourceE' resourceHash "Contains invalid hashid" diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 2c12b59..4bfd5be 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -911,6 +911,8 @@ instance YesodBreadcrumbs App where RepoStampR r k -> ("Stamp #" <> keyHashidText k, Just $ RepoR r) + RepoCollabsR r -> ("Collaborators", Just $ RepoR r) + DeckR d -> ("Ticket Tracker =" <> keyHashidText d, Just HomeR) DeckInboxR d -> ("Inbox", Just $ DeckR d) DeckOutboxR d -> ("Outbox", Just $ DeckR d) @@ -965,6 +967,8 @@ instance YesodBreadcrumbs App where LoomStampR l k -> ("Stamp #" <> keyHashidText k, Just $ LoomR l) + LoomCollabsR l -> ("Collaborators", Just $ LoomR l) + ClothR l c -> ("#" <> keyHashidText c, Just $ LoomClothsR l) ClothDiscussionR l c -> ("Discussion", Just $ ClothR l c) ClothEventsR l c -> ("Events", Just $ ClothR l c) diff --git a/src/Vervis/Handler/Client.hs b/src/Vervis/Handler/Client.hs index 4ecf218..4b605f4 100644 --- a/src/Vervis/Handler/Client.hs +++ b/src/Vervis/Handler/Client.hs @@ -1185,7 +1185,7 @@ postPublishMergeR = do inviteForm = renderDivs $ (,,,) <$> areq fedUriField "(URI) Whom to invite" Nothing - <*> areq fedUriField "(URI) Resource" Nothing + <*> areq fedUriField "(URI) Resource's collaborators collection" Nothing <*> areq roleField "Role" Nothing <*> areq capField "(URI) Grant activity to use for authorization" Nothing where @@ -1207,14 +1207,14 @@ postPublishInviteR = do federation <- getsYesod $ appFederation . appSettings unless federation badMethod - (uRecipient, uResource, role, (uCap, cap)) <- + (uRecipient, uResourceCollabs, role, (uCap, cap)) <- runFormPostRedirect PublishInviteR inviteForm (ep@(Entity pid _), a) <- getSender senderHash <- encodeKeyHashid pid result <- runExceptT $ do - (maybeSummary, audience, inv) <- invite pid uRecipient uResource role + (maybeSummary, audience, inv) <- invite pid uRecipient uResourceCollabs role (localRecips, remoteRecips, fwdHosts, action) <- makeServerInput (Just uCap) maybeSummary audience (AP.InviteActivity inv) handleViaActor pid (Just cap) localRecips remoteRecips fwdHosts action @@ -1229,7 +1229,7 @@ postPublishInviteR = do removeForm = renderDivs $ (,,) <$> areq fedUriField "(URI) Whom to remove" Nothing - <*> areq fedUriField "(URI) From which resource" Nothing + <*> areq fedUriField "(URI) From which resource collaborators collection" Nothing <*> areq capField "(URI) Grant activity to use for authorization" Nothing getPublishRemoveR :: Handler Html @@ -1248,14 +1248,14 @@ postPublishRemoveR = do federation <- getsYesod $ appFederation . appSettings unless federation badMethod - (uRecipient, uResource, (uCap, cap)) <- + (uRecipient, uResourceCollabs, (uCap, cap)) <- runFormPostRedirect PublishRemoveR removeForm (ep@(Entity pid _), a) <- getSender senderHash <- encodeKeyHashid pid result <- runExceptT $ do - (maybeSummary, audience, rmv) <- remove pid uRecipient uResource + (maybeSummary, audience, rmv) <- remove pid uRecipient uResourceCollabs (localRecips, remoteRecips, fwdHosts, action) <- makeServerInput (Just uCap) maybeSummary audience (AP.RemoveActivity rmv) handleViaActor pid (Just cap) localRecips remoteRecips fwdHosts action diff --git a/src/Vervis/Handler/Deck.hs b/src/Vervis/Handler/Deck.hs index 92d4131..16f2550 100644 --- a/src/Vervis/Handler/Deck.hs +++ b/src/Vervis/Handler/Deck.hs @@ -457,8 +457,8 @@ postDeckInviteR deckHash = do result <- runExceptT $ do (maybeSummary, audience, invite) <- do let uRecipient = encodeRouteHome $ PersonR recipPersonHash - uResource = encodeRouteHome $ DeckR deckHash - C.invite personID uRecipient uResource role + uResourceCollabs = encodeRouteHome $ DeckCollabsR deckHash + C.invite personID uRecipient uResourceCollabs role grantID <- do maybeItem <- lift $ runDB $ getGrant CollabTopicDeckCollab CollabTopicDeckDeck deckID personID fromMaybeE maybeItem "You need to be a collaborator in the Deck to invite people" @@ -506,8 +506,8 @@ postDeckRemoveR deckHash ctID = do case pidOrU of Left pid -> encodeRouteHome . PersonR <$> encodeKeyHashid pid Right u -> pure u - let uResource = encodeRouteHome $ DeckR deckHash - C.remove personID uRecipient uResource + let uResourceCollabs = encodeRouteHome $ DeckCollabsR deckHash + C.remove personID uRecipient uResourceCollabs grantID <- do maybeItem <- lift $ runDB $ getGrant CollabTopicDeckCollab CollabTopicDeckDeck deckID personID fromMaybeE maybeItem "You need to be a collaborator in the Deck to remove people" diff --git a/src/Vervis/Handler/Loom.hs b/src/Vervis/Handler/Loom.hs index 16fca92..607a17d 100644 --- a/src/Vervis/Handler/Loom.hs +++ b/src/Vervis/Handler/Loom.hs @@ -30,6 +30,8 @@ module Vervis.Handler.Loom , postLoomUnfollowR , getLoomStampR + + , getLoomCollabsR ) where @@ -339,3 +341,6 @@ postLoomUnfollowR _ = error "Temporarily disabled" getLoomStampR :: KeyHashid Loom -> KeyHashid SigKey -> Handler TypedContent getLoomStampR = servePerActorKey loomActor LocalActorLoom + +getLoomCollabsR :: KeyHashid Loom -> Handler TypedContent +getLoomCollabsR loomHash = error "TODO getLoomCollabsR" diff --git a/src/Vervis/Handler/Project.hs b/src/Vervis/Handler/Project.hs index 657f1c9..baecb90 100644 --- a/src/Vervis/Handler/Project.hs +++ b/src/Vervis/Handler/Project.hs @@ -268,8 +268,8 @@ postProjectInviteR projectHash = do result <- runExceptT $ do (maybeSummary, audience, invite) <- do let uRecipient = encodeRouteHome $ PersonR recipPersonHash - uResource = encodeRouteHome $ ProjectR projectHash - C.invite personID uRecipient uResource role + uResourceCollabs = encodeRouteHome $ ProjectCollabsR projectHash + C.invite personID uRecipient uResourceCollabs role grantID <- do maybeItem <- lift $ runDB $ getGrant CollabTopicProjectCollab CollabTopicProjectProject projectID personID fromMaybeE maybeItem "You need to be a collaborator in the Project to invite people" @@ -317,8 +317,8 @@ postProjectRemoveR projectHash ctID = do case pidOrU of Left pid -> encodeRouteHome . PersonR <$> encodeKeyHashid pid Right u -> pure u - let uResource = encodeRouteHome $ ProjectR projectHash - C.remove personID uRecipient uResource + let uResourceCollabs = encodeRouteHome $ ProjectCollabsR projectHash + C.remove personID uRecipient uResourceCollabs grantID <- do maybeItem <- lift $ runDB $ getGrant CollabTopicProjectCollab CollabTopicProjectProject projectID personID fromMaybeE maybeItem "You need to be a collaborator in the Project to remove people" diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 110e9bd..2438591 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -48,6 +48,8 @@ module Vervis.Handler.Repo , getRepoStampR + , getRepoCollabsR + @@ -772,6 +774,9 @@ postRepoLinkR repoHash loomHash = do getRepoStampR :: KeyHashid Repo -> KeyHashid SigKey -> Handler TypedContent getRepoStampR = servePerActorKey repoActor LocalActorRepo +getRepoCollabsR :: KeyHashid Repo -> Handler TypedContent +getRepoCollabsR repoHash = error "TODO getRepoCollabsR" + diff --git a/th/routes b/th/routes index 4c45713..51735a2 100644 --- a/th/routes +++ b/th/routes @@ -197,6 +197,8 @@ /repos/#RepoKeyHashid/stamps/#SigKeyKeyHashid RepoStampR GET +/repos/#RepoKeyHashid/collabs RepoCollabsR GET + ---- Deck -------------------------------------------------------------------- /decks/#DeckKeyHashid DeckR GET @@ -271,6 +273,8 @@ /looms/#LoomKeyHashid/stamps/#SigKeyKeyHashid LoomStampR GET +/looms/#LoomKeyHashid/collabs LoomCollabsR GET + ---- Cloth ------------------------------------------------------------------- /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid ClothR GET