DB & Vocab: Specify role in Add, store it in Component & Stem

src/Vervis/Actor/Project.hs

@@ -120,9 +120,11 @@ projectAdd now projectID (Verse authorIdMsig body) add = do
     -- Check input
     component <- do
         let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig
-        (component, projectComps) <- parseAdd author add
+        (component, projectComps, role) <- parseAdd author add
         unless (projectComps == Left projectID) $
             throwE "Add target isn't my components collection"
+        unless (role == AP.RoleAdmin) $
+            throwE "Add role isn't admin"
         return component
 
     -- If component is local, find it in our DB
@@ -270,7 +272,7 @@ projectAdd now projectID (Verse authorIdMsig body) add = do
         const () <$> MaybeT (getBy $ UniqueComponentProjectAccept originID)
 
     insertComponent componentDB addDB = do
-        componentID <- insert $ Component projectID
+        componentID <- insert $ Component projectID AP.RoleAdmin
         originID <- insert $ ComponentOriginAdd componentID
         case addDB of
             Left (_, _, addID) ->

src/Vervis/Data/Collab.hs

@@ -280,8 +280,9 @@ parseAdd
     -> ActE
         ( Either (ComponentBy Key) FedURI
         , Either ProjectId FedURI
+        , AP.Role
         )
-parseAdd sender (AP.Add object target) = do
+parseAdd sender (AP.Add object target role) = do
     result@(component, collection) <-
         (,) <$> nameExceptT "Add.object" (parseComponent' object)
             <*> nameExceptT "Add.target" (parseProjectComps target)
@@ -294,7 +295,7 @@ parseAdd sender (AP.Add object target) = do
         Left projectID | sender == Left (LocalActorProject projectID) ->
             throwE "Sender and project are the same"
         _ -> pure ()
-    return result
+    return (component, collection, role)
     where
     parseComponent' (Right _) = throwE "Not a component URI"
     parseComponent' (Left u) = do

src/Vervis/Migration.hs

@@ -2964,6 +2964,10 @@ changes hLocal ctx =
     , addFieldPrimRequired "RemoteActor" ("" :: Text) "type"
       -- 544
     , removeField "ComponentRemote" "object"
+      -- 545
+    , addFieldPrimRequired "Component" ("RoleAdmin" :: String) "role"
+      -- 546
+    , addFieldPrimRequired "Stem" ("RoleAdmin" :: String) "role"
     ]
 
 migrateDB

src/Web/ActivityPub.hs

@@ -1672,6 +1672,7 @@ instance ActivityPub AddObject where
 data Add u = Add
     { addObject :: Either (ObjURI u) (AddObject u)
     , addTarget :: ObjURI u
+    , addInstrument :: Role
     }
 
 parseAdd :: UriMode u => Object -> Authority u -> Parser (Add u)
@@ -1680,13 +1681,15 @@ parseAdd o h = Add
             toEither <$> o .: "object"
         )
     <*> o .: "target"
+    <*> o .: "instrument"
 
 encodeAdd :: UriMode u => Authority u -> Add u -> Series
-encodeAdd h (Add obj target)
+encodeAdd h (Add obj target ins)
     =  case obj of
         Left u -> "object" .= u
         Right o -> "object" `pair` pairs (toSeries h o)
     <> "target" .= target
+    <> "instrument" .= ins
 
 data Apply u = Apply
     { applyObject :: ObjURI u

th/models

@@ -717,6 +717,7 @@ CollabRecipRemoteAccept
 
 Component
     project ProjectId
+    role    Role
 
 ------------------------------ Component reason ------------------------------
 
@@ -889,6 +890,7 @@ ComponentFurtherRemote
 ------------------------------------------------------------------------------
 
 Stem
+    role Role
 
 -------------------------------- Stem identity -------------------------------