diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,6 @@ +# Changelog + +## 0.1.0.0 (2021-02-18) + +- Basic Zuul API data types. +- live-changes and nodepool-labels commands. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,41 @@ +# zuul + +[![Hackage](https://img.shields.io/hackage/v/zuul.svg)](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 . +``` diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -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 diff --git a/src/Zuul.hs b/src/Zuul.hs new file mode 100644 --- /dev/null +++ b/src/Zuul.hs @@ -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 diff --git a/src/Zuul/Aeson.hs b/src/Zuul/Aeson.hs new file mode 100644 --- /dev/null +++ b/src/Zuul/Aeson.hs @@ -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 diff --git a/src/Zuul/Job.hs b/src/Zuul/Job.hs new file mode 100644 --- /dev/null +++ b/src/Zuul/Job.hs @@ -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" diff --git a/src/Zuul/JobConfig.hs b/src/Zuul/JobConfig.hs new file mode 100644 --- /dev/null +++ b/src/Zuul/JobConfig.hs @@ -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" diff --git a/src/Zuul/Nodeset.hs b/src/Zuul/Nodeset.hs new file mode 100644 --- /dev/null +++ b/src/Zuul/Nodeset.hs @@ -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" diff --git a/src/Zuul/Project.hs b/src/Zuul/Project.hs new file mode 100644 --- /dev/null +++ b/src/Zuul/Project.hs @@ -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" diff --git a/src/Zuul/ProjectConfig.hs b/src/Zuul/ProjectConfig.hs new file mode 100644 --- /dev/null +++ b/src/Zuul/ProjectConfig.hs @@ -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" diff --git a/src/Zuul/SourceContext.hs b/src/Zuul/SourceContext.hs new file mode 100644 --- /dev/null +++ b/src/Zuul/SourceContext.hs @@ -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" diff --git a/src/Zuul/Status.hs b/src/Zuul/Status.hs new file mode 100644 --- /dev/null +++ b/src/Zuul/Status.hs @@ -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 diff --git a/src/Zuul/Tenant.hs b/src/Zuul/Tenant.hs new file mode 100644 --- /dev/null +++ b/src/Zuul/Tenant.hs @@ -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" diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -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 diff --git a/test/data/Job.json b/test/data/Job.json new file mode 100644 --- /dev/null +++ b/test/data/Job.json @@ -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 + } +] diff --git a/test/data/Jobs.json b/test/data/Jobs.json new file mode 100644 --- /dev/null +++ b/test/data/Jobs.json @@ -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" + } + ] + } +] diff --git a/test/data/Project.json b/test/data/Project.json new file mode 100644 --- /dev/null +++ b/test/data/Project.json @@ -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 + } + ] + ] + } + ] + } + ] +} diff --git a/test/data/Projects.json b/test/data/Projects.json new file mode 100644 --- /dev/null +++ b/test/data/Projects.json @@ -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" + } +] diff --git a/test/data/Status.json b/test/data/Status.json new file mode 100644 --- /dev/null +++ b/test/data/Status.json @@ -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": [] + } + ] +} diff --git a/test/data/Tenants.json b/test/data/Tenants.json new file mode 100644 --- /dev/null +++ b/test/data/Tenants.json @@ -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 + } +] diff --git a/zuul.cabal b/zuul.cabal new file mode 100644 --- /dev/null +++ b/zuul.cabal @@ -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