Merge pull request #1089 from morucci/1084

Add author' groups into Monocle Idents

CHANGELOG.md

@@ -2,12 +2,17 @@
 
 All notable changes to this project will be documented in this file.
 ## [master]
+
 ### Added
 
 - [crawler] Proxy can be configured with `http_proxy` and `https_proxy` environment.
+- [crawler] A new `groups` sub-field in all Author fields (`on_author` and `author`) for `Change` and `Events`.
+  Groups memberships are reflected from the config file to the database.
 
 ### Changed
+
 ### Removed
+
 ### Fixed
 
 - [web] authors search returning no results #1082

schemas/monocle/protob/change.proto

@@ -10,6 +10,7 @@ import "google/protobuf/timestamp.proto";
 message Ident {
   string uid = 1;
   string muid = 2;
+  repeated string groups = 3;
 }
 
 message ChangedFile {

src/Lentille.hs

@@ -50,6 +50,7 @@ import Proto3.Suite (Enumerated (Enumerated))
 import Streaming.Prelude qualified as S
 
 import Effectful.Reader.Static qualified as E
+import Monocle.Config qualified as Config
 
 -------------------------------------------------------------------------------
 -- The Lentille context
@@ -120,12 +121,17 @@ sanitizeID = T.replace ":" "@" . T.replace "/" "@"
 nobody :: Text
 nobody = "ghost"
 
-toIdent :: Text -> (Text -> Maybe Text) -> Text -> Ident
-toIdent host cb username = Ident {..}
+toIdent :: Text -> (Text -> Maybe Config.IdentUG) -> Text -> Ident
+toIdent host cb username =
+  Ident
+    { identUid
+    , identMuid = from identMuid
+    , identGroups = fromList $ from <$> identGroups
+    }
  where
   uid = host <> "/" <> username
   identUid = from uid
-  identMuid = from $ fromMaybe username (cb uid)
+  (identMuid, identGroups) = fromMaybe (username, mempty) (cb uid)
 
 ghostIdent :: Text -> Ident
 ghostIdent host = toIdent host (const Nothing) nobody

src/Lentille/Gerrit.hs

@@ -48,6 +48,7 @@ import Prelude (init, last)
 
 import Effectful (Dispatch (Static), DispatchOf)
 import Effectful.Dispatch.Static (SideEffects (..), evalStaticRep)
+import Monocle.Config qualified as Config
 
 -------------------------------------------------------------------------------
 -- Gerrit context
@@ -84,7 +85,7 @@ data GerritEnv = GerritEnv
   -- ^ The Gerrit connexion client
   , prefix :: Maybe Text
   -- ^ A project fullname prefix as defined in the Monocle configuration
-  , identAliasCB :: Text -> Maybe Text
+  , identAliasCB :: Text -> Maybe Config.IdentUG
   -- ^ The identity alias callback
   , crawlerName :: Text
   -- ^ The crawler name
@@ -214,7 +215,7 @@ streamChange' ::
   GerritEffects es =>
   GerritEnv ->
   -- A callback to get Ident ID from an alias
-  (Text -> Maybe Text) ->
+  (Text -> Maybe Config.IdentUG) ->
   Text ->
   [GerritQuery] ->
   Maybe Text ->

src/Lentille/GitHub/PullRequests.hs

@@ -12,6 +12,7 @@ import Lentille.GitHub.GraphQLFragments (fragmentPRData)
 import Lentille.GitHub.Types
 import Lentille.GitHub.Utils
 import Lentille.GraphQL
+import Monocle.Config qualified as Config
 import Monocle.Prelude hiding (id, state)
 import Monocle.Protob.Change
 
@@ -46,7 +47,7 @@ streamPullRequests ::
   GraphEffects es =>
   GraphClient ->
   -- A callback to get Ident ID from an alias
-  (Text -> Maybe Text) ->
+  (Text -> Maybe Config.IdentUG) ->
   UTCTime ->
   Text ->
   LentilleStream es Changes
@@ -62,7 +63,7 @@ transformResponse ::
   -- hostname of the provider
   Text ->
   -- A callback to get Ident ID from an alias
-  (Text -> Maybe Text) ->
+  (Text -> Maybe Config.IdentUG) ->
   -- The response payload
   GetProjectPullRequests ->
   (PageInfo, Maybe RateLimit, [Text], [Changes])

src/Lentille/GitHub/UserPullRequests.hs

@@ -11,6 +11,7 @@ import Lentille.GitHub.GraphQLFragments (fragmentPRData)
 import Lentille.GitHub.Types
 import Lentille.GitHub.Utils
 import Lentille.GraphQL
+import Monocle.Config qualified as Config
 import Monocle.Prelude hiding (id, state)
 import Monocle.Protob.Change
 
@@ -45,7 +46,7 @@ streamUserPullRequests ::
   GraphEffects es =>
   GraphClient ->
   -- A callback to get Ident ID from an alias
-  (Text -> Maybe Text) ->
+  (Text -> Maybe Config.IdentUG) ->
   UTCTime ->
   Text ->
   LentilleStream es Changes
@@ -59,7 +60,7 @@ transformResponse ::
   -- hostname of the provider
   Text ->
   -- A callback to get Ident ID from an alias
-  (Text -> Maybe Text) ->
+  (Text -> Maybe Config.IdentUG) ->
   -- The response payload
   GetUserPullRequests ->
   (PageInfo, Maybe RateLimit, [Text], [Changes])

src/Lentille/GitLab/Adapter.hs

@@ -12,6 +12,7 @@ import Data.Time.Clock
 import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeOrError)
 import Google.Protobuf.Timestamp qualified as T
 import Lentille (ghostIdent, nobody, toIdent)
+import Monocle.Config qualified as Config
 import Monocle.Prelude
 import Monocle.Protob.Change
 import Proto3.Suite (Enumerated (..))
@@ -97,7 +98,7 @@ getChangeNumber :: Text -> Int32
 getChangeNumber iid =
   from $ fromMaybe 0 ((readMaybe $ from iid) :: Maybe Int)
 
-toCommit :: Text -> (Text -> Maybe Text) -> MRCommit -> Commit
+toCommit :: Text -> (Text -> Maybe Config.IdentUG) -> MRCommit -> Commit
 toCommit host cb MRCommit {..} =
   Commit
     (from sha)

src/Lentille/GitLab/MergeRequests.hs

@@ -16,6 +16,7 @@ import Google.Protobuf.Timestamp qualified as T
 import Lentille
 import Lentille.GitLab.Adapter
 import Lentille.GraphQL
+import Monocle.Config qualified as Config
 import Monocle.Entity
 import Monocle.Prelude hiding (id, state)
 import Monocle.Protob.Change
@@ -109,7 +110,7 @@ streamMergeRequests ::
   GraphEffects es =>
   GraphClient ->
   -- A callback to get Ident ID from an alias
-  (Text -> Maybe Text) ->
+  (Text -> Maybe Config.IdentUG) ->
   UTCTime ->
   Text ->
   LentilleStream es Changes
@@ -122,7 +123,7 @@ streamMergeRequests client getIdentIdCb untilDate project =
 transformResponse ::
   Text ->
   -- A callback to get Ident ID from an alias
-  (Text -> Maybe Text) ->
+  (Text -> Maybe Config.IdentUG) ->
   GetProjectMergeRequests ->
   (PageInfo, Maybe RateLimit, [Text], [(Change, [ChangeEvent])])
 transformResponse host getIdentIdCB result =

src/Macroscope/Main.hs

@@ -375,7 +375,7 @@ getCrawler inf@(InfoCrawler _ _ crawler idents) = getCompose $ fmap addInfos (Co
         pure $ Just (k, [ghUserPRCrawler ghClient getIdentByAliasCB])
       Config.GithubApplicationProvider _ -> pure Nothing -- "Not (yet) implemented"
       Config.TaskDataProvider -> pure Nothing -- This is a generic crawler, not managed by the macroscope
-  getIdentByAliasCB :: Text -> Maybe Text
+  getIdentByAliasCB :: Text -> Maybe (Text, [Text])
   getIdentByAliasCB = flip Config.getIdentByAliasFromIdents idents
 
   getGHClient mToken mAPIUrl = do
@@ -384,7 +384,7 @@ getCrawler inf@(InfoCrawler _ _ crawler idents) = getCompose $ fmap addInfos (Co
       (fromMaybe "https://api.github.com/graphql" mAPIUrl)
       ghToken
 
-  glMRCrawler :: GraphClient -> (Text -> Maybe Text) -> DocumentStream es
+  glMRCrawler :: GraphClient -> (Text -> Maybe Config.IdentUG) -> DocumentStream es
   glMRCrawler glClient cb = Changes $ streamMergeRequests glClient cb
 
   glOrgCrawler :: GraphClient -> DocumentStream es
@@ -399,10 +399,10 @@ getCrawler inf@(InfoCrawler _ _ crawler idents) = getCompose $ fmap addInfos (Co
   ghOrgCrawler :: GraphClient -> DocumentStream es
   ghOrgCrawler ghClient = Projects $ streamOrganizationProjects ghClient
 
-  ghPRCrawler :: GraphClient -> (Text -> Maybe Text) -> DocumentStream es
+  ghPRCrawler :: GraphClient -> (Text -> Maybe Config.IdentUG) -> DocumentStream es
   ghPRCrawler glClient cb = Changes $ streamPullRequests glClient cb
 
-  ghUserPRCrawler :: GraphClient -> (Text -> Maybe Text) -> DocumentStream es
+  ghUserPRCrawler :: GraphClient -> (Text -> Maybe Config.IdentUG) -> DocumentStream es
   ghUserPRCrawler glClient cb = UserChanges $ streamUserPullRequests glClient cb
 
   gerritRegexProjects :: [Text] -> [Text]

src/Monocle/Api/Server.hs

@@ -1062,5 +1062,5 @@ handleLoggedIn cookieSettings err codeM stateM = do
   getIdents config auid = foldr go Map.empty $ Config.getWorkspaces config
    where
     go index acc = case Config.getIdentByAlias index auid of
-      Just muid -> Map.insert (Config.getWorkspaceName index) muid acc
+      Just (muid, _) -> Map.insert (Config.getWorkspaceName index) muid acc
       Nothing -> acc

src/Monocle/Backend/Documents.hs

@@ -33,6 +33,7 @@ import Monocle.Protob.Search qualified as SearchPB
 data Author = Author
   { authorMuid :: LText
   , authorUid :: LText
+  , authorGroups :: [LText]
   }
   deriving (Show, Eq, Generic)
 
@@ -47,12 +48,13 @@ instance From ChangePB.Ident Author where
     Author
       { authorMuid = identMuid
       , authorUid = identUid
+      , authorGroups = toList identGroups
       }
 
 fromMaybeIdent :: Maybe ChangePB.Ident -> Author
 fromMaybeIdent = maybe ghostAuthor from
  where
-  ghostAuthor = Author "backend-ghost" "backend-ghost"
+  ghostAuthor = Author "backend-ghost" "backend-ghost" mempty
 
 -- | CachedAuthor is used by the Author search cache
 data CachedAuthor = CachedAuthor
@@ -116,7 +118,7 @@ instance FromJSON Commit where
 ensureAuthor :: Maybe ChangePB.Ident -> ChangePB.Ident
 ensureAuthor = \case
   Just i -> i
-  Nothing -> ChangePB.Ident "backend-ghost" "backend-host"
+  Nothing -> ChangePB.Ident "backend-ghost" "backend-host" mempty
 
 instance From ChangePB.Commit Commit where
   from ChangePB.Commit {..} =