diff --git a/src/Vervis/Actor/Factory.hs b/src/Vervis/Actor/Factory.hs index f6a747f..404cf34 100644 --- a/src/Vervis/Actor/Factory.hs +++ b/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) $ - throwE "Add role isn't admin" + unless (role == AP.RoleWrite) $ + 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 diff --git a/src/Vervis/Actor/Group.hs b/src/Vervis/Actor/Group.hs index f3abb5f..e671e27 100644 --- a/src/Vervis/Actor/Group.hs +++ b/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) $ - throwE "Add role isn't admin" + --unless (role == AP.RoleAdmin) $ + -- 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