S2S: Relax role requirements for adding-resource-to-team

- Factory.Add now requires write instead of admin
- Group.Add.Resource now allows any role, not necessarily admin

src/Vervis/Actor/Factory.hs

@@ -643,8 +643,8 @@ factoryAdd now factoryID (Verse authorIdMsig body) add = do
 
     let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig
     (object, target, role) <- parseAdd author add
-    unless (role == AP.RoleAdmin) $
+    unless (role == AP.RoleWrite) $
-        throwE "Add role isn't admin"
+        throwE "Add role isn't write"
     case (target, object) of
         (Left (ATFactoryTeams j), _) | j == factoryID ->
             addTeamActive object
@@ -796,7 +796,7 @@ factoryAdd now factoryID (Verse authorIdMsig body) add = do
         where
 
         insertSquad resourceID topicDB addDB acceptID = do
-            squadID <- insert $ Squad AP.RoleAdmin resourceID
+            squadID <- insert $ Squad AP.RoleWrite resourceID
             case topicDB of
                 Left (Entity g _) -> insert_ $ SquadTopicLocal squadID g
                 Right a -> insert_ $ SquadTopicRemote squadID a
@@ -910,7 +910,7 @@ factoryAdd now factoryID (Verse authorIdMsig body) add = do
         where
 
         insertSquad resourceID topicDB addDB = do
-            squadID <- insert $ Squad AP.RoleAdmin resourceID
+            squadID <- insert $ Squad AP.RoleWrite resourceID
             case topicDB of
                 Left (Entity g _) -> insert_ $ SquadTopicLocal squadID g
                 Right a -> insert_ $ SquadTopicRemote squadID a

src/Vervis/Actor/Group.hs

@@ -169,23 +169,23 @@ groupAdd now groupID (Verse authorIdMsig body) add = do
 
     let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig
     (object, target, role) <- parseAdd author add
-    unless (role == AP.RoleAdmin) $
+    --unless (role == AP.RoleAdmin) $
-        throwE "Add role isn't admin"
+    --    throwE "Add role isn't admin"
     case (target, object) of
         (Left (ATGroupChildren j), _) | j == groupID ->
-            addChildActive object
+            addChildActive role object
         (Left (ATGroupParents j), _) | j == groupID ->
-            addParentActive object
+            addParentActive role object
         (Left (ATGroupEfforts j), _) | j == groupID ->
-            addResourceActive object
+            addResourceActive role object
         (_, Left (LocalActorGroup j)) | j == groupID ->
             case target of
                 Left (ATGroupParents j) | j /= groupID ->
-                    addChildPassive $ Left j
+                    addChildPassive role $ Left j
                 Left (ATGroupChildren j) | j /= groupID ->
-                    addParentPassive $ Left j
+                    addParentPassive role $ Left j
                 Left at | isJust $ addTargetResourceTeams at ->
-                    addResourcePassive $ Left $ fromJust $ addTargetResourceTeams at
+                    addResourcePassive role $ Left $ fromJust $ addTargetResourceTeams at
                 Right (ObjURI h luColl) -> do
                     -- NOTE this is HTTP GET done synchronously in the activity
                     -- handler
@@ -199,11 +199,11 @@ groupAdd now groupID (Verse authorIdMsig body) add = do
                             AP.ResourceChild _ _ -> throwE "Add.target remote ResourceChild"
                     let typ = AP.actorType d
                     if typ == AP.ActorTypeTeam && Just luColl == AP.rwcSubteams rwc
-                        then addParentPassive $ Right $ ObjURI h lu
+                        then addParentPassive role $ Right $ ObjURI h lu
                     else if typ == AP.ActorTypeTeam && Just luColl == AP.rwcParentsOrProjects rwc
-                        then addChildPassive $ Right $ ObjURI h lu
+                        then addChildPassive role $ Right $ ObjURI h lu
                     else if AP.actorTypeIsResourceNT typ && Just luColl == AP.rwcTeams rwc
-                        then addResourcePassive $ Right $ ObjURI h lu
+                        then addResourcePassive role $ Right $ ObjURI h lu
                     else throwE "Weird collection situation"
                 _ -> throwE "I'm being added somewhere irrelevant"
         _ -> throwE "This Add isn't for me"
@@ -243,7 +243,10 @@ groupAdd now groupID (Verse authorIdMsig body) add = do
 
         return (action, recipientSet, remoteActors, fwdHosts)
 
-    addParentActive parent = do
+    addParentActive role parent = do
+
+        unless (role == AP.RoleAdmin) $
+            throwE "Add role isn't admin"
 
         -- If parent is local, find it in our DB
         -- If parent is remote, HTTP GET it, verify it's an actor of Group
@@ -353,7 +356,10 @@ groupAdd now groupID (Verse authorIdMsig body) add = do
 
             insert_ $ SourceUsAccept usID acceptID
 
-    addChildActive child = do
+    addChildActive role child = do
+
+        unless (role == AP.RoleAdmin) $
+            throwE "Add role isn't admin"
 
         -- If child is local, find it in our DB
         -- If child is remote, HTTP GET it, verify it's an actor of Group
@@ -463,7 +469,10 @@ groupAdd now groupID (Verse authorIdMsig body) add = do
 
             insert_ $ DestUsAccept destID acceptID
 
-    addParentPassive parent = do
+    addParentPassive role parent = do
+
+        unless (role == AP.RoleAdmin) $
+            throwE "Add role isn't admin"
 
         -- If parent is local, find it in our DB
         -- If parent is remote, HTTP GET it, verify it's an actor of Group
@@ -548,7 +557,10 @@ groupAdd now groupID (Verse authorIdMsig body) add = do
                 Right (author, _, addID) ->
                     insert_ $ SourceThemGestureRemote themID (remoteAuthorId author) addID
 
-    addChildPassive child = do
+    addChildPassive role child = do
+
+        unless (role == AP.RoleAdmin) $
+            throwE "Add role isn't admin"
 
         -- If child is local, find it in our DB
         -- If child is remote, HTTP GET it, verify it's an actor of Group
@@ -633,7 +645,7 @@ groupAdd now groupID (Verse authorIdMsig body) add = do
                 Right (author, _, addID) ->
                     insert_ $ DestThemGestureRemote themID (remoteAuthorId author) addID
 
-    addResourceActive resource = do
+    addResourceActive role resource = do
 
         -- If resource is local, find it in our DB
         -- If resource is remote, HTTP GET it, verify it's an actor of Group
@@ -724,7 +736,7 @@ groupAdd now groupID (Verse authorIdMsig body) add = do
         where
 
         insertEffort topicDB addDB acceptID = do
-            effortID <- insert $ Effort AP.RoleAdmin groupID
+            effortID <- insert $ Effort role groupID
             case topicDB of
                 Left r -> insert_ $ EffortTopicLocal effortID r
                 Right a -> insert_ $ EffortTopicRemote effortID a
@@ -770,7 +782,7 @@ groupAdd now groupID (Verse authorIdMsig body) add = do
 
             return (action, recipientSet, remoteActors, fwdHosts)
 
-    addResourcePassive resource = do
+    addResourcePassive role resource = do
 
         -- If resource is local, find it in our DB
         -- If resource is remote, HTTP GET it, verify it's an actor of Group
@@ -840,7 +852,7 @@ groupAdd now groupID (Verse authorIdMsig body) add = do
         where
 
         insertEffort topicDB addDB = do
-            effortID <- insert $ Effort AP.RoleAdmin groupID
+            effortID <- insert $ Effort role groupID
             case topicDB of
                 Left r -> insert_ $ EffortTopicLocal effortID r
                 Right a -> insert_ $ EffortTopicRemote effortID a