From a6ff703f183a864689b50cb1aefe9aa8ceb59eb6 Mon Sep 17 00:00:00 2001 From: Fabien Boucher Date: Fri, 24 Nov 2023 15:28:59 +0000 Subject: [PATCH 1/6] Add the author's group field into the Monocle schema --- src/Monocle/Backend/Index.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/src/Monocle/Backend/Index.hs b/src/Monocle/Backend/Index.hs index 478538f9d..0fd1a37c5 100644 --- a/src/Monocle/Backend/Index.hs +++ b/src/Monocle/Backend/Index.hs @@ -55,6 +55,7 @@ instance ToJSON AuthorMapping where object [ "uid" .= object ["type" .= ("keyword" :: Text)] , "muid" .= object ["type" .= ("keyword" :: Text)] + , "groups" .= object ["type" .= ("keyword" :: Text)] ] instance ToJSON AuthorIndexMapping where @@ -240,7 +241,7 @@ createIndex indexName mapping = do retryPolicy = exponentialBackoff 500_000 <> limitRetries 7 configVersion :: ConfigVersion -configVersion = ConfigVersion 5 +configVersion = ConfigVersion 6 configIndex :: BH.IndexName configIndex = BH.IndexName "monocle.config" @@ -373,6 +374,12 @@ upgradeConfigV5 = do logInfo "Applying migration to schema V5 on workspace" ["index" .= indexName] void $ esPutMapping indexName mergedCommitField +upgradeConfigV6 :: forall es. MonoQuery :> es => IndexEffects es => Eff es () +upgradeConfigV6 = do + indexName <- getIndexName + logInfo "Applying migration to schema V6 on workspace" ["index" .= indexName] + void $ esPutMapping indexName ChangesIndexMapping + upgrades :: forall es. (E.Fail :> es, MonoQuery :> es) => IndexEffects es => [(ConfigVersion, Eff es ())] upgrades = [ (ConfigVersion 1, upgradeConfigV1) @@ -380,6 +387,7 @@ upgrades = , (ConfigVersion 3, void upgradeConfigV3) , (ConfigVersion 4, void upgradeConfigV4) , (ConfigVersion 5, void upgradeConfigV5) + , (ConfigVersion 6, void upgradeConfigV6) ] newtype ConfigVersion = ConfigVersion Integer From 26a2ab34b8a9253052cbadd69d365161883db150 Mon Sep 17 00:00:00 2001 From: Fabien Boucher Date: Tue, 28 Nov 2023 19:30:42 +0000 Subject: [PATCH 2/6] Update the protob Ident and init to mempty --- codegen/Monocle/Protob/Change.hs | 83 ++++++++++++++++++++++------- schemas/monocle/protob/change.proto | 1 + src/Lentille.hs | 1 + src/Monocle/Backend/Documents.hs | 6 ++- src/Monocle/Backend/Index.hs | 2 + src/Monocle/Backend/Janitor.hs | 4 +- src/Monocle/Backend/Provisioner.hs | 2 +- src/Monocle/Backend/Test.hs | 24 ++++----- 8 files changed, 87 insertions(+), 36 deletions(-) diff --git a/codegen/Monocle/Protob/Change.hs b/codegen/Monocle/Protob/Change.hs index b704eb9b6..c0329a595 100644 --- a/codegen/Monocle/Protob/Change.hs +++ b/codegen/Monocle/Protob/Change.hs @@ -46,7 +46,11 @@ import Proto3.Wire.Decode qualified as HsProtobuf ( import Unsafe.Coerce qualified as Hs import Prelude qualified as Hs -data Ident = Ident {identUid :: Hs.Text, identMuid :: Hs.Text} +data Ident = Ident + { identUid :: Hs.Text + , identMuid :: Hs.Text + , identGroups :: Hs.Vector Hs.Text + } deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic) instance Hs.NFData Ident @@ -57,18 +61,31 @@ instance HsProtobuf.Named Ident where instance HsProtobuf.HasDefault Ident instance HsProtobuf.Message Ident where - encodeMessage _ Ident {identUid = identUid, identMuid = identMuid} = - ( Hs.mconcat - [ ( HsProtobuf.encodeMessageField - (HsProtobuf.FieldNumber 1) - (Hs.coerce @(Hs.Text) @(HsProtobuf.String Hs.Text) (identUid)) - ) - , ( HsProtobuf.encodeMessageField - (HsProtobuf.FieldNumber 2) - (Hs.coerce @(Hs.Text) @(HsProtobuf.String Hs.Text) (identMuid)) - ) - ] - ) + encodeMessage + _ + Ident + { identUid = identUid + , identMuid = identMuid + , identGroups = identGroups + } = + ( Hs.mconcat + [ ( HsProtobuf.encodeMessageField + (HsProtobuf.FieldNumber 1) + (Hs.coerce @(Hs.Text) @(HsProtobuf.String Hs.Text) (identUid)) + ) + , ( HsProtobuf.encodeMessageField + (HsProtobuf.FieldNumber 2) + (Hs.coerce @(Hs.Text) @(HsProtobuf.String Hs.Text) (identMuid)) + ) + , ( HsProtobuf.encodeMessageField + (HsProtobuf.FieldNumber 3) + ( Hs.coerce @(Hs.Vector Hs.Text) + @(HsProtobuf.UnpackedVec (HsProtobuf.String Hs.Text)) + (identGroups) + ) + ) + ] + ) decodeMessage _ = (Hs.pure Ident) <*> ( HsProtobuf.coerceOver @(HsProtobuf.String Hs.Text) @(Hs.Text) @@ -83,6 +100,14 @@ instance HsProtobuf.Message Ident where (HsProtobuf.FieldNumber 2) ) ) + <*> ( HsProtobuf.coerceOver + @(HsProtobuf.UnpackedVec (HsProtobuf.String Hs.Text)) + @(Hs.Vector Hs.Text) + ( HsProtobuf.at + HsProtobuf.decodeMessageField + (HsProtobuf.FieldNumber 3) + ) + ) dotProto _ = [ ( HsProtobufAST.DotProtoField (HsProtobuf.FieldNumber 1) @@ -98,21 +123,36 @@ instance HsProtobuf.Message Ident where [] "" ) + , ( HsProtobufAST.DotProtoField + (HsProtobuf.FieldNumber 3) + (HsProtobufAST.Repeated HsProtobufAST.String) + (HsProtobufAST.Single "groups") + [] + "" + ) ] instance HsJSONPB.ToJSONPB Ident where - toJSONPB (Ident f1 f2) = + toJSONPB (Ident f1 f2 f3) = ( HsJSONPB.object [ "uid" .= (Hs.coerce @(Hs.Text) @(HsProtobuf.String Hs.Text) (f1)) - , "muid" - .= (Hs.coerce @(Hs.Text) @(HsProtobuf.String Hs.Text) (f2)) + , "muid" .= (Hs.coerce @(Hs.Text) @(HsProtobuf.String Hs.Text) (f2)) + , "groups" + .= ( Hs.coerce @(Hs.Vector Hs.Text) + @(HsProtobuf.UnpackedVec (HsProtobuf.String Hs.Text)) + (f3) + ) ] ) - toEncodingPB (Ident f1 f2) = + toEncodingPB (Ident f1 f2 f3) = ( HsJSONPB.pairs [ "uid" .= (Hs.coerce @(Hs.Text) @(HsProtobuf.String Hs.Text) (f1)) - , "muid" - .= (Hs.coerce @(Hs.Text) @(HsProtobuf.String Hs.Text) (f2)) + , "muid" .= (Hs.coerce @(Hs.Text) @(HsProtobuf.String Hs.Text) (f2)) + , "groups" + .= ( Hs.coerce @(Hs.Vector Hs.Text) + @(HsProtobuf.UnpackedVec (HsProtobuf.String Hs.Text)) + (f3) + ) ] ) @@ -128,6 +168,11 @@ instance HsJSONPB.FromJSONPB Ident where <*> ( HsProtobuf.coerceOver @(HsProtobuf.String Hs.Text) @(Hs.Text) (obj .: "muid") ) + <*> ( HsProtobuf.coerceOver + @(HsProtobuf.UnpackedVec (HsProtobuf.String Hs.Text)) + @(Hs.Vector Hs.Text) + (obj .: "groups") + ) ) ) diff --git a/schemas/monocle/protob/change.proto b/schemas/monocle/protob/change.proto index c13d6f1e1..ccf9b11bc 100644 --- a/schemas/monocle/protob/change.proto +++ b/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 { diff --git a/src/Lentille.hs b/src/Lentille.hs index 0a3abf9d1..ab429bd3f 100644 --- a/src/Lentille.hs +++ b/src/Lentille.hs @@ -126,6 +126,7 @@ toIdent host cb username = Ident {..} uid = host <> "/" <> username identUid = from uid identMuid = from $ fromMaybe username (cb uid) + identGroups = mempty ghostIdent :: Text -> Ident ghostIdent host = toIdent host (const Nothing) nobody diff --git a/src/Monocle/Backend/Documents.hs b/src/Monocle/Backend/Documents.hs index c16b441c6..b9424ba4f 100644 --- a/src/Monocle/Backend/Documents.hs +++ b/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 = mempty } 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 {..} = diff --git a/src/Monocle/Backend/Index.hs b/src/Monocle/Backend/Index.hs index 0fd1a37c5..947f7135c 100644 --- a/src/Monocle/Backend/Index.hs +++ b/src/Monocle/Backend/Index.hs @@ -482,11 +482,13 @@ toAuthor (Just ChangePB.Ident {..}) = Monocle.Backend.Documents.Author { authorMuid = identMuid , authorUid = identUid + , authorGroups = toList identGroups } toAuthor Nothing = Monocle.Backend.Documents.Author "backend-ghost" "backend-ghost" + mempty -- TODO: change that to a From instance toEChangeEvent :: ChangePB.ChangeEvent -> EChangeEvent diff --git a/src/Monocle/Backend/Janitor.hs b/src/Monocle/Backend/Janitor.hs index a2b5cf49b..14ad78b0b 100644 --- a/src/Monocle/Backend/Janitor.hs +++ b/src/Monocle/Backend/Janitor.hs @@ -28,9 +28,9 @@ import Streaming.Prelude qualified as Streaming updateAuthor :: Config.Index -> D.Author -> D.Author updateAuthor index author@D.Author {..} = case getIdent of - Just ident -> D.Author ident authorUid + Just ident -> D.Author ident authorUid mempty Nothing - | newMuid /= from authorMuid -> D.Author (from newMuid) authorUid + | newMuid /= from authorMuid -> D.Author (from newMuid) authorUid mempty | otherwise -> author where getIdent :: Maybe LText diff --git a/src/Monocle/Backend/Provisioner.hs b/src/Monocle/Backend/Provisioner.hs index f1561725f..bfc0c71e7 100644 --- a/src/Monocle/Backend/Provisioner.hs +++ b/src/Monocle/Backend/Provisioner.hs @@ -100,7 +100,7 @@ fakeTitle = from <$> Faker.Movie.BackToTheFuture.quotes fakeAuthor :: Faker.Fake Author fakeAuthor = do name <- from <$> Faker.TvShow.Futurama.characters - pure $ Author name name + pure $ Author name name mempty fakeText :: Faker.Fake LText fakeText = from <$> Faker.TvShow.Futurama.quotes diff --git a/src/Monocle/Backend/Test.hs b/src/Monocle/Backend/Test.hs index d047030d5..fa74da53a 100644 --- a/src/Monocle/Backend/Test.hs +++ b/src/Monocle/Backend/Test.hs @@ -41,11 +41,11 @@ fakeDate = [utctime|2021-05-31 10:00:00|] fakeDateAlt = [utctime|2021-06-01 20:00:00|] alice, bob, eve, fakeAuthor, fakeAuthorAlt :: Author -alice = Author "alice" "a" -bob = Author "bob" "b" -eve = Author "eve" "e" -fakeAuthor = Author "John" "John" -fakeAuthorAlt = Author "John Doe/12" "review.opendev.org/John Doe/12" +alice = Author "alice" "a" mempty +bob = Author "bob" "b" mempty +eve = Author "eve" "e" mempty +fakeAuthor = Author "John" "John" mempty +fakeAuthorAlt = Author "John Doe/12" "review.opendev.org/John Doe/12" mempty fakeChangePB :: ChangePB.Change fakeChangePB = @@ -603,7 +603,7 @@ testJanitorUpdateIdents = do } mkIdent :: [Text] -> Text -> Config.Ident mkIdent uid = Config.Ident uid Nothing - expectedAuthor = Author "John Doe" "github.com/john" + expectedAuthor = Author "John Doe" "github.com/john" mempty doUpdateIndentOnEventsTest :: Eff [MonoQuery, ElasticEffect, LoggerEffect, IOE] () doUpdateIndentOnEventsTest = E.runFailIO do @@ -617,8 +617,8 @@ testJanitorUpdateIdents = do evt2' <- I.getChangeEventById $ I.getEventDocId evt2 assertEqual' "Ensure event not changed" evt2' $ Just evt2 where - evt1 = mkEventWithAuthor "e1" (Author "john" "github.com/john") - evt2 = mkEventWithAuthor "e2" (Author "paul" "github.com/paul") + evt1 = mkEventWithAuthor "e1" (Author "john" "github.com/john" mempty) + evt2 = mkEventWithAuthor "e2" (Author "paul" "github.com/paul" mempty) mkEventWithAuthor :: -- eventId Text -> @@ -647,10 +647,10 @@ testJanitorUpdateIdents = do -- then default is to remove the "/" prefix checkEChangeField (I.getChangeDocId change3) echangeAuthor expectedAuthor' where - expectedAuthor' = Author "jane" "github.com/jane" - change1 = mkChangeWithAuthor "c1" (Author "john" "github.com/john") - change2 = mkChangeWithAuthor "c2" (Author "paul" "github.com/paul") - change3 = mkChangeWithAuthor "c3" (Author "Ident will revert" "github.com/jane") + expectedAuthor' = Author "jane" "github.com/jane" mempty + change1 = mkChangeWithAuthor "c1" (Author "john" "github.com/john" mempty) + change2 = mkChangeWithAuthor "c2" (Author "paul" "github.com/paul" mempty) + change3 = mkChangeWithAuthor "c3" (Author "Ident will revert" "github.com/jane" mempty) mkChangeWithAuthor :: -- changeId Text -> From 9b389902c5e710e48e2baeb5975aeaff8079059c Mon Sep 17 00:00:00 2001 From: Fabien Boucher Date: Sat, 2 Dec 2023 16:43:09 +0000 Subject: [PATCH 3/6] crawler - ensure lentilles populate groups field of Ident --- src/Lentille.hs | 13 +++++++++---- src/Lentille/Gerrit.hs | 5 +++-- src/Lentille/GitHub/PullRequests.hs | 5 +++-- src/Lentille/GitHub/UserPullRequests.hs | 5 +++-- src/Lentille/GitLab/Adapter.hs | 3 ++- src/Lentille/GitLab/MergeRequests.hs | 5 +++-- src/Macroscope/Main.hs | 8 ++++---- src/Monocle/Api/Server.hs | 2 +- src/Monocle/Backend/Janitor.hs | 2 +- src/Monocle/Config.hs | 19 ++++++++++++++----- src/Tests.hs | 4 ++-- 11 files changed, 45 insertions(+), 26 deletions(-) diff --git a/src/Lentille.hs b/src/Lentille.hs index ab429bd3f..9e4254a9e 100644 --- a/src/Lentille.hs +++ b/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,13 +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) - identGroups = mempty + (identMuid, identGroups) = fromMaybe (username, mempty) (cb uid) ghostIdent :: Text -> Ident ghostIdent host = toIdent host (const Nothing) nobody diff --git a/src/Lentille/Gerrit.hs b/src/Lentille/Gerrit.hs index c4f0e22b7..8312d4f4f 100644 --- a/src/Lentille/Gerrit.hs +++ b/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 -> diff --git a/src/Lentille/GitHub/PullRequests.hs b/src/Lentille/GitHub/PullRequests.hs index 94a5a76d2..98c5e6c60 100644 --- a/src/Lentille/GitHub/PullRequests.hs +++ b/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]) diff --git a/src/Lentille/GitHub/UserPullRequests.hs b/src/Lentille/GitHub/UserPullRequests.hs index f4aef734a..5e51c25be 100644 --- a/src/Lentille/GitHub/UserPullRequests.hs +++ b/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]) diff --git a/src/Lentille/GitLab/Adapter.hs b/src/Lentille/GitLab/Adapter.hs index eb8dca7b8..5c04da88b 100644 --- a/src/Lentille/GitLab/Adapter.hs +++ b/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) diff --git a/src/Lentille/GitLab/MergeRequests.hs b/src/Lentille/GitLab/MergeRequests.hs index 872f3854d..472f603ad 100644 --- a/src/Lentille/GitLab/MergeRequests.hs +++ b/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 = diff --git a/src/Macroscope/Main.hs b/src/Macroscope/Main.hs index 96be866af..952833392 100644 --- a/src/Macroscope/Main.hs +++ b/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] diff --git a/src/Monocle/Api/Server.hs b/src/Monocle/Api/Server.hs index a834366be..ca2867a3f 100644 --- a/src/Monocle/Api/Server.hs +++ b/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 diff --git a/src/Monocle/Backend/Janitor.hs b/src/Monocle/Backend/Janitor.hs index 14ad78b0b..c2829c0ea 100644 --- a/src/Monocle/Backend/Janitor.hs +++ b/src/Monocle/Backend/Janitor.hs @@ -34,7 +34,7 @@ updateAuthor index author@D.Author {..} = case getIdent of | otherwise -> author where getIdent :: Maybe LText - getIdent = from <$> Config.getIdentByAlias index (from authorUid) + getIdent = from . fst <$> Config.getIdentByAlias index (from authorUid) -- Remove the host prefix newMuid = T.drop 1 $ T.dropWhile (/= '/') (from authorUid) diff --git a/src/Monocle/Config.hs b/src/Monocle/Config.hs index 8e9442c18..d45110051 100644 --- a/src/Monocle/Config.hs +++ b/src/Monocle/Config.hs @@ -42,6 +42,9 @@ module Monocle.Config ( ConfigStatus (..), Status (..), + -- * Additional data types + IdentUG, + -- * Functions related to config loading loadConfig, loadConfigWithoutEnv, @@ -201,6 +204,9 @@ type WorkspaceName = IndexName type WorkspaceStatus = Map WorkspaceName Status +-- | IdentInfo is the Monocle UID and the list of Groups +type IdentUG = (Text, [Text]) + -- | The 'ConfigStatus' wraps the loaded Monocle config data ConfigStatus = ConfigStatus { csReloaded :: Bool @@ -393,8 +399,8 @@ getSearchAliases index = maybe [] (fmap toTuple) (search_aliases index) where toTuple SearchAlias {..} = (name, alias) --- | Get the Ident name for a Given alias -getIdentByAlias :: Index -> Text -> Maybe Text +-- | Get the Monocle UID and belonging Groups from an Ident's Alias +getIdentByAlias :: Index -> Text -> Maybe (Text, [Text]) getIdentByAlias Index {..} alias = getIdentByAliasFromIdents alias =<< idents -- End - Functions to handle an Index @@ -470,14 +476,17 @@ mkTenant name = , search_aliases = Nothing } --- | Get 'Ident' ident from a list of 'Ident' -getIdentByAliasFromIdents :: Text -> [Ident] -> Maybe Text +-- | Get the Monocle UID and belonging Groups from an Ident's Alias +getIdentByAliasFromIdents :: Text -> [Ident] -> Maybe (Text, [Text]) getIdentByAliasFromIdents alias idents' = case find isMatched idents' of Nothing -> Nothing - Just Ident {..} -> Just ident + Just Ident {..} -> Just (ident, toGroups groups) where isMatched :: Ident -> Bool isMatched Ident {..} = alias `elem` aliases + toGroups = \case + Nothing -> mempty + Just grps -> grps -- | Create an IndexName with checked constraints -- diff --git a/src/Tests.hs b/src/Tests.hs index 3d749b6c5..ca0927bba 100644 --- a/src/Tests.hs +++ b/src/Tests.hs @@ -653,12 +653,12 @@ monocleConfig = (Config.getTenantGroups tenant) testGetIdentByAlias = testCase "Validate getIdentByAliases" do - let identA = createIdent "alice" ["opendev.org/Alice Doe/12345", "github.com/alice89"] [] + let identA = createIdent "alice" ["opendev.org/Alice Doe/12345", "github.com/alice89"] ["cores", "devs"] identB = createIdent "bob" [] [] tenant = (Config.mkTenant $ hardcodedIndexName "test") {Config.idents = Just [identA, identB]} assertEqual "Ensure found alice as ident" - (Just "alice") + (Just ("alice", ["cores", "devs"])) $ Config.getIdentByAlias tenant "github.com/alice89" assertEqual "Ensure found no ident" From 3e617a4f9cfb07347d18b38671131097f2e919f4 Mon Sep 17 00:00:00 2001 From: Fabien Boucher Date: Mon, 11 Dec 2023 07:45:50 +0000 Subject: [PATCH 4/6] authors groups - update indexer and janitor --- src/Monocle/Backend/Documents.hs | 2 +- src/Monocle/Backend/Janitor.hs | 8 ++++---- src/Monocle/Backend/Test.hs | 13 ++++++++----- 3 files changed, 13 insertions(+), 10 deletions(-) diff --git a/src/Monocle/Backend/Documents.hs b/src/Monocle/Backend/Documents.hs index b9424ba4f..4b36563df 100644 --- a/src/Monocle/Backend/Documents.hs +++ b/src/Monocle/Backend/Documents.hs @@ -48,7 +48,7 @@ instance From ChangePB.Ident Author where Author { authorMuid = identMuid , authorUid = identUid - , authorGroups = mempty + , authorGroups = toList identGroups } fromMaybeIdent :: Maybe ChangePB.Ident -> Author diff --git a/src/Monocle/Backend/Janitor.hs b/src/Monocle/Backend/Janitor.hs index c2829c0ea..4cd4c3257 100644 --- a/src/Monocle/Backend/Janitor.hs +++ b/src/Monocle/Backend/Janitor.hs @@ -28,13 +28,13 @@ import Streaming.Prelude qualified as Streaming updateAuthor :: Config.Index -> D.Author -> D.Author updateAuthor index author@D.Author {..} = case getIdent of - Just ident -> D.Author ident authorUid mempty + Just (identMuid, identGroups) -> D.Author (from identMuid) authorUid (from <$> identGroups) Nothing - | newMuid /= from authorMuid -> D.Author (from newMuid) authorUid mempty + | newMuid /= from authorMuid -> D.Author (from newMuid) authorUid authorGroups | otherwise -> author where - getIdent :: Maybe LText - getIdent = from . fst <$> Config.getIdentByAlias index (from authorUid) + getIdent :: Maybe (Text, [Text]) + getIdent = Config.getIdentByAlias index (from authorUid) -- Remove the host prefix newMuid = T.drop 1 $ T.dropWhile (/= '/') (from authorUid) diff --git a/src/Monocle/Backend/Test.hs b/src/Monocle/Backend/Test.hs index fa74da53a..647c437b3 100644 --- a/src/Monocle/Backend/Test.hs +++ b/src/Monocle/Backend/Test.hs @@ -185,6 +185,10 @@ testIndexChanges = withTenant doTest (I.getChangeDocId fakeChange1) echangeTitle (echangeTitle fakeChange1) + checkEChangeField + (I.getChangeDocId fakeChange1) + echangeAuthor + (echangeAuthor fakeChange1) checkDocExists' $ I.getChangeDocId fakeChange2 checkEChangeField (I.getChangeDocId fakeChange2) @@ -230,6 +234,7 @@ testIndexChanges = withTenant doTest , echangeTitle = title , echangeRepositoryFullname = "fakerepo" , echangeUrl = "https://fakehost/change/" <> show number + , echangeAuthor = Author "John" "John" ["dev", "core"] } testIndexEvents :: Assertion @@ -598,12 +603,10 @@ testJanitorUpdateIdents = do , crawlers = [] , crawlers_api_key = Nothing , projects = Nothing - , idents = Just [mkIdent ["github.com/john"] "John Doe"] + , idents = Just [Config.Ident ["github.com/john"] (Just ["dev", "core"]) "John Doe"] , search_aliases = Nothing } - mkIdent :: [Text] -> Text -> Config.Ident - mkIdent uid = Config.Ident uid Nothing - expectedAuthor = Author "John Doe" "github.com/john" mempty + expectedAuthor = Author "John Doe" "github.com/john" ["dev", "core"] doUpdateIndentOnEventsTest :: Eff [MonoQuery, ElasticEffect, LoggerEffect, IOE] () doUpdateIndentOnEventsTest = E.runFailIO do @@ -617,7 +620,7 @@ testJanitorUpdateIdents = do evt2' <- I.getChangeEventById $ I.getEventDocId evt2 assertEqual' "Ensure event not changed" evt2' $ Just evt2 where - evt1 = mkEventWithAuthor "e1" (Author "john" "github.com/john" mempty) + evt1 = mkEventWithAuthor "e1" (Author "john" "github.com/john" ["not-core"]) evt2 = mkEventWithAuthor "e2" (Author "paul" "github.com/paul" mempty) mkEventWithAuthor :: -- eventId From 5daa879f3b8bf19551c2d74e99cdc1ce63a43ff0 Mon Sep 17 00:00:00 2001 From: Fabien Boucher Date: Mon, 11 Dec 2023 08:03:44 +0000 Subject: [PATCH 5/6] tests - add mkAuthorWithNoGroup --- src/Monocle/Backend/Test.hs | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/Monocle/Backend/Test.hs b/src/Monocle/Backend/Test.hs index 647c437b3..383cb33cb 100644 --- a/src/Monocle/Backend/Test.hs +++ b/src/Monocle/Backend/Test.hs @@ -40,12 +40,15 @@ fakeDate, fakeDateAlt :: UTCTime fakeDate = [utctime|2021-05-31 10:00:00|] fakeDateAlt = [utctime|2021-06-01 20:00:00|] +mkAuthorWithNoGroup :: LText -> LText -> Author +mkAuthorWithNoGroup muid uid = Author muid uid mempty + alice, bob, eve, fakeAuthor, fakeAuthorAlt :: Author -alice = Author "alice" "a" mempty -bob = Author "bob" "b" mempty -eve = Author "eve" "e" mempty -fakeAuthor = Author "John" "John" mempty -fakeAuthorAlt = Author "John Doe/12" "review.opendev.org/John Doe/12" mempty +alice = mkAuthorWithNoGroup "alice" "a" +bob = mkAuthorWithNoGroup "bob" "b" +eve = mkAuthorWithNoGroup "eve" "e" +fakeAuthor = mkAuthorWithNoGroup "John" "John" +fakeAuthorAlt = mkAuthorWithNoGroup "John Doe/12" "review.opendev.org/John Doe/12" fakeChangePB :: ChangePB.Change fakeChangePB = From bc62195b32acf2a6f43e7831db670c3de36ec5d4 Mon Sep 17 00:00:00 2001 From: Fabien Boucher Date: Tue, 12 Dec 2023 08:44:50 +0000 Subject: [PATCH 6/6] changelogs - for new groups field --- CHANGELOG.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 580f03bc9..e841313a7 100644 --- a/CHANGELOG.md +++ b/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