zuul 0.1.0.0 → 0.1.1.0

raw patch · 7 files changed

+159/−51 lines, 7 filesdep ~aesondep ~containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson, containers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• README.md +1/−1
• app/Main.hs +131/−43
• src/Zuul.hs +1/−0
• src/Zuul/JobConfig.hs +10/−3
• src/Zuul/ProjectConfig.hs +6/−1
• zuul.cabal +4/−3

@@ -1,5 +1,11 @@ # Changelog +## 0.1.1.0 (2022-03-31)++- Add variables to JobConfig and ProjectConfig.+- job-vars command.+- Allow aeson 2+ ## 0.1.0.0 (2021-02-18)  - Basic Zuul API data types.

@@ -11,7 +11,7 @@ - Command line utility to compute informations.   - live-changes: count the number of change running in a pipeline.   - nodepool-labels: get the label used in project pipelines.-+  - job-vars: get the job variables used in project pipelines.  ## Contribute 

@@ -10,7 +10,10 @@ import Data.Aeson (FromJSON, ToJSON (..), eitherDecodeFileStrict, encodeFile, object, (.=)) import Data.Aeson.Encode.Pretty (encodePretty) import Data.Aeson.Text (encodeToLazyText)+import qualified Data.List as L+import qualified Data.Map as M import Data.Map.Strict (Map, fromListWith, toList, unionsWith)+import Data.Maybe (mapMaybe) import Data.Text (Text, pack, unpack) import qualified Data.Text as T import qualified Data.Text.IO as Text@@ -52,20 +55,115 @@       encodeFile cachePath value       pure value +withTenantCache ::+  (FromJSON a, ToJSON a) =>+  ZuulClient ->+  Text ->+  -- | The query IO+  (ZuulClient -> IO a) ->+  -- | The name of the cache+  Text ->+  IO a+withTenantCache client tenant action cacheName =+  withCache (client `onTenant` tenant) action (tenant <> "/" <> cacheName)+ -- | Get the list of tenant names-getTenantNames :: ZuulClient -> IO [Text]-getTenantNames client = fmap (fmap tenantName) (withCache client getTenants "tenants")+getTenantNames :: ZuulClient -> Maybe Text -> IO [Text]+getTenantNames client tenantm =+  case tenantm of+    Just tenant -> pure [tenant]+    Nothing -> fmap (fmap tenantName) (withCache client getTenants "tenants")  -- | Get the list of project names-getProjectNames :: Text -> ZuulClient -> IO [Text]-getProjectNames tenant client =-  fmap (fmap projectCanonicalName) (withCache client getProjects (tenant <> "/projects"))+getProjectNames :: ZuulClient -> Text -> IO [Text]+getProjectNames client tenant =+  fmap (fmap projectCanonicalName) (withTenantCache client tenant getProjects "projects")  -- | Get the list of job names-getJobNames :: Text -> ZuulClient -> IO [Text]-getJobNames tenant client = fmap (fmap jobName) (withCache client getJobs (tenant <> "/jobs"))+getJobNames :: ZuulClient -> Text -> IO [Text]+getJobNames client tenant = fmap (fmap jobName) (withTenantCache client tenant getJobs "jobs") +-- | Get all the project configs+getProjectConfigs :: ZuulClient -> Text -> IO [ProjectConfig]+getProjectConfigs client tenant = do+  projectNames <- getProjectNames client tenant+  mapM getProjectCache projectNames+  where+    getProjectCache name = withTenantCache client tenant (`getProjectConfig` name) ("project/" <> name)++-- | Get all the jobs+getJobConfigs :: ZuulClient -> Text -> IO [JobConfig]+getJobConfigs client tenant = do+  jobNames <- getJobNames client tenant+  mconcat <$> mapM getJobCache jobNames+  where+    getJobCache name = withTenantCache client tenant (`getJobConfig` name) ("job/" <> name)++getConfigs :: ZuulClient -> Maybe Text -> IO [(Text, [ProjectConfig], [JobConfig])]+getConfigs client tenant = do+  tenants <- getTenantNames client tenant+  zip3 tenants+    <$> mapM (getProjectConfigs client) tenants+    <*> mapM (getJobConfigs client) tenants++getProjectJobs :: ProjectConfig -> [ProjectPipelineJob]+getProjectJobs =+  mconcat+    . mconcat+    . map Zuul.ppJobs+    . mconcat+    . map Zuul.ppcPipelines+    . Zuul.projectConfigConfigs+ ----------------------------------------------------------------------------------------------------+-- Vars usages+----------------------------------------------------------------------------------------------------+data VarUsage = VarUsage+  { vuTenantName :: Text,+    vuJobName :: Text,+    vuSourceContext :: SourceContext,+    vuVars :: [(Text, JobVariables)]+  }+  deriving (Show, Eq, Ord)++filterEmptyVars :: [(a, Map k b)] -> [(a, Map k b)]+filterEmptyVars = filter (not . M.null . snd)++getProjectJobVars :: Text -> ProjectPipelineJob -> VarUsage+getProjectJobVars tenant ProjectPipelineJob {..} = VarUsage tenant ppjName ppjSourceContext (filterEmptyVars vars)+  where+    vars =+      [ ("vars", ppjVariables),+        ("extra", ppjExtraVariables),+        ("host", ppjHostVariables),+        ("group", ppjGroupVariables)+      ]++getJobVars :: Text -> JobConfig -> Maybe VarUsage+getJobVars tenant JobConfig {..} = case jcSourceContext of+  Nothing -> Nothing+  Just sc -> Just $ VarUsage tenant jcName sc (filterEmptyVars vars)+  where+    vars =+      [ ("vars", jcVariables),+        ("extra", jcExtraVariables),+        ("host", jcHostVariables),+        ("group", jcGroupVariables)+      ]++getVars :: (Text, [ProjectConfig], [JobConfig]) -> [VarUsage]+getVars (tenant, pcs, jcs) = filter (not . L.null . vuVars) xs+  where+    xs = map (getProjectJobVars tenant) ppjs <> mapMaybe (getJobVars tenant) jcs+    ppjs = concatMap getProjectJobs pcs++printJobVars :: Maybe Text -> ZuulClient -> IO ()+printJobVars tenant client = do+  configs <- getConfigs client tenant+  let vars = concatMap getVars configs+  mapM_ print vars++---------------------------------------------------------------------------------------------------- -- Label usages ---------------------------------------------------------------------------------------------------- type LabelName = Text@@ -95,50 +193,35 @@     nodeToLabel Node {..} = (nodeLabel, [LabelUsage (nodesetName nodeset) tenant job sc])  -- | Get LabelUsage of a project-getProjectLabel :: ZuulClient -> Text -> Text -> IO [(LabelName, [LabelUsage])]-getProjectLabel client tenant project = do-  projectConfig <- withCache client (`getProjectConfig` project) (tenant <> "/project/" <> project)-  let jobs :: [ProjectPipelineJob]-      -- this penetrates the project config structure to get all the job in a flat list-      jobs = mconcat $ mconcat $ fmap ppJobs $ mconcat $ fmap ppcPipelines (projectConfigConfigs projectConfig)-  pure $ mconcat $ map projectPipelineJobToLabel jobs+getProjectLabel :: Text -> ProjectConfig -> [(LabelName, [LabelUsage])]+getProjectLabel tenant pc = mconcat $ map projectPipelineJobToLabel jobs   where+    jobs :: [ProjectPipelineJob]+    -- this penetrates the project config structure to get all the job in a flat list+    jobs = mconcat $ mconcat $ fmap ppJobs $ mconcat $ fmap ppcPipelines (projectConfigConfigs pc)     projectPipelineJobToLabel :: ProjectPipelineJob -> [(LabelName, [LabelUsage])]     projectPipelineJobToLabel ProjectPipelineJob {..} = case ppjNodeset of       Nothing -> []       Just nodeset -> nodesetToLabel tenant ppjName ppjSourceContext nodeset  -- | Get LabelUsage of a job-getJobLabel :: ZuulClient -> Text -> Text -> IO [(LabelName, [LabelUsage])]-getJobLabel client tenant job = do-  jobConfig <- withCache client (`getJobConfig` job) (tenant <> "/job/" <> job)-  pure $ mconcat $ map jobConfigToLabel jobConfig-  where-    jobConfigToLabel :: JobConfig -> [(LabelName, [LabelUsage])]-    jobConfigToLabel JobConfig {..} = case (jcNodeset, jcSourceContext) of-      (Just nodeset, Just sc) -> nodesetToLabel tenant job sc nodeset-      _ -> []+getJobLabel :: Text -> JobConfig -> [(LabelName, [LabelUsage])]+getJobLabel tenant JobConfig {..} = case (jcNodeset, jcSourceContext) of+  (Just nodeset, Just sc) -> nodesetToLabel tenant jcName sc nodeset+  _ -> []  -- | Get LabelUsage of a tenant projects and jobs-getTenantNodepoolLabels :: ZuulClient -> Text -> IO (Map LabelName [LabelUsage])-getTenantNodepoolLabels client tenant = fromListWith (<>) <$> go+getNodepoolLabels :: (Text, [ProjectConfig], [JobConfig]) -> Map LabelName [LabelUsage]+getNodepoolLabels (tenant, pcs, jcs) = fromListWith (<>) labels   where-    tenantClient = client `onTenant` tenant-    go :: IO [(LabelName, [LabelUsage])]-    go = do-      projectNames <- getProjectNames tenant tenantClient-      projectLabels <- mconcat <$> mapM (getProjectLabel tenantClient tenant) projectNames-      jobNames <- getJobNames tenant tenantClient-      jobLabels <- mconcat <$> mapM (getJobLabel tenantClient tenant) jobNames-      pure $ jobLabels <> projectLabels+    labels :: [(LabelName, [LabelUsage])]+    labels = concatMap (getProjectLabel tenant) pcs <> concatMap (getJobLabel tenant) jcs  -- | Print LabelUsage of one or all tenants-printNodepoolLabels :: Bool -> Text -> Maybe Text -> IO ()-printNodepoolLabels json url tenant = withClient url $ \client -> do-  tenants <- case tenant of-    Nothing -> getTenantNames client-    Just tenant' -> pure [tenant']-  labels <- unionsWith (<>) <$> mapM (getTenantNodepoolLabels client) tenants+printNodepoolLabels :: Bool -> Maybe Text -> ZuulClient -> IO ()+printNodepoolLabels json tenant client = do+  configs <- getConfigs client tenant+  let labels = unionsWith (<>) (map getNodepoolLabels configs)   Text.putStrLn $     if json       then toStrict (decodeUtf8 (encodePretty labels))@@ -150,8 +233,8 @@ ---------------------------------------------------------------------------------------------------- -- Live Changes -----------------------------------------------------------------------------------------------------printLiveChanges :: Text -> Text -> Maybe Text -> IO ()-printLiveChanges url pipeline queue = withClient url $ \client -> do+printLiveChanges :: Text -> Maybe Text -> ZuulClient -> IO ()+printLiveChanges pipeline queue client = do   status <- getStatus client   case Zuul.Status.pipelineChanges pipeline queue status of     Just changes -> print (map Zuul.Status.changeProject (Zuul.Status.liveChanges changes))@@ -166,6 +249,10 @@         json :: w ::: Bool <?> "Output JSON",         tenant :: w ::: Maybe Text <?> "A tenant filter"       }+  | JobVars+      { url :: w ::: Text <?> "Zuul API url",+        tenant :: w ::: Maybe Text <?> "A tenant filter"+      }   | LiveChanges       { url :: w ::: Text <?> "Zuul API url",         pipeline :: w ::: Text <?> "Pipeline name",@@ -180,5 +267,6 @@ main = do   args <- unwrapRecord "Zuul stats client"   case args of-    NodepoolLabels {..} -> printNodepoolLabels json url tenant-    LiveChanges {..} -> printLiveChanges url pipeline queue+    NodepoolLabels {..} -> withClient url (printNodepoolLabels json tenant)+    JobVars {..} -> withClient url (printJobVars tenant)+    LiveChanges {..} -> withClient url (printLiveChanges pipeline queue)

@@ -29,6 +29,7 @@     Zuul.Status (..),     Zuul.SourceContext (..),     Zuul.Tenant (..),+    Zuul.JobVariables,   ) where 

@@ -2,20 +2,27 @@ {-# LANGUAGE OverloadedStrings #-}  -- | The zuul job config data type-module Zuul.JobConfig (JobConfig (..)) where+module Zuul.JobConfig (JobConfig (..), JobVariables) where -import Data.Aeson (FromJSON (..), ToJSON (..))+import Data.Aeson (FromJSON (..), ToJSON (..), Value)+import Data.Map.Strict (Map) import Data.Text (Text) import GHC.Generics (Generic) import Zuul.Aeson (zuulParseJSON, zuulToJSON) import Zuul.Nodeset (Nodeset) import Zuul.SourceContext (SourceContext) +type JobVariables = Map Text Value+ data JobConfig = JobConfig   { jcName :: Text,     jcSourceContext :: Maybe SourceContext,     jcDescription :: Maybe Text,-    jcNodeset :: Maybe Nodeset+    jcNodeset :: Maybe Nodeset,+    jcVariables :: JobVariables,+    jcExtraVariables :: JobVariables,+    jcHostVariables :: JobVariables,+    jcGroupVariables :: JobVariables   }   deriving (Show, Eq, Ord, Generic) 

@@ -13,13 +13,18 @@ import Data.Text (Text) import GHC.Generics (Generic) import Zuul.Aeson (zuulParseJSON, zuulToJSON)+import Zuul.JobConfig (JobVariables) import Zuul.Nodeset (Nodeset) import Zuul.SourceContext (SourceContext)  data ProjectPipelineJob = ProjectPipelineJob   { ppjName :: Text,     ppjSourceContext :: SourceContext,-    ppjNodeset :: Maybe Nodeset+    ppjNodeset :: Maybe Nodeset,+    ppjVariables :: JobVariables,+    ppjExtraVariables :: JobVariables,+    ppjHostVariables :: JobVariables,+    ppjGroupVariables :: JobVariables   }   deriving (Show, Eq, Ord, Generic) 

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                zuul-version:             0.1.0.0+version:             0.1.1.0 synopsis:            A zuul client library description:     Zuul is a client library to interface with https://zuul-ci.org.@@ -29,7 +29,7 @@  common common-options   build-depends:       base                   >= 4.11.0.0 && < 5-                     , aeson                  >= 1.0.0.0  && < 1.6+                     , aeson                  >= 1.0.0.0  && < 2.1   ghc-options:         -Wall                        -Wcompat                        -Widentities@@ -48,7 +48,8 @@  library   import:              common-options-  build-depends:       http-client            >= 0.5.0    && < 0.8+  build-depends:       containers             <  0.7+                     , http-client            >= 0.5.0    && < 0.8                      , http-client-tls        >= 0.2.0    && < 0.4                      , text                   >= 0.11.1.0 && < 1.3   hs-source-dirs:      src