Vocab: Support project/component in parseInvite, update handlers

src/Vervis/Actor/Common.hs

@@ -705,9 +705,17 @@ topicInvite grabActor topicResource topicField topicCollabField collabTopicCtor
     -- Check invite
     (role, targetByKey) <- do
         let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig
-        (role, resource, recipient) <- parseInvite author invite
+        (role, resourceOrComps, recipientOrComp) <- parseInvite author invite
-        unless (Left (topicResource topicKey) == resource) $
+        unless (Left (Left $ topicResource topicKey) == resourceOrComps) $
             throwE "Invite topic isn't my collabs URI"
+        recipient <-
+            bitraverse
+                (\case
+                    Left r -> pure r
+                    Right _ -> throwE "Not accepting component actors as collabs"
+                )
+                pure
+                recipientOrComp
         return (role, recipient)
 
     -- If target is local, find it in our DB

src/Vervis/Actor/Person.hs

@@ -451,7 +451,7 @@ personInvite
 personInvite now recipPersonID (Verse authorIdMsig body) invite = do
 
     -- Check input
-    recipient <- do
+    recipientOrComp <- do
         let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig
         (_role, _resource, target) <- parseInvite author invite
         return target
@@ -471,8 +471,8 @@ personInvite now recipPersonID (Verse authorIdMsig body) invite = do
         Nothing -> done "I already have this activity in my inbox"
         Just actorID -> do
             let targetIsRecip =
-                    case recipient of
+                    case recipientOrComp of
-                        Left (GrantRecipPerson p) -> p == recipPersonID
+                        Left (Left (GrantRecipPerson p)) -> p == recipPersonID
                         _ -> False
             if not targetIsRecip
                 then done "I'm not the target; Inserted to inbox"

src/Vervis/Actor/Person/Client.hs

@@ -478,7 +478,23 @@ clientInvite
 clientInvite now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts action) invite = do
 
     -- Check input
-    (_role, resource, recipient) <- parseInvite (Left $ LocalActorPerson personMeID) invite
+    (_role, resourceOrComps, recipientOrComp) <- parseInvite (Left $ LocalActorPerson personMeID) invite
+    resource <-
+        bitraverse
+            (\case
+                Left r -> pure r
+                Right _ -> throwE "Not accepting project components as target"
+            )
+            pure
+            resourceOrComps
+    recipient <-
+        bitraverse
+            (\case
+                Left r -> pure r
+                Right _ -> throwE "Not accepting component actors as collabs"
+            )
+            pure
+            recipientOrComp
     _capID <- fromMaybeE maybeCap "No capability provided"
 
     -- If resource collabs URI is remote, HTTP GET it and its resource and its

src/Vervis/Client.hs

@@ -983,8 +983,24 @@ invite personID uRecipient uResourceCollabs role = do
     env <- asksSite appEnv
 
     let activity = AP.Invite role uRecipient uResourceCollabs
-    (_role, resource, recipient) <-
+    (_role, resourceOrComps, recipientOrComp) <-
         runActE $ parseInvite (Left $ LocalActorPerson personID) activity
+    resource <-
+        bitraverse
+            (\case
+                Left r -> pure r
+                Right _-> throwE "Not accepting project components as target"
+            )
+            pure
+            resourceOrComps
+    recipient <-
+        bitraverse
+            (\case
+                Left r -> pure r
+                Right _ -> throwE "Not accepting component actors as collabs"
+            )
+            pure
+            recipientOrComp
 
     -- If resource collabs is remote, we need to get it from DB/HTTP to
     -- determine the resourc & its managing actor & followers collection

src/Vervis/Data/Collab.hs

@@ -51,6 +51,7 @@ module Vervis.Data.Collab
     )
 where
 
+import Control.Applicative
 import Control.Monad
 import Control.Monad.Trans.Except
 import Data.Barbie
@@ -148,6 +149,28 @@ parseTopic u = do
         pure
         routeOrRemote
 
+parseTopic'
+    :: StageRoute Env ~ Route App
+    => FedURI
+    -> ActE (Either (Either (GrantResourceBy Key) ProjectId) FedURI)
+parseTopic' u = do
+    routeOrRemote <- parseFedURI u
+    bitraverse
+        (\case
+            ProjectComponentsR j ->
+                Right <$> WAP.decodeKeyHashidE j "Not a project components route"
+            route -> Left <$> do
+                resourceHash <-
+                    fromMaybeE
+                        (parseGrantResourceCollabs route)
+                        "Not a shared resource collabs route"
+                unhashGrantResourceE'
+                    resourceHash
+                    "Contains invalid hashid"
+        )
+        pure
+        routeOrRemote
+
 parseRecipient sender u = do
     routeOrRemote <- parseFedURI u
     bitraverse
@@ -172,20 +195,55 @@ parseRecipient sender u = do
         )
         routeOrRemote
 
+parseRecipient' sender u = do
+    routeOrRemote <- parseFedURI u
+    bitraverse
+        (\ route -> do
+            recipOrComp <-
+                Left <$>
+                fromMaybeE
+                    (parseGrantRecip route)
+                    "Not a grant recipient route"
+                <|>
+                Right <$>
+                fromMaybeE
+                    (parseComponent route)
+                    "Not a component route"
+            bitraverse
+                (\ recipHash -> do
+                    recipKey <-
+                        unhashGrantRecipE
+                            recipHash
+                            "Contains invalid hashid"
+                    case recipKey of
+                        GrantRecipPerson p | Left (LocalActorPerson p) == sender ->
+                            throwE "Invite local sender and recipient are the same Person"
+                        _ -> return recipKey
+                )
+                (flip unhashComponentE "Contains invalid keyhashid")
+                recipOrComp
+        )
+        (\ u -> do
+            when (Right u == sender) $
+                throwE "Invite remote sender and recipient are the same actor"
+            return u
+        )
+        routeOrRemote
+
 parseInvite
     :: StageRoute Env ~ Route App
     => Either (LocalActorBy Key) FedURI
     -> AP.Invite URIMode
     -> ActE
         ( AP.Role
-        , Either (GrantResourceBy Key) FedURI
+        , Either (Either (GrantResourceBy Key) ProjectId) FedURI
-        , Either (GrantRecipBy Key) FedURI
+        , Either (Either (GrantRecipBy Key) (ComponentBy Key)) FedURI
         )
 parseInvite sender (AP.Invite instrument object target) =
     (,,)
         <$> verifyRole instrument
-        <*> nameExceptT "Invite target" (parseTopic target)
+        <*> nameExceptT "Invite target" (parseTopic' target)
-        <*> nameExceptT "Invite object" (parseRecipient sender object)
+        <*> nameExceptT "Invite object" (parseRecipient' sender object)
 
 parseJoin
     :: StageRoute Env ~ Route App
@@ -318,11 +376,6 @@ parseAdd sender (AP.Add object target role) = do
             )
             pure
             routeOrRemote
-        where
-        parseComponent (RepoR r) = Just $ ComponentRepo r
-        parseComponent (DeckR d) = Just $ ComponentDeck d
-        parseComponent (LoomR l) = Just $ ComponentLoom l
-        parseComponent _         = Nothing
     parseProjectComps u = do
         routeOrRemote <- parseFedURI u
         bitraverse
@@ -427,6 +480,11 @@ data ComponentBy f
 
 deriving instance AllBF Eq f ComponentBy => Eq (ComponentBy f)
 
+parseComponent (RepoR r) = Just $ ComponentRepo r
+parseComponent (DeckR d) = Just $ ComponentDeck d
+parseComponent (LoomR l) = Just $ ComponentLoom l
+parseComponent _         = Nothing
+
 unhashComponentPure ctx = f
     where
     f (ComponentRepo r) =