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

@@ -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
 

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
+    -- If resource collabs URI is remote, HTTP GET it and its resource and its
-    -- our DB. If resource is local, find it in our DB.
+    -- 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

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
+    -- If resource collabs is remote, we need to get it from DB/HTTP to
-    -- managing actor & followers collection
+    -- 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

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)
+                    (parseGrantResourceCollabs route)
-                    "Not a shared resource route"
+                    "Not a shared resource collabs route"
             unhashGrantResourceE'
                 resourceHash
                 "Contains invalid hashid"

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)

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

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
+                uResourceCollabs = encodeRouteHome $ DeckCollabsR deckHash
-            C.invite personID uRecipient uResource role
+            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
+            let uResourceCollabs = encodeRouteHome $ DeckCollabsR deckHash
-            C.remove personID uRecipient uResource
+            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"

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"

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
+                uResourceCollabs = encodeRouteHome $ ProjectCollabsR projectHash
-            C.invite personID uRecipient uResource role
+            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
+            let uResourceCollabs = encodeRouteHome $ ProjectCollabsR projectHash
-            C.remove personID uRecipient uResource
+            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"

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"
+
 
 
 

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