From 48a3d373f1c25e74c28421204cf71b27efd3533c Mon Sep 17 00:00:00 2001 From: Fabien Boucher Date: Sat, 2 Dec 2023 16:43:09 +0000 Subject: [PATCH] crawler - ensure lentilles populate groups field of Ident --- src/Lentille.hs | 13 +++++++++---- src/Lentille/Gerrit.hs | 5 +++-- src/Lentille/GitHub/PullRequests.hs | 14 +++++++++++--- 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, 53 insertions(+), 27 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..c965f71a8 100644 --- a/src/Lentille/GitHub/PullRequests.hs +++ b/src/Lentille/GitHub/PullRequests.hs @@ -11,7 +11,15 @@ import Lentille import Lentille.GitHub.GraphQLFragments (fragmentPRData) import Lentille.GitHub.Types import Lentille.GitHub.Utils -import Lentille.GraphQL +import Lentille.GraphQL ( + GraphClient, + GraphEffects, + PageInfo (..), + RateLimit, + ghSchemaLocation, + streamFetch, + ) +import Monocle.Config qualified as Config import Monocle.Prelude hiding (id, state) import Monocle.Protob.Change @@ -46,7 +54,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 +70,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"