From 034194f2aa87df712404ba30a8e2fc79525b86ad Mon Sep 17 00:00:00 2001
From: Pere Lev <pere@towards.vision>
Date: Tue, 27 Jun 2023 22:56:52 +0300
Subject: [PATCH] DB & Vocab: Specify role in Add, store it in Component & Stem

---
 src/Vervis/Actor/Project.hs | 6 ++++--
 src/Vervis/Data/Collab.hs   | 5 +++--
 src/Vervis/Migration.hs     | 4 ++++
 src/Web/ActivityPub.hs      | 5 ++++-
 th/models                   | 2 ++
 5 files changed, 17 insertions(+), 5 deletions(-)

diff --git a/src/Vervis/Actor/Project.hs b/src/Vervis/Actor/Project.hs
index 9c681b5..0e7a8d9 100644
--- a/src/Vervis/Actor/Project.hs
+++ b/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) ->
diff --git a/src/Vervis/Data/Collab.hs b/src/Vervis/Data/Collab.hs
index 1e3b788..281dd99 100644
--- a/src/Vervis/Data/Collab.hs
+++ b/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
diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs
index f014b29..2fe16f0 100644
--- a/src/Vervis/Migration.hs
+++ b/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
diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs
index 5ba77fc..8b0e80d 100644
--- a/src/Web/ActivityPub.hs
+++ b/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
diff --git a/th/models b/th/models
index 6f25a39..1f1fceb 100644
--- a/th/models
+++ b/th/models
@@ -717,6 +717,7 @@ CollabRecipRemoteAccept
 
 Component
     project ProjectId
+    role    Role
 
 ------------------------------ Component reason ------------------------------
 
@@ -889,6 +890,7 @@ ComponentFurtherRemote
 ------------------------------------------------------------------------------
 
 Stem
+    role Role
 
 -------------------------------- Stem identity -------------------------------