zuul (empty) → 0.1.0.0
raw patch · 22 files changed
+1615/−0 lines, 22 filesdep +aesondep +aeson-prettydep +base
Dependencies added: aeson, aeson-pretty, base, bytestring, containers, directory, filepath, http-client, http-client-tls, optparse-generic, tasty, tasty-hunit, text, xdg-basedir, zuul
Files
- CHANGELOG.md +6/−0
- LICENSE +201/−0
- README.md +41/−0
- app/Main.hs +184/−0
- src/Zuul.hs +107/−0
- src/Zuul/Aeson.hs +29/−0
- src/Zuul/Job.hs +22/−0
- src/Zuul/JobConfig.hs +26/−0
- src/Zuul/Nodeset.hs +33/−0
- src/Zuul/Project.hs +42/−0
- src/Zuul/ProjectConfig.hs +68/−0
- src/Zuul/SourceContext.hs +23/−0
- src/Zuul/Status.hs +139/−0
- src/Zuul/Tenant.hs +23/−0
- test/Spec.hs +39/−0
- test/data/Job.json +86/−0
- test/data/Jobs.json +28/−0
- test/data/Project.json +138/−0
- test/data/Projects.json +20/−0
- test/data/Status.json +222/−0
- test/data/Tenants.json +47/−0
- zuul.cabal +91/−0
+ CHANGELOG.md view
@@ -0,0 +1,6 @@+# Changelog++## 0.1.0.0 (2021-02-18)++- Basic Zuul API data types.+- live-changes and nodepool-labels commands.
+ LICENSE view
@@ -0,0 +1,201 @@+ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ README.md view
@@ -0,0 +1,41 @@+# zuul++[](https://hackage.haskell.org/package/zuul)++A client library for [zuul](https://zuul-ci.org).++## Features++- JSON decoder for API endpoints.+- HTTP client helper functions.+- 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.+++## Contribute++Run tests:++```+$ cabal build+$ cabal test+```++Run cli:++```+$ cabal run zuul-cli -- --help+```++Install cli:++```+$ cabal install --installdir=~/.local/bin+```++Build container:++```+$ podman build -t quay.io/software-factory/zuul-stats .+```
+ app/Main.hs view
@@ -0,0 +1,184 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeOperators #-}++module Main (main) where++import Data.Aeson (FromJSON, ToJSON (..), eitherDecodeFileStrict, encodeFile, object, (.=))+import Data.Aeson.Encode.Pretty (encodePretty)+import Data.Aeson.Text (encodeToLazyText)+import Data.Map.Strict (Map, fromListWith, toList, unionsWith)+import Data.Text (Text, pack, unpack)+import qualified Data.Text as T+import qualified Data.Text.IO as Text+import Data.Text.Lazy (toStrict)+import Data.Text.Lazy.Encoding (decodeUtf8)+import Options.Generic+import System.Directory (createDirectoryIfMissing, doesFileExist)+import System.Environment (getArgs)+import System.Environment.XDG.BaseDir (getUserCacheDir)+import System.FilePath.Posix (splitFileName)+import Zuul+import qualified Zuul.Status++-- | An helper function to cache http query+withCache ::+ (FromJSON a, ToJSON a) =>+ ZuulClient ->+ -- | The query IO+ (ZuulClient -> IO a) ->+ -- | The name of the cache+ Text ->+ IO a+withCache client action cacheName = do+ baseCache <- getUserCacheDir "zuul-haskell"+ let basePath = T.replace "https://" "" (T.replace "http://" "" (baseUrl client))+ let cachePath = baseCache <> "/" <> unpack basePath <> unpack cacheName <> ".json"+ cached <- doesFileExist cachePath+ if cached+ then do+ value <- eitherDecodeFileStrict cachePath+ -- putStrLn ("Reading cache: " <> cachePath)+ case value of+ Left err -> error ("Couldn't decode " <> cachePath <> ":" <> err)+ Right x -> pure x+ else do+ createDirectoryIfMissing True (fst (splitFileName cachePath))+ value <- action client+ putStrLn ("Writting cache: " <> cachePath)+ encodeFile cachePath value+ pure value++-- | Get the list of tenant names+getTenantNames :: ZuulClient -> IO [Text]+getTenantNames client = 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"))++-- | Get the list of job names+getJobNames :: Text -> ZuulClient -> IO [Text]+getJobNames tenant client = fmap (fmap jobName) (withCache client getJobs (tenant <> "/jobs"))++----------------------------------------------------------------------------------------------------+-- Label usages+----------------------------------------------------------------------------------------------------+type LabelName = Text++data LabelUsage = LabelUsage+ { luNodesetName :: Text,+ luTenantName :: Text,+ luJobName :: Text,+ luSourceContext :: SourceContext+ }+ deriving (Show, Eq, Ord)++instance ToJSON LabelUsage where+ toJSON LabelUsage {..} =+ object+ [ "nodeset" .= luNodesetName,+ "tenant" .= luTenantName,+ "job" .= luJobName,+ "source_context" .= luSourceContext+ ]++-- | Convert a nodeset and extra data to a LabelUsage+nodesetToLabel :: Text -> Text -> SourceContext -> Nodeset -> [(LabelName, [LabelUsage])]+nodesetToLabel tenant job sc nodeset = nodeToLabel <$> nodesetNodes nodeset+ where+ nodeToLabel :: Node -> (LabelName, [LabelUsage])+ 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+ where+ 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+ _ -> []++-- | Get LabelUsage of a tenant projects and jobs+getTenantNodepoolLabels :: ZuulClient -> Text -> IO (Map LabelName [LabelUsage])+getTenantNodepoolLabels client tenant = fromListWith (<>) <$> go+ 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++-- | 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+ Text.putStrLn $+ if json+ then toStrict (decodeUtf8 (encodePretty labels))+ else T.unlines (concatMap ppr (toList labels))+ where+ ppr :: (LabelName, [LabelUsage]) -> [Text]+ ppr (name, xs) = map (\lu -> name <> " " <> toStrict (encodeToLazyText lu)) xs++----------------------------------------------------------------------------------------------------+-- Live Changes+----------------------------------------------------------------------------------------------------+printLiveChanges :: Text -> Text -> Maybe Text -> IO ()+printLiveChanges url pipeline queue = withClient url $ \client -> do+ status <- getStatus client+ case Zuul.Status.pipelineChanges pipeline queue status of+ Just changes -> print (map Zuul.Status.changeProject (Zuul.Status.liveChanges changes))+ Nothing -> putStrLn "No pipeline found :("++----------------------------------------------------------------------------------------------------+-- Zuul CLI+----------------------------------------------------------------------------------------------------+data ZuulCli w+ = NodepoolLabels+ { url :: w ::: Text <?> "Zuul API url",+ json :: w ::: Bool <?> "Output JSON",+ tenant :: w ::: Maybe Text <?> "A tenant filter"+ }+ | LiveChanges+ { url :: w ::: Text <?> "Zuul API url",+ pipeline :: w ::: Text <?> "Pipeline name",+ queue :: w ::: Maybe Text <?> "Queue name"+ }+ deriving (Generic)++instance ParseRecord (ZuulCli Wrapped) where+ parseRecord = parseRecordWithModifiers lispCaseModifiers++main :: IO ()+main = do+ args <- unwrapRecord "Zuul stats client"+ case args of+ NodepoolLabels {..} -> printNodepoolLabels json url tenant+ LiveChanges {..} -> printLiveChanges url pipeline queue
+ src/Zuul.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | This module contains the zuul REST client+module Zuul+ ( -- * Client+ ZuulClient (baseUrl),+ withClient,+ onTenant,++ -- * Api+ getJobConfig,+ getJobs,+ getProjectConfig,+ getProjects,+ getStatus,+ getTenants,++ -- * Main data types+ Zuul.Job (..),+ Zuul.JobConfig (..),+ Zuul.Node (..),+ Zuul.Nodeset (..),+ Zuul.ProjectPipelineJob (..),+ Zuul.ProjectPipelineConfig (..),+ Zuul.ProjectPipeline (..),+ Zuul.ProjectConfig (..),+ Zuul.Project (..),+ Zuul.Status (..),+ Zuul.SourceContext (..),+ Zuul.Tenant (..),+ )+where++import Data.Aeson (FromJSON, decode, eitherDecode)+import Data.Maybe (fromJust)+import Data.Text (Text, unpack)+import qualified Data.Text as T+import Network.HTTP.Client (Manager, httpLbs, newManager, parseUrlThrow, requestHeaders, responseBody)+import Network.HTTP.Client.TLS (tlsManagerSettings)+import qualified Zuul.Job as Zuul+import qualified Zuul.JobConfig as Zuul+import qualified Zuul.Nodeset as Zuul+import qualified Zuul.Project as Zuul+import qualified Zuul.ProjectConfig as Zuul+import qualified Zuul.SourceContext as Zuul+import qualified Zuul.Status as Zuul+import qualified Zuul.Tenant as Zuul++-- | The ZuulClient record, use 'withClient' to create+data ZuulClient = ZuulClient+ { -- | the base url+ baseUrl :: Text,+ manager :: Manager+ }++-- | Create the 'ZuulClient'+withClient ::+ -- | The zuul api url+ Text ->+ -- | The callback+ (ZuulClient -> IO ()) ->+ -- | withClient performs the IO+ IO ()+withClient url callBack =+ do+ manager <- newManager tlsManagerSettings+ callBack (ZuulClient {..})+ where+ baseUrl = T.dropWhileEnd (== '/') url <> "/"++-- | Update a 'ZuulClient' to work on a tenant+onTenant :: ZuulClient -> Text -> ZuulClient+onTenant client tenant = client {baseUrl = baseUrl client <> "tenant/" <> tenant <> "/"}++zuulGet ::+ (FromJSON a) =>+ Text ->+ ZuulClient ->+ IO a+zuulGet path ZuulClient {..} =+ do+ initRequest <- parseUrlThrow (unpack $ baseUrl <> path)+ let request = initRequest {requestHeaders = [("Accept", "*/*")]}+ response <- httpLbs request manager+ case eitherDecode $ responseBody response of+ Left err -> error $ "Decoding of " <> show (responseBody response) <> " failed with: " <> err+ Right a -> pure a++-- | Read the status+getStatus :: ZuulClient -> IO Zuul.Status+getStatus = zuulGet "status"++getTenants :: ZuulClient -> IO [Zuul.Tenant]+getTenants = zuulGet "tenants"++getProjects :: ZuulClient -> IO [Zuul.Project]+getProjects = zuulGet "projects"++getProjectConfig :: ZuulClient -> Text -> IO Zuul.ProjectConfig+getProjectConfig client project = zuulGet ("project/" <> project) client++getJobs :: ZuulClient -> IO [Zuul.Job]+getJobs = zuulGet "jobs"++getJobConfig :: ZuulClient -> Text -> IO [Zuul.JobConfig]+getJobConfig client job = zuulGet ("job/" <> job) client
+ src/Zuul/Aeson.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE FlexibleContexts #-}++-- | Helper functions to derive JSON encoder/decoder+module Zuul.Aeson (zuulParseJSON, zuulToJSON) where++import Data.Aeson (GFromJSON, GToJSON', Options (fieldLabelModifier), Value, Zero, defaultOptions, genericParseJSON, genericToJSON)+import Data.Aeson.Types (Parser)+import Data.Char (isUpper, toLower)+import qualified Data.Text as T+import GHC.Generics (Generic, Rep)++zuulOptions :: T.Text -> Options+zuulOptions prefix = defaultOptions {fieldLabelModifier = recordToJson}+ where+ recordToJson = updateCase . drop (T.length prefix)+ updateCase [] = []+ updateCase (x : xs) = toLower x : updateCase' xs+ updateCase' [] = []+ updateCase' (x : xs)+ | isUpper x = '_' : toLower x : updateCase' xs+ | otherwise = x : updateCase' xs++-- | An helper function to implement the parseJSON class+zuulParseJSON :: (Generic a, GFromJSON Zero (Rep a)) => T.Text -> Value -> Parser a+zuulParseJSON = genericParseJSON . zuulOptions++-- | An helper function to implement the toJSON class+zuulToJSON :: (Generic a, GToJSON' Value Zero (Rep a)) => T.Text -> a -> Value+zuulToJSON = genericToJSON . zuulOptions
+ src/Zuul/Job.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++-- | The zuul job data type+module Zuul.Job (Job (..)) where++import Data.Aeson (FromJSON (..), ToJSON (..))+import Data.Text (Text)+import GHC.Generics (Generic)+import Zuul.Aeson (zuulParseJSON, zuulToJSON)++data Job = Job+ { jobName :: Text,+ jobDescription :: Maybe Text+ }+ deriving (Show, Eq, Ord, Generic)++instance ToJSON Job where+ toJSON = zuulToJSON "job"++instance FromJSON Job where+ parseJSON = zuulParseJSON "job"
+ src/Zuul/JobConfig.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++-- | The zuul job config data type+module Zuul.JobConfig (JobConfig (..)) where++import Data.Aeson (FromJSON (..), ToJSON (..))+import Data.Text (Text)+import GHC.Generics (Generic)+import Zuul.Aeson (zuulParseJSON, zuulToJSON)+import Zuul.Nodeset (Nodeset)+import Zuul.SourceContext (SourceContext)++data JobConfig = JobConfig+ { jcName :: Text,+ jcSourceContext :: Maybe SourceContext,+ jcDescription :: Maybe Text,+ jcNodeset :: Maybe Nodeset+ }+ deriving (Show, Eq, Ord, Generic)++instance ToJSON JobConfig where+ toJSON = zuulToJSON "jc"++instance FromJSON JobConfig where+ parseJSON = zuulParseJSON "jc"
+ src/Zuul/Nodeset.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++module Zuul.Nodeset (Nodeset (..), Node (..)) where++import Data.Aeson (FromJSON (..), ToJSON (..))+import Data.Text (Text)+import GHC.Generics (Generic)+import Zuul.Aeson (zuulParseJSON, zuulToJSON)++data Node = Node+ { nodeName :: Text,+ nodeLabel :: Text+ }+ deriving (Show, Eq, Ord, Generic)++data Nodeset = Nodeset+ { nodesetName :: Text,+ nodesetNodes :: [Node]+ }+ deriving (Show, Eq, Ord, Generic)++instance ToJSON Node where+ toJSON = zuulToJSON "node"++instance FromJSON Node where+ parseJSON = zuulParseJSON "node"++instance ToJSON Nodeset where+ toJSON = zuulToJSON "nodeset"++instance FromJSON Nodeset where+ parseJSON = zuulParseJSON "nodeset"
+ src/Zuul/Project.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++module Zuul.Project (Project (..), ProjectType (..)) where++import Data.Aeson (FromJSON (..), ToJSON (..), Value (String))+import Data.Aeson.Types (prependFailure, typeMismatch)+import Data.Text (Text)+import GHC.Generics (Generic)+import Zuul.Aeson (zuulParseJSON, zuulToJSON)++data ProjectType = ProjectConfig | ProjectUntrusted+ deriving (Show, Eq, Ord, Generic)++data Project = Project+ { projectName :: Text,+ projectType :: ProjectType,+ projectCanonicalName :: Text,+ projectConnectionName :: Text+ }+ deriving (Show, Eq, Ord, Generic)++instance ToJSON ProjectType where+ toJSON v = case v of+ ProjectConfig -> "config"+ ProjectUntrusted -> "untrusted"++instance FromJSON ProjectType where+ parseJSON (String s) = pure $ case s of+ "config" -> ProjectConfig+ "untrusted" -> ProjectUntrusted+ _ -> error "Received unrecognized ProjectType"+ parseJSON invalid =+ prependFailure+ "parsing ProjectType failed, "+ (typeMismatch "String" invalid)++instance ToJSON Project where+ toJSON = zuulToJSON "project"++instance FromJSON Project where+ parseJSON = zuulParseJSON "project"
+ src/Zuul/ProjectConfig.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++module Zuul.ProjectConfig+ ( ProjectPipeline (..),+ ProjectPipelineJob (..),+ ProjectPipelineConfig (..),+ ProjectConfig (..),+ )+where++import Data.Aeson (FromJSON (..), ToJSON (..))+import Data.Text (Text)+import GHC.Generics (Generic)+import Zuul.Aeson (zuulParseJSON, zuulToJSON)+import Zuul.Nodeset (Nodeset)+import Zuul.SourceContext (SourceContext)++data ProjectPipelineJob = ProjectPipelineJob+ { ppjName :: Text,+ ppjSourceContext :: SourceContext,+ ppjNodeset :: Maybe Nodeset+ }+ deriving (Show, Eq, Ord, Generic)++instance ToJSON ProjectPipelineJob where+ toJSON = zuulToJSON "ppj"++instance FromJSON ProjectPipelineJob where+ parseJSON = zuulParseJSON "ppj"++data ProjectPipeline = ProjectPipeline+ { ppName :: Text,+ ppJobs :: [[ProjectPipelineJob]]+ }+ deriving (Show, Eq, Ord, Generic)++instance ToJSON ProjectPipeline where+ toJSON = zuulToJSON "pp"++instance FromJSON ProjectPipeline where+ parseJSON = zuulParseJSON "pp"++data ProjectPipelineConfig = ProjectPipelineConfig+ { ppcDefaultBranch :: Maybe Text,+ ppcPipelines :: [ProjectPipeline]+ }+ deriving (Show, Eq, Ord, Generic)++instance ToJSON ProjectPipelineConfig where+ toJSON = zuulToJSON "ppc"++instance FromJSON ProjectPipelineConfig where+ parseJSON = zuulParseJSON "ppc"++data ProjectConfig = ProjectConfig+ { projectConfigName :: Text,+ projectConfigCanonicalName :: Text,+ projectConfigConnectionName :: Text,+ projectConfigConfigs :: [ProjectPipelineConfig]+ }+ deriving (Show, Eq, Ord, Generic)++instance ToJSON ProjectConfig where+ toJSON = zuulToJSON "projectConfig"++instance FromJSON ProjectConfig where+ parseJSON = zuulParseJSON "projectConfig"
+ src/Zuul/SourceContext.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++module Zuul.SourceContext (SourceContext (..)) where++import Data.Aeson (FromJSON (..), ToJSON (..), Value (String))+import Data.Aeson.Types (prependFailure, typeMismatch)+import Data.Text (Text)+import GHC.Generics (Generic)+import Zuul.Aeson (zuulParseJSON, zuulToJSON)++data SourceContext = SourceContext+ { scBranch :: Text,+ scPath :: Text,+ scProject :: Text+ }+ deriving (Show, Eq, Ord, Generic)++instance ToJSON SourceContext where+ toJSON = zuulToJSON "sc"++instance FromJSON SourceContext where+ parseJSON = zuulParseJSON "sc"
+ src/Zuul/Status.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | The zuul status data type+module Zuul.Status+ ( -- * Status data types+ JobStatus (..),+ Change (..),+ Changes (..),+ ChangeQueue (..),+ Pipeline (..),+ Status (..),++ -- * Convenient functions+ pipelineChanges,+ liveChanges,+ changeJobUuid,+ )+where++import Control.Monad (guard)+import Data.Aeson (FromJSON (..), ToJSON (..))+import Data.Maybe (fromJust, isJust)+import Data.Text (Text)+import GHC.Generics (Generic)+import Zuul.Aeson (zuulParseJSON, zuulToJSON)++data JobStatus = JobStatus+ { jobName :: Text,+ jobUuid :: Maybe Text,+ jobResult :: Maybe Text+ }+ deriving (Show, Eq, Ord, Generic)++instance FromJSON JobStatus where+ parseJSON = zuulParseJSON "job"++instance ToJSON JobStatus where+ toJSON = zuulToJSON "job"++data Change = Change+ { changeId :: Maybe Text,+ changeRef :: Text,+ changeProject :: Text,+ changeLive :: Bool,+ changeActive :: Bool,+ changeJobs :: [JobStatus]+ }+ deriving (Show, Eq, Ord, Generic)++instance FromJSON Change where+ parseJSON = zuulParseJSON "change"++instance ToJSON Change where+ toJSON = zuulToJSON "change"++newtype Changes = Changes [Change]+ deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)++data ChangeQueue = ChangeQueue+ { changeQueueName :: Text,+ changeQueueHeads :: [Changes]+ }+ deriving (Show, Eq, Ord, Generic)++instance FromJSON ChangeQueue where+ parseJSON = zuulParseJSON "changeQueue"++instance ToJSON ChangeQueue where+ toJSON = zuulToJSON "changeQueue"++data Pipeline = Pipeline+ { pipelineName :: Text,+ pipelineChangeQueues :: [ChangeQueue]+ }+ deriving (Show, Eq, Ord, Generic)++instance FromJSON Pipeline where+ parseJSON = zuulParseJSON "pipeline"++instance ToJSON Pipeline where+ toJSON = zuulToJSON "pipeline"++data Status = Status+ { statusZuulVersion :: Text,+ statusPipelines :: [Pipeline]+ }+ deriving (Show, Eq, Ord, Generic)++instance FromJSON Status where+ parseJSON = zuulParseJSON "status"++instance ToJSON Status where+ toJSON = zuulToJSON "status"++-- | Get the change from a pipeline+pipelineChanges ::+ -- | The pipeline name+ Text ->+ -- | An optional queue name+ Maybe Text ->+ -- | The status record+ Status ->+ -- | Returns an optional list of changes+ Maybe [Change]+pipelineChanges name queueName status =+ case filter (\c -> pipelineName c == name) (statusPipelines status) of+ [pipeline] -> Just $ processPipeline pipeline+ _ -> Nothing+ where+ processPipeline :: Pipeline -> [Change]+ processPipeline pipeline = concatMap processQueue (pipelineChangeQueues pipeline)+ processQueue :: ChangeQueue -> [Change]+ processQueue queue = case queueName of+ Just queueName' ->+ if changeQueueName queue == queueName'+ then concatMap processChanges (changeQueueHeads queue)+ else []+ Nothing -> concatMap processChanges (changeQueueHeads queue)+ processChanges :: Changes -> [Change]+ processChanges (Changes changes) = changes++-- | Filter the change that are live and active+liveChanges :: [Change] -> [Change]+liveChanges = filter (\c -> changeLive c && changeActive c)++-- | Extract the job uuids from a list of change+changeJobUuid :: [Change] -> [Text]+changeJobUuid = concatMap go+ where+ go :: Change -> [Text]+ go Change {..} = getUuids changeJobs+ getUuids :: [JobStatus] -> [Text]+ getUuids jobs = do+ job <- jobs+ guard $ isJust (jobUuid job)+ return $ fromJust $ jobUuid job
+ src/Zuul/Tenant.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++-- | The zuul tenant data type+module Zuul.Tenant (Tenant (..)) where++import Data.Aeson (FromJSON (..), ToJSON (..))+import Data.Text (Text)+import GHC.Generics (Generic)+import Zuul.Aeson (zuulParseJSON, zuulToJSON)++data Tenant = Tenant+ { tenantName :: Text,+ tenantProjects :: Int,+ tenantQueue :: Int+ }+ deriving (Show, Eq, Ord, Generic)++instance ToJSON Tenant where+ toJSON = zuulToJSON "tenant"++instance FromJSON Tenant where+ parseJSON = zuulParseJSON "tenant"
+ test/Spec.hs view
@@ -0,0 +1,39 @@+module Main (main) where++import Data.Aeson (decode)+import qualified Data.ByteString.Lazy as BSL+import Data.Maybe (isJust)+import Test.Tasty+import Test.Tasty.HUnit+import Zuul++main :: IO ()+main = defaultMain (testGroup "Tests" [encodingTests])++encodingTests :: TestTree+encodingTests =+ testGroup+ "FromJSON"+ [ decodeFp "Status.json" isStatus,+ decodeFp "Tenants.json" isTenants,+ decodeFp "Projects.json" isProjects,+ decodeFp "Project.json" isProjectConfig,+ decodeFp "Jobs.json" isJobs,+ decodeFp "Job.json" isJobConfigs+ ]+ where+ decodeFp fp check = testCase ("Test " <> fp) $ do+ fContent <- BSL.readFile ("./test/data/" <> fp)+ assertBool (fp <> " is decoded") (check (decode fContent))+ isProjectConfig :: Maybe Zuul.ProjectConfig -> Bool+ isProjectConfig = isJust+ isJobConfigs :: Maybe [Zuul.JobConfig] -> Bool+ isJobConfigs = isJust+ isJobs :: Maybe [Zuul.Job] -> Bool+ isJobs = isJust+ isProjects :: Maybe [Zuul.Project] -> Bool+ isProjects = isJust+ isTenants :: Maybe [Zuul.Tenant] -> Bool+ isTenants = isJust+ isStatus :: Maybe Zuul.Status -> Bool+ isStatus = isJust
+ test/data/Job.json view
@@ -0,0 +1,86 @@+[+ {+ "name": "cabal-test",+ "branches": [],+ "override_checkout": null,+ "files": [],+ "irrelevant_files": [],+ "variant_description": "",+ "source_context": {+ "project": "zuul/zuul-jobs",+ "branch": "master",+ "path": "zuul.d/haskell-jobs.yaml"+ },+ "description": "Run cabal test for a Haskell project.\n\nResponds to these variables:\n\n.. zuul:jobvar:: cabal_target\n\n The cabal target(s) to test.\n\n.. zuul:jobvar:: ghc_version\n\n Use the specified ghc version (``latest`` picks the latest).\n",+ "required_projects": [],+ "semaphore": null,+ "variables": {+ "ghc_version": "latest"+ },+ "extra_variables": {},+ "host_variables": {},+ "group_variables": {},+ "final": false,+ "abstract": false,+ "protected": null,+ "voting": true,+ "timeout": null,+ "tags": [],+ "provides": [],+ "requires": [],+ "dependencies": [],+ "attempts": 3,+ "roles": [+ {+ "target_name": "zuul-jobs",+ "type": "zuul",+ "project_canonical_name": "opendev.org/zuul/zuul-jobs",+ "implicit": true+ }+ ],+ "run": [+ {+ "path": "playbooks/haskell/cabal.yaml",+ "roles": [+ {+ "target_name": "zuul-jobs",+ "type": "zuul",+ "project_canonical_name": "opendev.org/zuul/zuul-jobs",+ "implicit": true+ }+ ],+ "secrets": [],+ "source_context": {+ "project": "zuul/zuul-jobs",+ "branch": "master",+ "path": "zuul.d/haskell-jobs.yaml"+ }+ }+ ],+ "pre_run": [+ {+ "path": "playbooks/haskell/pre.yaml",+ "roles": [+ {+ "target_name": "zuul-jobs",+ "type": "zuul",+ "project_canonical_name": "opendev.org/zuul/zuul-jobs",+ "implicit": true+ }+ ],+ "secrets": [],+ "source_context": {+ "project": "zuul/zuul-jobs",+ "branch": "master",+ "path": "zuul.d/haskell-jobs.yaml"+ }+ }+ ],+ "post_run": [],+ "cleanup_run": [],+ "post_review": null,+ "match_on_config_updates": true,+ "parent": "base",+ "ansible_version": null+ }+]
+ test/data/Jobs.json view
@@ -0,0 +1,28 @@+[+ {+ "name": "base",+ "variants": [+ {+ "parent": "base-minimal"+ }+ ]+ },+ {+ "name": "cabal-test",+ "description": "Run cabal test for a Haskell project.",+ "variants": [+ {+ "parent": "base"+ }+ ]+ },+ {+ "name": "dhall-diff",+ "description": "Ensure that generated configuration files are idempotent.",+ "variants": [+ {+ "parent": "base"+ }+ ]+ }+]
+ test/data/Project.json view
@@ -0,0 +1,138 @@+{+ "name": "ansible/awx",+ "connection_name": "github.com",+ "canonical_name": "github.com/ansible/awx",+ "configs": [+ {+ "default_branch": "devel",+ "merge_mode": "merge-resolve",+ "templates": [+ "python-awx"+ ],+ "pipelines": [+ {+ "queue_name": null,+ "name": "gate",+ "jobs": [+ [+ {+ "name": "awx-push-new-schema",+ "branches": [],+ "override_checkout": null,+ "files": [],+ "irrelevant_files": [],+ "variant_description": "",+ "source_context": {+ "project": "ansible/zuul-config",+ "branch": "master",+ "path": "zuul.d/projects.yaml"+ },+ "description": null,+ "required_projects": [],+ "semaphore": null,+ "variables": {},+ "extra_variables": {},+ "host_variables": {},+ "group_variables": {},+ "final": false,+ "abstract": false,+ "protected": null,+ "voting": false,+ "timeout": null,+ "tags": [],+ "provides": [],+ "requires": [],+ "dependencies": [+ {+ "name": "awx-api-lint",+ "soft": false+ },+ {+ "name": "awx-api",+ "soft": false+ },+ {+ "name": "awx-ui",+ "soft": false+ },+ {+ "name": "awx-swagger",+ "soft": false+ },+ {+ "name": "awx-ansible-modules",+ "soft": false+ }+ ],+ "attempts": 3,+ "roles": [],+ "run": [],+ "pre_run": [],+ "post_run": [],+ "cleanup_run": [],+ "post_review": null,+ "match_on_config_updates": true,+ "parent": "base",+ "ansible_version": null+ }+ ]+ ]+ }+ ]+ },+ {+ "default_branch": null,+ "merge_mode": null,+ "templates": [],+ "pipelines": [+ {+ "queue_name": "awx",+ "name": "check",+ "jobs": [+ [+ {+ "name": "awx-api-lint",+ "branches": [],+ "override_checkout": null,+ "files": [],+ "irrelevant_files": [],+ "variant_description": "",+ "source_context": {+ "project": "ansible/zuul-jobs",+ "branch": "master",+ "path": "zuul.d/templates.yaml"+ },+ "description": null,+ "required_projects": [],+ "semaphore": null,+ "variables": {},+ "extra_variables": {},+ "host_variables": {},+ "group_variables": {},+ "final": false,+ "abstract": false,+ "protected": null,+ "voting": true,+ "timeout": null,+ "tags": [],+ "provides": [],+ "requires": [],+ "dependencies": [],+ "attempts": 3,+ "roles": [],+ "run": [],+ "pre_run": [],+ "post_run": [],+ "cleanup_run": [],+ "post_review": null,+ "match_on_config_updates": true,+ "parent": "base",+ "ansible_version": null+ }+ ]+ ]+ }+ ]+ }+ ]+}
+ test/data/Projects.json view
@@ -0,0 +1,20 @@+[+ {+ "name": "ansible/ansible",+ "connection_name": "github.com",+ "canonical_name": "github.com/ansible/ansible",+ "type": "untrusted"+ },+ {+ "name": "ansible/awx",+ "connection_name": "github.com",+ "canonical_name": "github.com/ansible/awx",+ "type": "untrusted"+ },+ {+ "name": "ansible/zuul-config",+ "connection_name": "github.com",+ "canonical_name": "github.com/ansible/zuul-config",+ "type": "config"+ }+]
+ test/data/Status.json view
@@ -0,0 +1,222 @@+{+ "zuul_version": "3.19.0-1.el7",+ "trigger_event_queue": {+ "length": 0+ },+ "result_event_queue": {+ "length": 0+ },+ "management_event_queue": {+ "length": 0+ },+ "last_reconfigured": 1595009796000,+ "pipelines": [+ {+ "name": "check",+ "description": "Newly uploaded patchsets enter this pipeline to receive an\ninitial +/-1 Verified vote.\n",+ "change_queues": [+ {+ "name": "software-factory/sfinfo-haskell",+ "heads": [+ [+ {+ "active": true,+ "live": false,+ "url": "https://softwarefactory-project.io/r/18955",+ "ref": "refs/changes/55/18955/3",+ "id": "18955,3",+ "item_ahead": null,+ "items_behind": [+ "18957,2"+ ],+ "failing_reasons": [],+ "zuul_ref": "Z2210a470948c418b93f0dc19eb804a0b",+ "project": "software-factory/gerrit-haskell",+ "project_canonical": "softwarefactory-project.io/software-factory/gerrit-haskell",+ "enqueue_time": 1595014956841,+ "jobs": [],+ "owner": {+ "name": "Tristan de Cacqueray",+ "email": "tdecacqu@redhat.com",+ "username": "TristanCacqueray"+ },+ "remaining_time": null+ },+ {+ "active": true,+ "live": false,+ "url": "https://softwarefactory-project.io/r/18957",+ "ref": "refs/changes/57/18957/2",+ "id": "18957,2",+ "item_ahead": "18955,3",+ "items_behind": [+ "18877,2"+ ],+ "failing_reasons": [],+ "zuul_ref": "Z9303da8a5cb14880ab43a75fbf290cb3",+ "project": "software-factory/gerrit-haskell",+ "project_canonical": "softwarefactory-project.io/software-factory/gerrit-haskell",+ "enqueue_time": 1595014956841,+ "jobs": [],+ "owner": {+ "name": "Tristan de Cacqueray",+ "email": "tdecacqu@redhat.com",+ "username": "TristanCacqueray"+ },+ "remaining_time": null+ },+ {+ "active": true,+ "live": false,+ "url": "https://softwarefactory-project.io/r/18877",+ "ref": "refs/changes/77/18877/2",+ "id": "18877,2",+ "item_ahead": "18957,2",+ "items_behind": [+ "18960,2"+ ],+ "failing_reasons": [],+ "zuul_ref": "Z348f40c661ea419d93d7c41c93149702",+ "project": "software-factory/podman-haskell",+ "project_canonical": "softwarefactory-project.io/software-factory/podman-haskell",+ "enqueue_time": 1595014956842,+ "jobs": [],+ "owner": {+ "name": "Tristan de Cacqueray",+ "email": "tdecacqu@redhat.com",+ "username": "TristanCacqueray"+ },+ "remaining_time": null+ },+ {+ "active": true,+ "live": true,+ "url": "https://softwarefactory-project.io/r/18960",+ "ref": "refs/changes/60/18960/2",+ "id": "18960,2",+ "item_ahead": "18877,2",+ "items_behind": [],+ "failing_reasons": [],+ "zuul_ref": "Z45d80c3299b2410fa8b98c093b04d0e8",+ "project": "software-factory/sfinfo-haskell",+ "project_canonical": "softwarefactory-project.io/software-factory/sfinfo-haskell",+ "enqueue_time": 1595014956843,+ "jobs": [+ {+ "name": "linters",+ "dependencies": [],+ "elapsed_time": 4654,+ "remaining_time": 62846,+ "url": "stream/a5460a59705f485aa3e3ae279411e08d?logfile=console.log",+ "finger_url": null,+ "report_url": "linters",+ "result": null,+ "voting": true,+ "uuid": "a5460a59705f485aa3e3ae279411e08d",+ "execute_time": 1595014960.5013387,+ "start_time": 1595014960.556152,+ "end_time": null,+ "estimated_time": 67.5,+ "pipeline": "check",+ "canceled": false,+ "paused": false,+ "retry": false,+ "tries": 1,+ "queued": true,+ "node_labels": [],+ "node_name": null,+ "worker": {+ "name": "ze07.softwarefactory-project.io",+ "hostname": "ze07.softwarefactory-project.io"+ }+ },+ {+ "name": "haskell-stack-test",+ "dependencies": [],+ "elapsed_time": 4538,+ "remaining_time": 80462,+ "url": "stream/d2d74a3769d847bb8b52e98ab5c7c2a6?logfile=console.log",+ "finger_url": null,+ "report_url": "haskell-stack-test",+ "result": null,+ "voting": true,+ "uuid": "d2d74a3769d847bb8b52e98ab5c7c2a6",+ "execute_time": 1595014960.5694344,+ "start_time": 1595014960.6725166,+ "end_time": null,+ "estimated_time": 85.0,+ "pipeline": "check",+ "canceled": false,+ "paused": false,+ "retry": false,+ "tries": 1,+ "queued": true,+ "node_labels": [],+ "node_name": null,+ "worker": {+ "name": "ze04.softwarefactory-project.io",+ "hostname": "ze04.softwarefactory-project.io"+ }+ },+ {+ "name": "hlint",+ "dependencies": [],+ "elapsed_time": null,+ "remaining_time": null,+ "url": null,+ "finger_url": null,+ "report_url": null,+ "result": null,+ "voting": true,+ "uuid": null,+ "execute_time": null,+ "start_time": null,+ "end_time": null,+ "estimated_time": null,+ "pipeline": null,+ "canceled": null,+ "paused": null,+ "retry": null,+ "tries": 0,+ "queued": true,+ "node_labels": [],+ "node_name": null,+ "worker": null+ }+ ],+ "owner": {+ "name": "Tristan de Cacqueray",+ "email": "tdecacqu@redhat.com",+ "username": "TristanCacqueray"+ },+ "remaining_time": null+ }+ ]+ ],+ "window": 0+ }+ ]+ },+ {+ "name": "check",+ "description": "Newly uploaded patchsets enter this pipeline to receive an\ninitial +/-1 Verified vote.\n",+ "change_queues": []+ },+ {+ "name": "gate",+ "description": "Changes that have been approved by core developers are enqueued\nin order in this pipeline, and if they pass tests, will be\nmerged.\n",+ "change_queues": [+ {+ "name": "config",+ "heads": [],+ "window": 77+ }+ ]+ },+ {+ "name": "post",+ "description": "This pipeline runs jobs that operate after each change is merged.",+ "change_queues": []+ }+ ]+}
+ test/data/Tenants.json view
@@ -0,0 +1,47 @@+[+ {+ "name": "ansible",+ "projects": 5,+ "queue": 1+ },+ {+ "name": "containers-update",+ "projects": 7,+ "queue": 0+ },+ {+ "name": "fedora",+ "projects": 521,+ "queue": 3+ },+ {+ "name": "local",+ "projects": 902,+ "queue": 3+ },+ {+ "name": "opendev.org",+ "projects": 2,+ "queue": 0+ },+ {+ "name": "ovirt",+ "projects": 5,+ "queue": 0+ },+ {+ "name": "ovirt-staging",+ "projects": 5,+ "queue": 0+ },+ {+ "name": "packit-service",+ "projects": 14,+ "queue": 0+ },+ {+ "name": "rdoproject.org",+ "projects": 1095,+ "queue": 22+ }+]
+ zuul.cabal view
@@ -0,0 +1,91 @@+cabal-version: 2.4+name: zuul+version: 0.1.0.0+synopsis: A zuul client library+description:+ Zuul is a client library to interface with https://zuul-ci.org.+ .+ Use this library to query and decode zuul-web API.+ .+ Use the zuul-cli to compute informations.+ .+homepage: https://github.com/softwarefactory-project/zuul-haskell#readme+bug-reports: https://github.com/softwarefactory-project/zuul-haskell/issues+license: Apache-2.0+license-file: LICENSE+author: Tristan de Cacqueray+maintainer: tdecacqu@redhat.com+copyright: 2021 Red Hat+category: Development+build-type: Simple+extra-doc-files: CHANGELOG.md+ README.md+extra-source-files: test/data/*.json+tested-with: GHC == 8.10.3++source-repository head+ type: git+ location: https://github.com/softwarefactory-project/zuul-haskell.git++common common-options+ build-depends: base >= 4.11.0.0 && < 5+ , aeson >= 1.0.0.0 && < 1.6+ ghc-options: -Wall+ -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wredundant-constraints+ -Wno-unused-imports+ if impl(ghc >= 8.2)+ ghc-options: -fhide-source-paths+ if impl(ghc >= 8.4)+ ghc-options: -Wmissing-export-lists+ if impl(ghc >= 8.10)+ ghc-options: -Wunused-packages++ default-language: Haskell2010++library+ import: common-options+ build-depends: 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+ exposed-modules: Zuul+ , Zuul.Aeson+ , Zuul.Job+ , Zuul.JobConfig+ , Zuul.Project+ , Zuul.ProjectConfig+ , Zuul.SourceContext+ , Zuul.Nodeset+ , Zuul.Status+ , Zuul.Tenant++executable zuul-cli+ import: common-options+ hs-source-dirs: app+ main-is: Main.hs+ build-depends: aeson-pretty < 0.9+ , containers >= 0.5.8.0 && < 0.7+ , directory >= 1.3.0.0 && < 1.4+ , filepath >= 1.4 && < 1.5+ , optparse-generic < 1.5.0+ , text >= 0.11.1.0 && < 1.3+ , xdg-basedir < 0.3.0+ , zuul+ ghc-options: -threaded+ -rtsopts+ -with-rtsopts=-N++test-suite zuul-test+ import: common-options+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: bytestring < 0.11+ , tasty >= 0.11.2 && < 1.5+ , tasty-hunit >= 0.10 && < 0.11+ , zuul+ ghc-options: -Wall