diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,82 @@ # Changelog +## next +- 'repoquery': new experimental command + +## 1.0.0 (2022-02-21) +- rpm's _sourcedir is now acts as a source cache directory: + sources are in the package dir, but may be hardlinks to _sourcedir +- getSources checks compression integrity to re-download partial tarballs + and missing sources entries now only prompt once +- initial support for %autorelease (#24) +- 'build': consolidate nvr output +- 'build': skip branch if already built +- 'build': --changelog-notes to use spec changelog for Bodhi notes +- 'bump': new --local switch +- 'commit': --first-line to only use 1st line from changelog +- 'commit': --staged to only commit staged changes +- 'commit': extract incremental commit message from diff +- 'copr': --exclude-arch option +- 'count': new command to count packages with .spec files +- 'diff': new --status, --filter and --filter-not options +- 'log' renamed to 'compare' +- 'mock': use system arch, not hardcoded to x86_64 +- 'parallel': more compact and precise output +- 'parallel': only sleep 3s for job start and 1s when job still pending +- 'parallel': error with pending package layers and number of packages +- 'parallel': new --skip-to-layer option for restarting after failure +- 'prep': --clone option +- 'prep': install any required srpm macros (golang, rust, fonts) +- 'reviews': output one line per package +- 'switch': informative error when detached and use "git switch" +- 'update': --source-only to update sources without version bump +- 'update': add --force to re-download sources from upstream +- 'update': check changelog versions before bumping +- 'update': use --allow-head for updating a detached rebase +- error with package name when no .spec file found +- Merge: rebase after non-ancestor merge +- ListReviews: use anonymous bugzilla queries +- checkOnBranch and gitCurrentBranch now prompt if detached HEAD + +- update to bugzilla-redhat-1.0 and use API key bzApiKeySession +- 'build': build by branch by default instead of by package, if >1 package +- 'build': --[no-]waitrepo option changes default behavior with autoupdate +- 'commit': replace --staged with --unstaged +- 'commit': tweak changelog filter to "+- " prefix +- 'copr': handle --all-fedora and --all-epel +- 'list': use pagure-hs release with new Object API +- 'mock': add --no-clean-all and --shell to enter chroot after building +- 'parallel': output enhancements +- 'prep': add --pull option (alternative to --clone) +- 'prep': add --verbose for prep output +- 'pull': add --lenient to ignore non-git dirs/files +- 'pull': handle old master branch better +- 'push': new git push command +- 'rename-master' renamed to 'rename-rawhide' +- 'request-branches': output branch names with newline +- 'scratch': print package header by default +- 'sort': add --parallel option to group dependent packages +- 'update': only run spectool -g once with --force +- 'update': only sed edit sources if it exists +- 'update': improve the mver/pkg/dirty logic +- Bodhi: fix for aeson-2.0 +- Bugzilla: getBzUser save email id in ~/.config/fbrnch/bugzilla +- Bugzilla: many queries now use anonymous session +- Krb: factor out klistEntryFedora adding maybeFasIdFromKrb +- Krb: klist errors if no tickets +- Package: add checkLookasideCache to checkSourcesMatch +- Package: builtRpms: check in %_rpmdir if not distgit +- Package: fix lookaside check url +- Package: handle Dynamic BRs locally +- Package: refactor checkCompression +- allow anonymous cloning of packages +- decouple bodhi-hs, copr-hs, pagure-hs, pdc-hs +- fedora-dists-2.0 was released: remove the submodule +- kojiWatchTask: don't backtrace for task failure +- latest fedora-dists uses cached-json-file & has better releaseBranch err +- readme: note https checkouts currently assumed anonymous (#27) +- require rpm-nvr-0.1.1 for VerComp bugfix + ## 0.9.1.1 (2021-08-01) - getSources: fix mixup between sources and patches - 'reviews': add --pattern for package prefix diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -96,7 +96,7 @@ One can change the branch of one or more packages: ``` -$ fbrnch switch f34 [package] ... +$ fbrnch switch f35 [package] ... ``` You can also git pull over packages: @@ -144,13 +144,13 @@ You can merge branches with: ``` -$ fbrnch merge f33 package +$ fbrnch merge f34 package ``` -which will offer to merge f34 (or some of it) into f33. +which will offer to merge f35 (or some of it) into f34. Merging can also be done together with building: ``` -$ fbrnch build f34 package +$ fbrnch build f35 package ``` will ask if you want to merge newer commits from a newer branch, then push and build it. @@ -233,9 +233,9 @@ ``` $ fbrnch --version -0.9.1.1 +1.0.0 $ fbrnch --help -Fedora package branch building tool +Fedora branch building tool Usage: fbrnch [--version] COMMAND This tool helps with updating and building package branches @@ -264,7 +264,7 @@ local Build locally srpm Build srpm diff Diff local changes - log Show commits between branches + compare Show commits between branches mock Local mock build install-deps Install package build dependencies install Build locally and install package(s) @@ -273,6 +273,7 @@ bump Bump release for package commit Git commit packages pull Git pull packages + push Git push packages create-review Create a Package Review request update-review Update a Package Review review-package Run fedora-review on a package Review Request bug @@ -284,39 +285,18 @@ find-review Find package review bug command Run shell command in package dirs ($p) copr Build package(s) in Fedora Copr - rename-master Rename local master branch to rawhide + rename-rawhide Rename local 'master' branch to 'rawhide' + count Count number of living packages graph Output dependency graph ``` -## Known issues -- parallel builds will push local package commits without asking -- currently it only checks if already built by NVR not githash -- authentication is not implemented yet natively for Koji, Bodhi, Pagure - (and source upload) - - so python clients are used for "writing" - (specifically koji, bodhi-client, fedpkg), - but all queries are done directly by Web APIs for speed and control. - -## Motivation, history, talks -This project started off (as "fedbrnch") basically as a simple tool to -build a package across branches (ie for current releases). Then bugzilla -and Bodhi integration was added, and gradually more features, including -some generic commands across packages which had already been done before -in fedora-haskell-tools. - -I have given a couple of short talks about fbranch: -- Nest with Fedora: [youtube](https://www.youtube.com/watch?v=40kTBsA674U) and [slides](https://github.com/juhp/presentations/blob/master/fedora-nest-2020-fbrnch/fbrnch-nest.md) -- Lightning talk at devconf.cz 2021: [youtube](https://www.youtube.com/watch?v=O2-6rDuPMRA&t=2s) - ## Installation fbrnch is packaged in Fedora: `sudo dnf install fbrnch`. ## Build from source 1. Install openssl-devel -2. Clone the git repo and in the source dir, setup the git submodules: - -`git submodule update --init` +2. Clone the git repo. 3. Then either: @@ -345,6 +325,28 @@ - klist and fkinit - git - ssh & scp (for uploading package reviews) +- bugzilla API key + +## Known issues +- parallel builds will push local package commits without asking +- currently it only checks if already built by NVR not githash +- authentication is not implemented yet natively for Koji, Bodhi, Pagure + (and source upload) + - so python clients are used for "writing" + (specifically koji, bodhi-client, fedpkg), + but all queries are done directly by Web APIs for speed and control. +- https checkouts are currently assumed to an anonymous git checkouts + +## Motivation, history, talks +This project started off (as "fedbrnch") basically as a simple tool to +build a package across branches (ie for current releases). Then bugzilla +and Bodhi integration was added, and gradually more features, including +some generic commands across packages which had already been done before +in fedora-haskell-tools. + +I have given a couple of short talks about fbranch: +- Nest with Fedora: [youtube](https://www.youtube.com/watch?v=40kTBsA674U) and [slides](https://github.com/juhp/presentations/blob/master/fedora-nest-2020-fbrnch/fbrnch-nest.md) +- Lightning talk at devconf.cz 2021: [youtube](https://www.youtube.com/watch?v=O2-6rDuPMRA&t=2s) ## Contribute Bug reports, feedback, and pull requests welcome. diff --git a/fbrnch.cabal b/fbrnch.cabal --- a/fbrnch.cabal +++ b/fbrnch.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: fbrnch -version: 0.9.1.1 +version: 1.0.0 synopsis: Build and create Fedora package repos and branches description: fbrnch (fedora branch) is a convenient packaging tool for @@ -27,18 +27,13 @@ license-file: LICENSE author: Jens Petersen maintainer: Jens Petersen -copyright: 2019-2021 Jens Petersen +copyright: 2019-2022 Jens Petersen category: Distribution build-type: Simple extra-doc-files: CHANGELOG.md README.md - libs/bodhi-hs/LICENSE - libs/copr-hs/LICENSE - libs/fedora-dists/LICENSE - libs/pagure-hs/LICENSE - libs/pdc-hs/LICENSE tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, - GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.4 + GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.2 source-repository head type: git @@ -68,7 +63,8 @@ Cmd.Override Cmd.Parallel Cmd.PkgReview - Cmd.Pull + Cmd.Prep + Cmd.PullPush Cmd.Repoquery Cmd.RequestBranch Cmd.RequestRepo @@ -92,69 +88,51 @@ Pagure Paths_fbrnch Prompt - -- copr - Web.Fedora.Copr - Web.Fedora.Copr.API - -- fedora-dists - Distribution.Fedora - Distribution.Fedora.Branch - Distribution.Fedora.Products - Distribution.Fedora.ReadProducts - -- pdc - Fedora.PDC - -- bodhi - Fedora.Bodhi - -- pagure - Fedora.Pagure + Types hs-source-dirs: src - libs/copr-hs/src - libs/fedora-dists/src - libs/pdc-hs/src - libs/bodhi-hs/src - libs/pagure-hs/src default-language: Haskell2010 build-depends: aeson, async, -- pretty-terminal needs 4.9: base >= 4.9 && < 5, - -- bodhi, - bugzilla-redhat >= 0.3, + bodhi, + bugzilla-redhat >= 1.0, bytestring, config-ini, - -- copr, + copr-api, directory >= 1.2.3, email-validate, extra, - -- fedora-dists > 2.0, + fedora-dists >= 2.0, filepath, http-conduit, http-directory >= 0.1.5, http-query, koji, network-uri, + -- (for simple_cmd_args < 0.1.7): optparse-applicative, - -- pagure, + pagure >= 0.1, pretty-terminal, process, + -- regex-tdfa, rpmbuild-order >= 0.4.5, - rpm-nvr, + rpm-nvr >= 0.1.1, simple-cmd >= 0.2.0, simple-cmd-args >= 0.1.6, text, time, typed-process >= 0.2.4.0, utf8-string, - xdg-basedir, - -- for copr: - unordered-containers, - -- for bodhi and pagure: - lens, - lens-aeson + unix, + xdg-basedir - if impl(ghc<8.0) + if impl(ghc<8.3) build-depends: semigroups + if impl(ghc<8.4) + build-depends: http-common < 0.8.3.4 ghc-options: -threaded -Wall diff --git a/libs/bodhi-hs/LICENSE b/libs/bodhi-hs/LICENSE deleted file mode 100644 --- a/libs/bodhi-hs/LICENSE +++ /dev/null @@ -1,21 +0,0 @@ -MIT License - -Copyright (c) 2020 Jens Petersen - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. diff --git a/libs/bodhi-hs/src/Fedora/Bodhi.hs b/libs/bodhi-hs/src/Fedora/Bodhi.hs deleted file mode 100644 --- a/libs/bodhi-hs/src/Fedora/Bodhi.hs +++ /dev/null @@ -1,187 +0,0 @@ -{-# LANGUAGE CPP, OverloadedStrings #-} - -{- | -Copyright: (c) 2020 Jens Petersen -SPDX-License-Identifier: MIT -Maintainer: Jens Petersen - -Fedora Bodhi REST client library --} - -module Fedora.Bodhi - ( bodhiBuild - , bodhiBuilds - , bodhiComment - , bodhiComments - , bodhiCSRF - , bodhiOverride - , bodhiOverrides - , bodhiOverrideDates - , bodhiPackages - , bodhiRelease - , bodhiReleases - , bodhiUpdate - , bodhiUpdates - , bodhiUser - , bodhiUsers - , lookupKey - , lookupKey' - , queryBodhi - , makeKey - , makeItem - , maybeKey - , Query - , QueryItem - ) where - -#if (defined(VERSION_lens_aeson)) -import Control.Lens -import Data.Aeson.Lens -#else -import Lens.Micro -import Lens.Micro.Aeson -#endif -import Data.Aeson.Types -import Data.Text (Text) -import Data.Time.LocalTime -import Network.HTTP.Query - -server :: String -server = "bodhi.fedoraproject.org" - --- | Returns build JSON for NVR --- --- https://bodhi.fedoraproject.org/docs/server_api/rest/builds.html#service-0 -bodhiBuild :: String -> IO Object -bodhiBuild nvr = do - res <- queryBodhi [] $ "builds" +/+ nvr - return $ res ^. _Object - --- | returns JSON list of builds --- --- https://bodhi.fedoraproject.org/docs/server_api/rest/builds.html#service-1 -bodhiBuilds :: Query -> IO [Object] -bodhiBuilds params = do - res <- queryBodhi params "builds/" - return $ res ^.. key "builds" . values . _Object - --- | Returns comment JSON for id --- --- https://bodhi.fedoraproject.org/docs/server_api/rest/comments.html#service-0 -bodhiComment :: String -> IO Object -bodhiComment cid = do - res <- queryBodhi [] $ "comments" +/+ cid - return $ res ^. _Object - --- | returns JSON list of comments --- --- https://bodhi.fedoraproject.org/docs/server_api/rest/comments.html#service-1 -bodhiComments :: Query -> IO [Object] -bodhiComments params = do - res <- queryBodhi params "comments/" - return $ res ^.. key "comments" . values . _Object - --- | Get CSRF token --- --- https://bodhi.fedoraproject.org/docs/server_api/rest/csrf.html -bodhiCSRF :: IO (Maybe Text) -bodhiCSRF = do - res <- queryBodhi [] "csrf" - return $ res ^? key "csrf_token" . _String - --- | Returns override JSON for NVR --- --- https://bodhi.fedoraproject.org/docs/server_api/rest/overrides.html#service-0 -bodhiOverride :: String -> IO (Maybe Object) -bodhiOverride nvr = do - res <- queryBodhi [] $ "overrides" +/+ nvr - return $ res ^? key "override" . _Object - --- | Returns override expiration and submission dates for NVR -bodhiOverrideDates :: String -> IO (Maybe (LocalTime,LocalTime)) -bodhiOverrideDates nvr = do - mobj <- bodhiOverride nvr - case mobj of - Nothing -> do - putStrLn $ "Override for " ++ nvr ++ " not found" - return Nothing - Just obj -> return $ readDates obj - where - readDates :: Object -> Maybe (LocalTime,LocalTime) - readDates = - parseMaybe $ \obj -> do - expire <- obj .: "expiration_date" - submit <- obj .: "submission_date" - return (expire,submit) - --- | returns JSON list of overrides --- --- https://bodhi.fedoraproject.org/docs/server_api/rest/overrides.html#service-1 -bodhiOverrides :: Query -> IO [Object] -bodhiOverrides params = do - res <- queryBodhi params "overrides/" - return $ res ^.. key "overrides" . values . _Object - --- | Packages query --- --- https://bodhi.fedoraproject.org/docs/server_api/rest/packages.html#service-0 -bodhiPackages :: Query -> IO [Object] -bodhiPackages params = do - res <- queryBodhi params "packages/" - return $ res ^.. key "packages" . values . _Object - --- | read releases metadata from Bodhi --- --- https://bodhi.fedoraproject.org/docs/server_api/rest/releases.html#service-0 -bodhiRelease :: String -> IO Object -bodhiRelease rel = do - res <- queryBodhi [] $ "releases" +/+ rel - return $ res ^. _Object - --- | read releases metadata from Bodhi --- --- https://bodhi.fedoraproject.org/docs/server_api/rest/releases.html#service-1 -bodhiReleases :: Query -> IO [Object] --- FIXME handle errors: --- fromList [("status",String "error"),("errors",Array [Object (fromList [("location",String "body"),("name",String "name"),("description",String "No such release")])])] -bodhiReleases params = do - res <- queryBodhi params "releases/" - return $ res ^.. key "releases" . values . _Object - --- | read an update from Bodhi --- --- https://bodhi.fedoraproject.org/docs/server_api/rest/updates.html#service-0 -bodhiUpdate :: String -> IO (Maybe Object) -bodhiUpdate update = do - res <- queryBodhi [] $ "updates" +/+ update - return $ res ^? key "update" . _Object - --- | search for updates on Bodhi --- --- https://bodhi.fedoraproject.org/docs/server_api/rest/updates.html#service-2 -bodhiUpdates :: Query -> IO [Object] -bodhiUpdates params = do - res <- queryBodhi params "updates/" - return $ res ^.. key "updates" . values . _Object - --- | user info from Bodhi --- --- https://bodhi.fedoraproject.org/docs/server_api/rest/users.html#service-0 -bodhiUser :: String -> IO Object -bodhiUser user = do - res <- queryBodhi [] $ "users" +/+ user - return $ res ^. _Object - --- | list users from Bodhi --- --- https://bodhi.fedoraproject.org/docs/server_api/rest/users.html#service-1 -bodhiUsers :: Query -> IO [Object] -bodhiUsers params = do - res <- queryBodhi params "users/" - return $ res ^.. key "users" . values . _Object - --- | low-level query -queryBodhi :: Query -> String -> IO Value -queryBodhi params path = - let url = "https://" ++ server +/+ path - in webAPIQuery url params diff --git a/libs/copr-hs/LICENSE b/libs/copr-hs/LICENSE deleted file mode 100644 --- a/libs/copr-hs/LICENSE +++ /dev/null @@ -1,674 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 3, 29 June 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The GNU General Public License is a free, copyleft license for -software and other kinds of works. - - The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -the GNU General Public License is intended to guarantee your freedom to -share and change all versions of a program--to make sure it remains free -software for all its users. We, the Free Software Foundation, use the -GNU General Public License for most of our software; it applies also to -any other work released this way by its authors. You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - - To protect your rights, we need to prevent others from denying you -these rights or asking you to surrender the rights. Therefore, you have -certain responsibilities if you distribute copies of the software, or if -you modify it: responsibilities to respect the freedom of others. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must pass on to the recipients the same -freedoms that you received. You must make sure that they, too, receive -or can get the source code. And you must show them these terms so they -know their rights. - - Developers that use the GNU GPL protect your rights with two steps: -(1) assert copyright on the software, and (2) offer you this License -giving you legal permission to copy, distribute and/or modify it. - - For the developers' and authors' protection, the GPL clearly explains -that there is no warranty for this free software. For both users' and -authors' sake, the GPL requires that modified versions be marked as -changed, so that their problems will not be attributed erroneously to -authors of previous versions. - - Some devices are designed to deny users access to install or run -modified versions of the software inside them, although the manufacturer -can do so. This is fundamentally incompatible with the aim of -protecting users' freedom to change the software. The systematic -pattern of such abuse occurs in the area of products for individuals to -use, which is precisely where it is most unacceptable. Therefore, we -have designed this version of the GPL to prohibit the practice for those -products. If such problems arise substantially in other domains, we -stand ready to extend this provision to those domains in future versions -of the GPL, as needed to protect the freedom of users. - - Finally, every program is threatened constantly by software patents. -States should not allow patents to restrict development and use of -software on general-purpose computers, but in those that do, we wish to -avoid the special danger that patents applied to a free program could -make it effectively proprietary. To prevent this, the GPL assures that -patents cannot be used to render the program non-free. - - The precise terms and conditions for copying, distribution and -modification follow. - - TERMS AND CONDITIONS - - 0. Definitions. - - "This License" refers to version 3 of the GNU General Public License. - - "Copyright" also means copyright-like laws that apply to other kinds of -works, such as semiconductor masks. - - "The Program" refers to any copyrightable work licensed under this -License. Each licensee is addressed as "you". "Licensees" and -"recipients" may be individuals or organizations. - - To "modify" a work means to copy from or adapt all or part of the work -in a fashion requiring copyright permission, other than the making of an -exact copy. The resulting work is called a "modified version" of the -earlier work or a work "based on" the earlier work. - - A "covered work" means either the unmodified Program or a work based -on the Program. - - To "propagate" a work means to do anything with it that, without -permission, would make you directly or secondarily liable for -infringement under applicable copyright law, except executing it on a -computer or modifying a private copy. Propagation includes copying, -distribution (with or without modification), making available to the -public, and in some countries other activities as well. - - To "convey" a work means any kind of propagation that enables other -parties to make or receive copies. Mere interaction with a user through -a computer network, with no transfer of a copy, is not conveying. - - An interactive user interface displays "Appropriate Legal Notices" -to the extent that it includes a convenient and prominently visible -feature that (1) displays an appropriate copyright notice, and (2) -tells the user that there is no warranty for the work (except to the -extent that warranties are provided), that licensees may convey the -work under this License, and how to view a copy of this License. If -the interface presents a list of user commands or options, such as a -menu, a prominent item in the list meets this criterion. - - 1. Source Code. - - The "source code" for a work means the preferred form of the work -for making modifications to it. "Object code" means any non-source -form of a work. - - A "Standard Interface" means an interface that either is an official -standard defined by a recognized standards body, or, in the case of -interfaces specified for a particular programming language, one that -is widely used among developers working in that language. - - The "System Libraries" of an executable work include anything, other -than the work as a whole, that (a) is included in the normal form of -packaging a Major Component, but which is not part of that Major -Component, and (b) serves only to enable use of the work with that -Major Component, or to implement a Standard Interface for which an -implementation is available to the public in source code form. A -"Major Component", in this context, means a major essential component -(kernel, window system, and so on) of the specific operating system -(if any) on which the executable work runs, or a compiler used to -produce the work, or an object code interpreter used to run it. - - The "Corresponding Source" for a work in object code form means all -the source code needed to generate, install, and (for an executable -work) run the object code and to modify the work, including scripts to -control those activities. However, it does not include the work's -System Libraries, or general-purpose tools or generally available free -programs which are used unmodified in performing those activities but -which are not part of the work. For example, Corresponding Source -includes interface definition files associated with source files for -the work, and the source code for shared libraries and dynamically -linked subprograms that the work is specifically designed to require, -such as by intimate data communication or control flow between those -subprograms and other parts of the work. - - The Corresponding Source need not include anything that users -can regenerate automatically from other parts of the Corresponding -Source. - - The Corresponding Source for a work in source code form is that -same work. - - 2. Basic Permissions. - - All rights granted under this License are granted for the term of -copyright on the Program, and are irrevocable provided the stated -conditions are met. This License explicitly affirms your unlimited -permission to run the unmodified Program. The output from running a -covered work is covered by this License only if the output, given its -content, constitutes a covered work. This License acknowledges your -rights of fair use or other equivalent, as provided by copyright law. - - You may make, run and propagate covered works that you do not -convey, without conditions so long as your license otherwise remains -in force. You may convey covered works to others for the sole purpose -of having them make modifications exclusively for you, or provide you -with facilities for running those works, provided that you comply with -the terms of this License in conveying all material for which you do -not control copyright. Those thus making or running the covered works -for you must do so exclusively on your behalf, under your direction -and control, on terms that prohibit them from making any copies of -your copyrighted material outside their relationship with you. - - Conveying under any other circumstances is permitted solely under -the conditions stated below. Sublicensing is not allowed; section 10 -makes it unnecessary. - - 3. Protecting Users' Legal Rights From Anti-Circumvention Law. - - No covered work shall be deemed part of an effective technological -measure under any applicable law fulfilling obligations under article -11 of the WIPO copyright treaty adopted on 20 December 1996, or -similar laws prohibiting or restricting circumvention of such -measures. - - When you convey a covered work, you waive any legal power to forbid -circumvention of technological measures to the extent such circumvention -is effected by exercising rights under this License with respect to -the covered work, and you disclaim any intention to limit operation or -modification of the work as a means of enforcing, against the work's -users, your or third parties' legal rights to forbid circumvention of -technological measures. - - 4. Conveying Verbatim Copies. - - You may convey verbatim copies of the Program's source code as you -receive it, in any medium, provided that you conspicuously and -appropriately publish on each copy an appropriate copyright notice; -keep intact all notices stating that this License and any -non-permissive terms added in accord with section 7 apply to the code; -keep intact all notices of the absence of any warranty; and give all -recipients a copy of this License along with the Program. - - You may charge any price or no price for each copy that you convey, -and you may offer support or warranty protection for a fee. - - 5. Conveying Modified Source Versions. - - You may convey a work based on the Program, or the modifications to -produce it from the Program, in the form of source code under the -terms of section 4, provided that you also meet all of these conditions: - - a) The work must carry prominent notices stating that you modified - it, and giving a relevant date. - - b) The work must carry prominent notices stating that it is - released under this License and any conditions added under section - 7. This requirement modifies the requirement in section 4 to - "keep intact all notices". - - c) You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable section 7 - additional terms, to the whole of the work, and all its parts, - regardless of how they are packaged. This License gives no - permission to license the work in any other way, but it does not - invalidate such permission if you have separately received it. - - d) If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has interactive - interfaces that do not display Appropriate Legal Notices, your - work need not make them do so. - - A compilation of a covered work with other separate and independent -works, which are not by their nature extensions of the covered work, -and which are not combined with it such as to form a larger program, -in or on a volume of a storage or distribution medium, is called an -"aggregate" if the compilation and its resulting copyright are not -used to limit the access or legal rights of the compilation's users -beyond what the individual works permit. Inclusion of a covered work -in an aggregate does not cause this License to apply to the other -parts of the aggregate. - - 6. Conveying Non-Source Forms. - - You may convey a covered work in object code form under the terms -of sections 4 and 5, provided that you also convey the -machine-readable Corresponding Source under the terms of this License, -in one of these ways: - - a) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. - - b) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that product - model, to give anyone who possesses the object code either (1) a - copy of the Corresponding Source for all the software in the - product that is covered by this License, on a durable physical - medium customarily used for software interchange, for a price no - more than your reasonable cost of physically performing this - conveying of source, or (2) access to copy the - Corresponding Source from a network server at no charge. - - c) Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, and - only if you received the object code with such an offer, in accord - with subsection 6b. - - d) Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to the - Corresponding Source in the same way through the same place at no - further charge. You need not require recipients to copy the - Corresponding Source along with the object code. If the place to - copy the object code is a network server, the Corresponding Source - may be on a different server (operated by you or a third party) - that supports equivalent copying facilities, provided you maintain - clear directions next to the object code saying where to find the - Corresponding Source. Regardless of what server hosts the - Corresponding Source, you remain obligated to ensure that it is - available for as long as needed to satisfy these requirements. - - e) Convey the object code using peer-to-peer transmission, provided - you inform other peers where the object code and Corresponding - Source of the work are being offered to the general public at no - charge under subsection 6d. - - A separable portion of the object code, whose source code is excluded -from the Corresponding Source as a System Library, need not be -included in conveying the object code work. - - A "User Product" is either (1) a "consumer product", which means any -tangible personal property which is normally used for personal, family, -or household purposes, or (2) anything designed or sold for incorporation -into a dwelling. In determining whether a product is a consumer product, -doubtful cases shall be resolved in favor of coverage. For a particular -product received by a particular user, "normally used" refers to a -typical or common use of that class of product, regardless of the status -of the particular user or of the way in which the particular user -actually uses, or expects or is expected to use, the product. A product -is a consumer product regardless of whether the product has substantial -commercial, industrial or non-consumer uses, unless such uses represent -the only significant mode of use of the product. - - "Installation Information" for a User Product means any methods, -procedures, authorization keys, or other information required to install -and execute modified versions of a covered work in that User Product from -a modified version of its Corresponding Source. The information must -suffice to ensure that the continued functioning of the modified object -code is in no case prevented or interfered with solely because -modification has been made. - - If you convey an object code work under this section in, or with, or -specifically for use in, a User Product, and the conveying occurs as -part of a transaction in which the right of possession and use of the -User Product is transferred to the recipient in perpetuity or for a -fixed term (regardless of how the transaction is characterized), the -Corresponding Source conveyed under this section must be accompanied -by the Installation Information. But this requirement does not apply -if neither you nor any third party retains the ability to install -modified object code on the User Product (for example, the work has -been installed in ROM). - - The requirement to provide Installation Information does not include a -requirement to continue to provide support service, warranty, or updates -for a work that has been modified or installed by the recipient, or for -the User Product in which it has been modified or installed. Access to a -network may be denied when the modification itself materially and -adversely affects the operation of the network or violates the rules and -protocols for communication across the network. - - Corresponding Source conveyed, and Installation Information provided, -in accord with this section must be in a format that is publicly -documented (and with an implementation available to the public in -source code form), and must require no special password or key for -unpacking, reading or copying. - - 7. Additional Terms. - - "Additional permissions" are terms that supplement the terms of this -License by making exceptions from one or more of its conditions. -Additional permissions that are applicable to the entire Program shall -be treated as though they were included in this License, to the extent -that they are valid under applicable law. If additional permissions -apply only to part of the Program, that part may be used separately -under those permissions, but the entire Program remains governed by -this License without regard to the additional permissions. - - When you convey a copy of a covered work, you may at your option -remove any additional permissions from that copy, or from any part of -it. (Additional permissions may be written to require their own -removal in certain cases when you modify the work.) You may place -additional permissions on material, added by you to a covered work, -for which you have or can give appropriate copyright permission. - - Notwithstanding any other provision of this License, for material you -add to a covered work, you may (if authorized by the copyright holders of -that material) supplement the terms of this License with terms: - - a) Disclaiming warranty or limiting liability differently from the - terms of sections 15 and 16 of this License; or - - b) Requiring preservation of specified reasonable legal notices or - author attributions in that material or in the Appropriate Legal - Notices displayed by works containing it; or - - c) Prohibiting misrepresentation of the origin of that material, or - requiring that modified versions of such material be marked in - reasonable ways as different from the original version; or - - d) Limiting the use for publicity purposes of names of licensors or - authors of the material; or - - e) Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or - - f) Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified versions of - it) with contractual assumptions of liability to the recipient, for - any liability that these contractual assumptions directly impose on - those licensors and authors. - - All other non-permissive additional terms are considered "further -restrictions" within the meaning of section 10. If the Program as you -received it, or any part of it, contains a notice stating that it is -governed by this License along with a term that is a further -restriction, you may remove that term. If a license document contains -a further restriction but permits relicensing or conveying under this -License, you may add to a covered work material governed by the terms -of that license document, provided that the further restriction does -not survive such relicensing or conveying. - - If you add terms to a covered work in accord with this section, you -must place, in the relevant source files, a statement of the -additional terms that apply to those files, or a notice indicating -where to find the applicable terms. - - Additional terms, permissive or non-permissive, may be stated in the -form of a separately written license, or stated as exceptions; -the above requirements apply either way. - - 8. Termination. - - You may not propagate or modify a covered work except as expressly -provided under this License. Any attempt otherwise to propagate or -modify it is void, and will automatically terminate your rights under -this License (including any patent licenses granted under the third -paragraph of section 11). - - However, if you cease all violation of this License, then your -license from a particular copyright holder is reinstated (a) -provisionally, unless and until the copyright holder explicitly and -finally terminates your license, and (b) permanently, if the copyright -holder fails to notify you of the violation by some reasonable means -prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. - - Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, you do not qualify to receive new licenses for the same -material under section 10. - - 9. Acceptance Not Required for Having Copies. - - You are not required to accept this License in order to receive or -run a copy of the Program. Ancillary propagation of a covered work -occurring solely as a consequence of using peer-to-peer transmission -to receive a copy likewise does not require acceptance. However, -nothing other than this License grants you permission to propagate or -modify any covered work. These actions infringe copyright if you do -not accept this License. Therefore, by modifying or propagating a -covered work, you indicate your acceptance of this License to do so. - - 10. Automatic Licensing of Downstream Recipients. - - Each time you convey a covered work, the recipient automatically -receives a license from the original licensors, to run, modify and -propagate that work, subject to this License. You are not responsible -for enforcing compliance by third parties with this License. - - An "entity transaction" is a transaction transferring control of an -organization, or substantially all assets of one, or subdividing an -organization, or merging organizations. If propagation of a covered -work results from an entity transaction, each party to that -transaction who receives a copy of the work also receives whatever -licenses to the work the party's predecessor in interest had or could -give under the previous paragraph, plus a right to possession of the -Corresponding Source of the work from the predecessor in interest, if -the predecessor has it or can get it with reasonable efforts. - - You may not impose any further restrictions on the exercise of the -rights granted or affirmed under this License. For example, you may -not impose a license fee, royalty, or other charge for exercise of -rights granted under this License, and you may not initiate litigation -(including a cross-claim or counterclaim in a lawsuit) alleging that -any patent claim is infringed by making, using, selling, offering for -sale, or importing the Program or any portion of it. - - 11. Patents. - - A "contributor" is a copyright holder who authorizes use under this -License of the Program or a work on which the Program is based. The -work thus licensed is called the contributor's "contributor version". - - A contributor's "essential patent claims" are all patent claims -owned or controlled by the contributor, whether already acquired or -hereafter acquired, that would be infringed by some manner, permitted -by this License, of making, using, or selling its contributor version, -but do not include claims that would be infringed only as a -consequence of further modification of the contributor version. For -purposes of this definition, "control" includes the right to grant -patent sublicenses in a manner consistent with the requirements of -this License. - - Each contributor grants you a non-exclusive, worldwide, royalty-free -patent license under the contributor's essential patent claims, to -make, use, sell, offer for sale, import and otherwise run, modify and -propagate the contents of its contributor version. - - In the following three paragraphs, a "patent license" is any express -agreement or commitment, however denominated, not to enforce a patent -(such as an express permission to practice a patent or covenant not to -sue for patent infringement). To "grant" such a patent license to a -party means to make such an agreement or commitment not to enforce a -patent against the party. - - If you convey a covered work, knowingly relying on a patent license, -and the Corresponding Source of the work is not available for anyone -to copy, free of charge and under the terms of this License, through a -publicly available network server or other readily accessible means, -then you must either (1) cause the Corresponding Source to be so -available, or (2) arrange to deprive yourself of the benefit of the -patent license for this particular work, or (3) arrange, in a manner -consistent with the requirements of this License, to extend the patent -license to downstream recipients. "Knowingly relying" means you have -actual knowledge that, but for the patent license, your conveying the -covered work in a country, or your recipient's use of the covered work -in a country, would infringe one or more identifiable patents in that -country that you have reason to believe are valid. - - If, pursuant to or in connection with a single transaction or -arrangement, you convey, or propagate by procuring conveyance of, a -covered work, and grant a patent license to some of the parties -receiving the covered work authorizing them to use, propagate, modify -or convey a specific copy of the covered work, then the patent license -you grant is automatically extended to all recipients of the covered -work and works based on it. - - A patent license is "discriminatory" if it does not include within -the scope of its coverage, prohibits the exercise of, or is -conditioned on the non-exercise of one or more of the rights that are -specifically granted under this License. You may not convey a covered -work if you are a party to an arrangement with a third party that is -in the business of distributing software, under which you make payment -to the third party based on the extent of your activity of conveying -the work, and under which the third party grants, to any of the -parties who would receive the covered work from you, a discriminatory -patent license (a) in connection with copies of the covered work -conveyed by you (or copies made from those copies), or (b) primarily -for and in connection with specific products or compilations that -contain the covered work, unless you entered into that arrangement, -or that patent license was granted, prior to 28 March 2007. - - Nothing in this License shall be construed as excluding or limiting -any implied license or other defenses to infringement that may -otherwise be available to you under applicable patent law. - - 12. No Surrender of Others' Freedom. - - If conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot convey a -covered work so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you may -not convey it at all. For example, if you agree to terms that obligate you -to collect a royalty for further conveying from those to whom you convey -the Program, the only way you could satisfy both those terms and this -License would be to refrain entirely from conveying the Program. - - 13. Use with the GNU Affero General Public License. - - Notwithstanding any other provision of this License, you have -permission to link or combine any covered work with a work licensed -under version 3 of the GNU Affero General Public License into a single -combined work, and to convey the resulting work. The terms of this -License will continue to apply to the part which is the covered work, -but the special requirements of the GNU Affero General Public License, -section 13, concerning interaction through a network will apply to the -combination as such. - - 14. Revised Versions of this License. - - The Free Software Foundation may publish revised and/or new versions of -the GNU General Public License from time to time. Such new versions will -be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - - Each version is given a distinguishing version number. If the -Program specifies that a certain numbered version of the GNU General -Public License "or any later version" applies to it, you have the -option of following the terms and conditions either of that numbered -version or of any later version published by the Free Software -Foundation. If the Program does not specify a version number of the -GNU General Public License, you may choose any version ever published -by the Free Software Foundation. - - If the Program specifies that a proxy can decide which future -versions of the GNU General Public License can be used, that proxy's -public statement of acceptance of a version permanently authorizes you -to choose that version for the Program. - - Later license versions may give you additional or different -permissions. However, no additional obligations are imposed on any -author or copyright holder as a result of your choosing to follow a -later version. - - 15. Disclaimer of Warranty. - - THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT -HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY -OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, -THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM -IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF -ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. Limitation of Liability. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS -THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY -GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE -USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF -DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD -PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), -EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF -SUCH DAMAGES. - - 17. Interpretation of Sections 15 and 16. - - If the disclaimer of warranty and limitation of liability provided -above cannot be given local legal effect according to their terms, -reviewing courts shall apply local law that most closely approximates -an absolute waiver of all civil liability in connection with the -Program, unless a warranty or assumption of liability accompanies a -copy of the Program in return for a fee. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . - -Also add information on how to contact you by electronic and paper mail. - - If the program does terminal interaction, make it output a short -notice like this when it starts in an interactive mode: - - Copyright (C) - This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, your program's commands -might be different; for a GUI interface, you would use an "about box". - - You should also get your employer (if you work as a programmer) or school, -if any, to sign a "copyright disclaimer" for the program, if necessary. -For more information on this, and how to apply and follow the GNU GPL, see -. - - The GNU General Public License does not permit incorporating your program -into proprietary programs. If your program is a subroutine library, you -may consider it more useful to permit linking proprietary applications with -the library. If this is what you want to do, use the GNU Lesser General -Public License instead of this License. But first, please read -. diff --git a/libs/copr-hs/src/Web/Fedora/Copr.hs b/libs/copr-hs/src/Web/Fedora/Copr.hs deleted file mode 100644 --- a/libs/copr-hs/src/Web/Fedora/Copr.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} - -{- | -Copyright: (c) 2020 Jens Petersen -SPDX-License-Identifier: GPL-2.0-only -Maintainer: Jens Petersen - -Copr REST client library --} - -module Web.Fedora.Copr - (coprChroots, - fedoraCopr) -where - -import Data.Aeson.Types (Object) -import qualified Data.HashMap.Lazy as H -import Data.List (sort) -import Data.Text (Text) - -import Web.Fedora.Copr.API - -coprChroots :: String -> String -> String -> IO [Text] -coprChroots server owner project = do - proj <- coprGetProject server owner project - case lookupKey "chroot_repos" proj :: Maybe Object of - Nothing -> - case lookupKey "error" proj of - Just err -> error err - Nothing -> return [] - Just obj -> return $ (reverse . sort . H.keys) obj - -fedoraCopr :: String -fedoraCopr = "copr.fedorainfracloud.org" diff --git a/libs/copr-hs/src/Web/Fedora/Copr/API.hs b/libs/copr-hs/src/Web/Fedora/Copr/API.hs deleted file mode 100644 --- a/libs/copr-hs/src/Web/Fedora/Copr/API.hs +++ /dev/null @@ -1,190 +0,0 @@ -{-# LANGUAGE CPP #-} - -{- | -Copyright: (c) 2020 Jens Petersen -SPDX-License-Identifier: GPL-2.0-only -Maintainer: Jens Petersen - -Copr REST client library --} - -module Web.Fedora.Copr.API - ( coprGetProject - , coprGetProjectsList - , coprSearchProjects - , coprGetBuild - , coprGetBuildSourceChroot - , coprGetBuildSourceConfig - , coprGetBuildPackageList - , coprGetBuildChroot - , coprGetBuildChrootList - , coprGetBuildChrootConfig - , coprMockChrootList - , coprGetPackage - , coprGetPackageList - , coprGetProjectChroot - , coprGetProjectChrootBuildConfig - , queryCopr - , maybeKey - , makeKey - , makeItem - , lookupKey - , lookupKey' - ) -where - -import Data.Aeson.Types -import Network.HTTP.Query - --- # Projects - --- | List project details --- --- https://pagure.io/copr/copr/blob/master/f/python/copr/v3/proxies/project.py#_9 -coprGetProject :: String -> String -> String -> IO Object -coprGetProject server owner project = do - let path = "project" - params = [makeItem "ownername" owner, makeItem "projectname" project] - queryCopr server path params - --- | List projects of owner --- --- https://pagure.io/copr/copr/blob/master/f/python/copr/v3/proxies/project.py#_26 -coprGetProjectsList :: String -> String -> IO Value --- FIXME limit=int or maybe pagination? -coprGetProjectsList server owner = do - let path = "project/list" - params = makeKey "ownername" owner - queryCopr server path params - --- | search projects by query string --- --- https://pagure.io/copr/copr/blob/master/f/python/copr/v3/proxies/project.py#_43 -coprSearchProjects :: String -> String -> IO Value -coprSearchProjects server query = do - let path = "project/search" - params = makeKey "query" query - queryCopr server path params - --- # Builds - --- | get build --- --- https://pagure.io/copr/copr/blob/master/f/python/copr/v3/proxies/build.py#_10 -coprGetBuild :: String -> Int -> IO Object -coprGetBuild server bid = do - let path = "build" +/+ show bid - queryCopr server path [] - --- | get srpm build --- --- https://pagure.io/copr/copr/blob/master/f/python/copr/v3/proxies/build.py#_22 -coprGetBuildSourceChroot :: String -> Int -> IO Object -coprGetBuildSourceChroot server bid = do - let path = "build/source-chroot" +/+ show bid - queryCopr server path [] - --- | get build source config --- --- https://pagure.io/copr/copr/blob/master/f/python/copr/v3/proxies/build.py#_34 -coprGetBuildSourceConfig :: String -> Int -> IO Object -coprGetBuildSourceConfig server bid = do - let path = "build/source-build-config" +/+ show bid - queryCopr server path [] - --- | get list of packages --- --- https://pagure.io/copr/copr/blob/master/f/python/copr/v3/proxies/build.py#_46 -coprGetBuildPackageList :: String -> Query -> IO Value -coprGetBuildPackageList server params = do - let path = "build/list" - queryCopr server path params - --- # Build chroot - --- | get build chroot --- --- https://pagure.io/copr/copr/blob/master/f/python/copr/v3/proxies/build_chroot.py#_8 -coprGetBuildChroot :: String -> Int -> String -> IO Value -coprGetBuildChroot server bid chroot = do - let path = "build-chroot" +/+ show bid +/+ chroot - queryCopr server path [] - --- | list of build chroots --- --- https://pagure.io/copr/copr/blob/master/f/python/copr/v3/proxies/build_chroot.py#_25 -coprGetBuildChrootList :: String -> Int -> IO Value -coprGetBuildChrootList server bid = do - let path = "build-chroot/list" +/+ show bid - queryCopr server path [] - --- | get build config for chroot --- --- https://pagure.io/copr/copr/blob/master/f/python/copr/v3/proxies/build_chroot.py#_44 -coprGetBuildChrootConfig :: String -> Int -> String -> IO Value -coprGetBuildChrootConfig server bid chroot = do - let path = "build-chroot/build-config" +/+ show bid +/+ chroot - queryCopr server path [] - --- # Mock chroot - --- | list of all available mock chroots --- --- https://pagure.io/copr/copr/blob/master/f/python/copr/v3/proxies/mock_chroot.py -coprMockChrootList :: String -> IO Value -coprMockChrootList server = do - let path = "mock-chroots/list" - queryCopr server path [] - --- # Package - --- | Get project package details --- --- https://pagure.io/copr/copr/blob/master/f/python/copr/v3/proxies/package.py#_9 -coprGetPackage :: String -> String -> String -> String -> IO Value -coprGetPackage server owner project package = do - let path = "package" - params = [makeItem "ownername" owner, - makeItem "projectname" project, - makeItem "packagename" package] - queryCopr server path params - --- | List project packages --- --- https://pagure.io/copr/copr/blob/master/f/python/copr/v3/proxies/package.py#_28 -coprGetPackageList :: String -> String -> String -> IO Value -coprGetPackageList server owner project = do - let path = "package/list" - params = [makeItem "ownername" owner, makeItem "projectname" project] - queryCopr server path params - --- # Project chroot - --- | get build chroot --- --- https://pagure.io/copr/copr/blob/master/f/python/copr/v3/proxies/project_chroot.py#_10 -coprGetProjectChroot :: String -> String -> String -> String -> IO Value -coprGetProjectChroot server owner project chroot = do - let path = "project-chroot" - params = [makeItem "ownername" owner, - makeItem "projectname" project, - makeItem "chrootname" chroot] - queryCopr server path params - --- | list of build chroots --- --- https://pagure.io/copr/copr/blob/master/f/python/copr/v3/proxies/project_chroot.py#_29 -coprGetProjectChrootBuildConfig :: String -> String -> String -> String -> IO Value -coprGetProjectChrootBuildConfig server owner project chroot = do - let path = "project-chroot/build-config" - params = [makeItem "ownername" owner, - makeItem "projectname" project, - makeItem "chrootname" chroot] - queryCopr server path params - - --- | low-level query -queryCopr :: FromJSON a => String -> String -> Query -> IO a -queryCopr server path params = - let url = "https://" ++ server +/+ "api_3" +/+ path - in webAPIQuery url params diff --git a/libs/fedora-dists/LICENSE b/libs/fedora-dists/LICENSE deleted file mode 100644 --- a/libs/fedora-dists/LICENSE +++ /dev/null @@ -1,674 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 3, 29 June 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The GNU General Public License is a free, copyleft license for -software and other kinds of works. - - The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -the GNU General Public License is intended to guarantee your freedom to -share and change all versions of a program--to make sure it remains free -software for all its users. We, the Free Software Foundation, use the -GNU General Public License for most of our software; it applies also to -any other work released this way by its authors. You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - - To protect your rights, we need to prevent others from denying you -these rights or asking you to surrender the rights. Therefore, you have -certain responsibilities if you distribute copies of the software, or if -you modify it: responsibilities to respect the freedom of others. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must pass on to the recipients the same -freedoms that you received. You must make sure that they, too, receive -or can get the source code. And you must show them these terms so they -know their rights. - - Developers that use the GNU GPL protect your rights with two steps: -(1) assert copyright on the software, and (2) offer you this License -giving you legal permission to copy, distribute and/or modify it. - - For the developers' and authors' protection, the GPL clearly explains -that there is no warranty for this free software. For both users' and -authors' sake, the GPL requires that modified versions be marked as -changed, so that their problems will not be attributed erroneously to -authors of previous versions. - - Some devices are designed to deny users access to install or run -modified versions of the software inside them, although the manufacturer -can do so. This is fundamentally incompatible with the aim of -protecting users' freedom to change the software. The systematic -pattern of such abuse occurs in the area of products for individuals to -use, which is precisely where it is most unacceptable. Therefore, we -have designed this version of the GPL to prohibit the practice for those -products. If such problems arise substantially in other domains, we -stand ready to extend this provision to those domains in future versions -of the GPL, as needed to protect the freedom of users. - - Finally, every program is threatened constantly by software patents. -States should not allow patents to restrict development and use of -software on general-purpose computers, but in those that do, we wish to -avoid the special danger that patents applied to a free program could -make it effectively proprietary. To prevent this, the GPL assures that -patents cannot be used to render the program non-free. - - The precise terms and conditions for copying, distribution and -modification follow. - - TERMS AND CONDITIONS - - 0. Definitions. - - "This License" refers to version 3 of the GNU General Public License. - - "Copyright" also means copyright-like laws that apply to other kinds of -works, such as semiconductor masks. - - "The Program" refers to any copyrightable work licensed under this -License. Each licensee is addressed as "you". "Licensees" and -"recipients" may be individuals or organizations. - - To "modify" a work means to copy from or adapt all or part of the work -in a fashion requiring copyright permission, other than the making of an -exact copy. The resulting work is called a "modified version" of the -earlier work or a work "based on" the earlier work. - - A "covered work" means either the unmodified Program or a work based -on the Program. - - To "propagate" a work means to do anything with it that, without -permission, would make you directly or secondarily liable for -infringement under applicable copyright law, except executing it on a -computer or modifying a private copy. Propagation includes copying, -distribution (with or without modification), making available to the -public, and in some countries other activities as well. - - To "convey" a work means any kind of propagation that enables other -parties to make or receive copies. Mere interaction with a user through -a computer network, with no transfer of a copy, is not conveying. - - An interactive user interface displays "Appropriate Legal Notices" -to the extent that it includes a convenient and prominently visible -feature that (1) displays an appropriate copyright notice, and (2) -tells the user that there is no warranty for the work (except to the -extent that warranties are provided), that licensees may convey the -work under this License, and how to view a copy of this License. If -the interface presents a list of user commands or options, such as a -menu, a prominent item in the list meets this criterion. - - 1. Source Code. - - The "source code" for a work means the preferred form of the work -for making modifications to it. "Object code" means any non-source -form of a work. - - A "Standard Interface" means an interface that either is an official -standard defined by a recognized standards body, or, in the case of -interfaces specified for a particular programming language, one that -is widely used among developers working in that language. - - The "System Libraries" of an executable work include anything, other -than the work as a whole, that (a) is included in the normal form of -packaging a Major Component, but which is not part of that Major -Component, and (b) serves only to enable use of the work with that -Major Component, or to implement a Standard Interface for which an -implementation is available to the public in source code form. A -"Major Component", in this context, means a major essential component -(kernel, window system, and so on) of the specific operating system -(if any) on which the executable work runs, or a compiler used to -produce the work, or an object code interpreter used to run it. - - The "Corresponding Source" for a work in object code form means all -the source code needed to generate, install, and (for an executable -work) run the object code and to modify the work, including scripts to -control those activities. However, it does not include the work's -System Libraries, or general-purpose tools or generally available free -programs which are used unmodified in performing those activities but -which are not part of the work. For example, Corresponding Source -includes interface definition files associated with source files for -the work, and the source code for shared libraries and dynamically -linked subprograms that the work is specifically designed to require, -such as by intimate data communication or control flow between those -subprograms and other parts of the work. - - The Corresponding Source need not include anything that users -can regenerate automatically from other parts of the Corresponding -Source. - - The Corresponding Source for a work in source code form is that -same work. - - 2. Basic Permissions. - - All rights granted under this License are granted for the term of -copyright on the Program, and are irrevocable provided the stated -conditions are met. This License explicitly affirms your unlimited -permission to run the unmodified Program. The output from running a -covered work is covered by this License only if the output, given its -content, constitutes a covered work. This License acknowledges your -rights of fair use or other equivalent, as provided by copyright law. - - You may make, run and propagate covered works that you do not -convey, without conditions so long as your license otherwise remains -in force. You may convey covered works to others for the sole purpose -of having them make modifications exclusively for you, or provide you -with facilities for running those works, provided that you comply with -the terms of this License in conveying all material for which you do -not control copyright. Those thus making or running the covered works -for you must do so exclusively on your behalf, under your direction -and control, on terms that prohibit them from making any copies of -your copyrighted material outside their relationship with you. - - Conveying under any other circumstances is permitted solely under -the conditions stated below. Sublicensing is not allowed; section 10 -makes it unnecessary. - - 3. Protecting Users' Legal Rights From Anti-Circumvention Law. - - No covered work shall be deemed part of an effective technological -measure under any applicable law fulfilling obligations under article -11 of the WIPO copyright treaty adopted on 20 December 1996, or -similar laws prohibiting or restricting circumvention of such -measures. - - When you convey a covered work, you waive any legal power to forbid -circumvention of technological measures to the extent such circumvention -is effected by exercising rights under this License with respect to -the covered work, and you disclaim any intention to limit operation or -modification of the work as a means of enforcing, against the work's -users, your or third parties' legal rights to forbid circumvention of -technological measures. - - 4. Conveying Verbatim Copies. - - You may convey verbatim copies of the Program's source code as you -receive it, in any medium, provided that you conspicuously and -appropriately publish on each copy an appropriate copyright notice; -keep intact all notices stating that this License and any -non-permissive terms added in accord with section 7 apply to the code; -keep intact all notices of the absence of any warranty; and give all -recipients a copy of this License along with the Program. - - You may charge any price or no price for each copy that you convey, -and you may offer support or warranty protection for a fee. - - 5. Conveying Modified Source Versions. - - You may convey a work based on the Program, or the modifications to -produce it from the Program, in the form of source code under the -terms of section 4, provided that you also meet all of these conditions: - - a) The work must carry prominent notices stating that you modified - it, and giving a relevant date. - - b) The work must carry prominent notices stating that it is - released under this License and any conditions added under section - 7. This requirement modifies the requirement in section 4 to - "keep intact all notices". - - c) You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable section 7 - additional terms, to the whole of the work, and all its parts, - regardless of how they are packaged. This License gives no - permission to license the work in any other way, but it does not - invalidate such permission if you have separately received it. - - d) If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has interactive - interfaces that do not display Appropriate Legal Notices, your - work need not make them do so. - - A compilation of a covered work with other separate and independent -works, which are not by their nature extensions of the covered work, -and which are not combined with it such as to form a larger program, -in or on a volume of a storage or distribution medium, is called an -"aggregate" if the compilation and its resulting copyright are not -used to limit the access or legal rights of the compilation's users -beyond what the individual works permit. Inclusion of a covered work -in an aggregate does not cause this License to apply to the other -parts of the aggregate. - - 6. Conveying Non-Source Forms. - - You may convey a covered work in object code form under the terms -of sections 4 and 5, provided that you also convey the -machine-readable Corresponding Source under the terms of this License, -in one of these ways: - - a) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. - - b) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that product - model, to give anyone who possesses the object code either (1) a - copy of the Corresponding Source for all the software in the - product that is covered by this License, on a durable physical - medium customarily used for software interchange, for a price no - more than your reasonable cost of physically performing this - conveying of source, or (2) access to copy the - Corresponding Source from a network server at no charge. - - c) Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, and - only if you received the object code with such an offer, in accord - with subsection 6b. - - d) Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to the - Corresponding Source in the same way through the same place at no - further charge. You need not require recipients to copy the - Corresponding Source along with the object code. If the place to - copy the object code is a network server, the Corresponding Source - may be on a different server (operated by you or a third party) - that supports equivalent copying facilities, provided you maintain - clear directions next to the object code saying where to find the - Corresponding Source. Regardless of what server hosts the - Corresponding Source, you remain obligated to ensure that it is - available for as long as needed to satisfy these requirements. - - e) Convey the object code using peer-to-peer transmission, provided - you inform other peers where the object code and Corresponding - Source of the work are being offered to the general public at no - charge under subsection 6d. - - A separable portion of the object code, whose source code is excluded -from the Corresponding Source as a System Library, need not be -included in conveying the object code work. - - A "User Product" is either (1) a "consumer product", which means any -tangible personal property which is normally used for personal, family, -or household purposes, or (2) anything designed or sold for incorporation -into a dwelling. In determining whether a product is a consumer product, -doubtful cases shall be resolved in favor of coverage. For a particular -product received by a particular user, "normally used" refers to a -typical or common use of that class of product, regardless of the status -of the particular user or of the way in which the particular user -actually uses, or expects or is expected to use, the product. A product -is a consumer product regardless of whether the product has substantial -commercial, industrial or non-consumer uses, unless such uses represent -the only significant mode of use of the product. - - "Installation Information" for a User Product means any methods, -procedures, authorization keys, or other information required to install -and execute modified versions of a covered work in that User Product from -a modified version of its Corresponding Source. The information must -suffice to ensure that the continued functioning of the modified object -code is in no case prevented or interfered with solely because -modification has been made. - - If you convey an object code work under this section in, or with, or -specifically for use in, a User Product, and the conveying occurs as -part of a transaction in which the right of possession and use of the -User Product is transferred to the recipient in perpetuity or for a -fixed term (regardless of how the transaction is characterized), the -Corresponding Source conveyed under this section must be accompanied -by the Installation Information. But this requirement does not apply -if neither you nor any third party retains the ability to install -modified object code on the User Product (for example, the work has -been installed in ROM). - - The requirement to provide Installation Information does not include a -requirement to continue to provide support service, warranty, or updates -for a work that has been modified or installed by the recipient, or for -the User Product in which it has been modified or installed. Access to a -network may be denied when the modification itself materially and -adversely affects the operation of the network or violates the rules and -protocols for communication across the network. - - Corresponding Source conveyed, and Installation Information provided, -in accord with this section must be in a format that is publicly -documented (and with an implementation available to the public in -source code form), and must require no special password or key for -unpacking, reading or copying. - - 7. Additional Terms. - - "Additional permissions" are terms that supplement the terms of this -License by making exceptions from one or more of its conditions. -Additional permissions that are applicable to the entire Program shall -be treated as though they were included in this License, to the extent -that they are valid under applicable law. If additional permissions -apply only to part of the Program, that part may be used separately -under those permissions, but the entire Program remains governed by -this License without regard to the additional permissions. - - When you convey a copy of a covered work, you may at your option -remove any additional permissions from that copy, or from any part of -it. (Additional permissions may be written to require their own -removal in certain cases when you modify the work.) You may place -additional permissions on material, added by you to a covered work, -for which you have or can give appropriate copyright permission. - - Notwithstanding any other provision of this License, for material you -add to a covered work, you may (if authorized by the copyright holders of -that material) supplement the terms of this License with terms: - - a) Disclaiming warranty or limiting liability differently from the - terms of sections 15 and 16 of this License; or - - b) Requiring preservation of specified reasonable legal notices or - author attributions in that material or in the Appropriate Legal - Notices displayed by works containing it; or - - c) Prohibiting misrepresentation of the origin of that material, or - requiring that modified versions of such material be marked in - reasonable ways as different from the original version; or - - d) Limiting the use for publicity purposes of names of licensors or - authors of the material; or - - e) Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or - - f) Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified versions of - it) with contractual assumptions of liability to the recipient, for - any liability that these contractual assumptions directly impose on - those licensors and authors. - - All other non-permissive additional terms are considered "further -restrictions" within the meaning of section 10. If the Program as you -received it, or any part of it, contains a notice stating that it is -governed by this License along with a term that is a further -restriction, you may remove that term. If a license document contains -a further restriction but permits relicensing or conveying under this -License, you may add to a covered work material governed by the terms -of that license document, provided that the further restriction does -not survive such relicensing or conveying. - - If you add terms to a covered work in accord with this section, you -must place, in the relevant source files, a statement of the -additional terms that apply to those files, or a notice indicating -where to find the applicable terms. - - Additional terms, permissive or non-permissive, may be stated in the -form of a separately written license, or stated as exceptions; -the above requirements apply either way. - - 8. Termination. - - You may not propagate or modify a covered work except as expressly -provided under this License. Any attempt otherwise to propagate or -modify it is void, and will automatically terminate your rights under -this License (including any patent licenses granted under the third -paragraph of section 11). - - However, if you cease all violation of this License, then your -license from a particular copyright holder is reinstated (a) -provisionally, unless and until the copyright holder explicitly and -finally terminates your license, and (b) permanently, if the copyright -holder fails to notify you of the violation by some reasonable means -prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. - - Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, you do not qualify to receive new licenses for the same -material under section 10. - - 9. Acceptance Not Required for Having Copies. - - You are not required to accept this License in order to receive or -run a copy of the Program. Ancillary propagation of a covered work -occurring solely as a consequence of using peer-to-peer transmission -to receive a copy likewise does not require acceptance. However, -nothing other than this License grants you permission to propagate or -modify any covered work. These actions infringe copyright if you do -not accept this License. Therefore, by modifying or propagating a -covered work, you indicate your acceptance of this License to do so. - - 10. Automatic Licensing of Downstream Recipients. - - Each time you convey a covered work, the recipient automatically -receives a license from the original licensors, to run, modify and -propagate that work, subject to this License. You are not responsible -for enforcing compliance by third parties with this License. - - An "entity transaction" is a transaction transferring control of an -organization, or substantially all assets of one, or subdividing an -organization, or merging organizations. If propagation of a covered -work results from an entity transaction, each party to that -transaction who receives a copy of the work also receives whatever -licenses to the work the party's predecessor in interest had or could -give under the previous paragraph, plus a right to possession of the -Corresponding Source of the work from the predecessor in interest, if -the predecessor has it or can get it with reasonable efforts. - - You may not impose any further restrictions on the exercise of the -rights granted or affirmed under this License. For example, you may -not impose a license fee, royalty, or other charge for exercise of -rights granted under this License, and you may not initiate litigation -(including a cross-claim or counterclaim in a lawsuit) alleging that -any patent claim is infringed by making, using, selling, offering for -sale, or importing the Program or any portion of it. - - 11. Patents. - - A "contributor" is a copyright holder who authorizes use under this -License of the Program or a work on which the Program is based. The -work thus licensed is called the contributor's "contributor version". - - A contributor's "essential patent claims" are all patent claims -owned or controlled by the contributor, whether already acquired or -hereafter acquired, that would be infringed by some manner, permitted -by this License, of making, using, or selling its contributor version, -but do not include claims that would be infringed only as a -consequence of further modification of the contributor version. For -purposes of this definition, "control" includes the right to grant -patent sublicenses in a manner consistent with the requirements of -this License. - - Each contributor grants you a non-exclusive, worldwide, royalty-free -patent license under the contributor's essential patent claims, to -make, use, sell, offer for sale, import and otherwise run, modify and -propagate the contents of its contributor version. - - In the following three paragraphs, a "patent license" is any express -agreement or commitment, however denominated, not to enforce a patent -(such as an express permission to practice a patent or covenant not to -sue for patent infringement). To "grant" such a patent license to a -party means to make such an agreement or commitment not to enforce a -patent against the party. - - If you convey a covered work, knowingly relying on a patent license, -and the Corresponding Source of the work is not available for anyone -to copy, free of charge and under the terms of this License, through a -publicly available network server or other readily accessible means, -then you must either (1) cause the Corresponding Source to be so -available, or (2) arrange to deprive yourself of the benefit of the -patent license for this particular work, or (3) arrange, in a manner -consistent with the requirements of this License, to extend the patent -license to downstream recipients. "Knowingly relying" means you have -actual knowledge that, but for the patent license, your conveying the -covered work in a country, or your recipient's use of the covered work -in a country, would infringe one or more identifiable patents in that -country that you have reason to believe are valid. - - If, pursuant to or in connection with a single transaction or -arrangement, you convey, or propagate by procuring conveyance of, a -covered work, and grant a patent license to some of the parties -receiving the covered work authorizing them to use, propagate, modify -or convey a specific copy of the covered work, then the patent license -you grant is automatically extended to all recipients of the covered -work and works based on it. - - A patent license is "discriminatory" if it does not include within -the scope of its coverage, prohibits the exercise of, or is -conditioned on the non-exercise of one or more of the rights that are -specifically granted under this License. You may not convey a covered -work if you are a party to an arrangement with a third party that is -in the business of distributing software, under which you make payment -to the third party based on the extent of your activity of conveying -the work, and under which the third party grants, to any of the -parties who would receive the covered work from you, a discriminatory -patent license (a) in connection with copies of the covered work -conveyed by you (or copies made from those copies), or (b) primarily -for and in connection with specific products or compilations that -contain the covered work, unless you entered into that arrangement, -or that patent license was granted, prior to 28 March 2007. - - Nothing in this License shall be construed as excluding or limiting -any implied license or other defenses to infringement that may -otherwise be available to you under applicable patent law. - - 12. No Surrender of Others' Freedom. - - If conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot convey a -covered work so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you may -not convey it at all. For example, if you agree to terms that obligate you -to collect a royalty for further conveying from those to whom you convey -the Program, the only way you could satisfy both those terms and this -License would be to refrain entirely from conveying the Program. - - 13. Use with the GNU Affero General Public License. - - Notwithstanding any other provision of this License, you have -permission to link or combine any covered work with a work licensed -under version 3 of the GNU Affero General Public License into a single -combined work, and to convey the resulting work. The terms of this -License will continue to apply to the part which is the covered work, -but the special requirements of the GNU Affero General Public License, -section 13, concerning interaction through a network will apply to the -combination as such. - - 14. Revised Versions of this License. - - The Free Software Foundation may publish revised and/or new versions of -the GNU General Public License from time to time. Such new versions will -be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - - Each version is given a distinguishing version number. If the -Program specifies that a certain numbered version of the GNU General -Public License "or any later version" applies to it, you have the -option of following the terms and conditions either of that numbered -version or of any later version published by the Free Software -Foundation. If the Program does not specify a version number of the -GNU General Public License, you may choose any version ever published -by the Free Software Foundation. - - If the Program specifies that a proxy can decide which future -versions of the GNU General Public License can be used, that proxy's -public statement of acceptance of a version permanently authorizes you -to choose that version for the Program. - - Later license versions may give you additional or different -permissions. However, no additional obligations are imposed on any -author or copyright holder as a result of your choosing to follow a -later version. - - 15. Disclaimer of Warranty. - - THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT -HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY -OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, -THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM -IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF -ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. Limitation of Liability. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS -THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY -GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE -USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF -DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD -PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), -EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF -SUCH DAMAGES. - - 17. Interpretation of Sections 15 and 16. - - If the disclaimer of warranty and limitation of liability provided -above cannot be given local legal effect according to their terms, -reviewing courts shall apply local law that most closely approximates -an absolute waiver of all civil liability in connection with the -Program, unless a warranty or assumption of liability accompanies a -copy of the Program in return for a fee. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . - -Also add information on how to contact you by electronic and paper mail. - - If the program does terminal interaction, make it output a short -notice like this when it starts in an interactive mode: - - Copyright (C) - This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, your program's commands -might be different; for a GUI interface, you would use an "about box". - - You should also get your employer (if you work as a programmer) or school, -if any, to sign a "copyright disclaimer" for the program, if necessary. -For more information on this, and how to apply and follow the GNU GPL, see -. - - The GNU General Public License does not permit incorporating your program -into proprietary programs. If your program is a subroutine library, you -may consider it more useful to permit linking proprietary applications with -the library. If this is what you want to do, use the GNU Lesser General -Public License instead of this License. But first, please read -. diff --git a/libs/fedora-dists/src/Distribution/Fedora.hs b/libs/fedora-dists/src/Distribution/Fedora.hs deleted file mode 100644 --- a/libs/fedora-dists/src/Distribution/Fedora.hs +++ /dev/null @@ -1,216 +0,0 @@ -{-# LANGUAGE CPP #-} - --- | --- Module : Distribution.Fedora --- Copyright : (C) 2014-2020 Jens Petersen --- --- Maintainer : Jens Petersen --- --- Explanation: Fedora Dist type and functions - --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- (at your option) any later version. - -module Distribution.Fedora - (Dist(..), - getReleaseIds, - getFedoraReleaseIds, - getFedoraDists, - getEPELReleaseIds, - getRawhideDist, - getLatestFedoraDist, - getLatestEPELDist, - rawhideVersionId, - distBranch, - distRepo, - distUpdates, - distOverride, - mockConfig, - distVersion, - kojicmd, - rpkg, - rpmDistTag) where - -import qualified Data.Text as T -import Data.Text (Text) -import Data.Version -import Text.Read -import Text.ParserCombinators.ReadP (char, eof, string) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>), (*>)) -import Data.Traversable (traverse) -#endif - -import Distribution.Fedora.ReadProducts -import Distribution.Fedora.Products - --- | The `Dist` datatype specifies the target OS and version. --- (roughly corresponds to a git branch) -data Dist = RHEL Version -- ^ RHEL version - | EPEL Int -- ^ EPEL release - | Fedora Int -- ^ Fedora release - deriving (Eq, Ord) - -instance Show Dist where - show (Fedora n) = "f" ++ show n - show (EPEL n) = (if n <= 6 then "el" else "epel") ++ show n - show (RHEL v) = "rhel-" ++ showVersion v - --- | Read from eg "f29", "epel7" -instance Read Dist where - readPrec = choice [pFedora, pEPEL, pRHEL] where - pFedora = Fedora <$> (lift (char 'f') *> readPrec) - pEPEL = EPEL <$> (lift (string "epel") *> readPrec) - pRHEL = RHEL <$> lift (do - v <- string "rhel-" >> parseVersion - eof - return v) - -getReleases :: IO [Release] -getReleases = do - file <- getProductsFile - reverse <$> parseReleases file - --- | gets list of current releases (Fedora and EPEL) --- --- The data is stored in ~/.fedora/product-versions.json --- and refreshed from Fedora PDC if older than 5.5 hours -getReleaseIds :: IO [Text] -getReleaseIds = map releaseProductVersionId <$> getReleases - -getProductReleases :: Text -> IO [Release] -getProductReleases name = - filter (\p -> releaseProduct p == name) <$> getReleases - --- getRelease :: Text -> IO (Maybe Release) --- getRelease pv = --- find (\p -> releaseProductVersionId p == pv) <$> getReleases - -getFedoraReleases :: IO [Release] -getFedoraReleases = - getProductReleases (T.pack "fedora") - --- | gets current Fedora releases -getFedoraReleaseIds :: IO [Text] -getFedoraReleaseIds = - map releaseProductVersionId <$> getFedoraReleases - -getEPELReleases :: IO [Release] -getEPELReleases = - getProductReleases (T.pack "epel") - --- | gets current EPEL releases -getEPELReleaseIds :: IO [Text] -getEPELReleaseIds = - map releaseProductVersionId <$> getEPELReleases - --- | Rawhide version id -rawhideVersionId :: Text -rawhideVersionId = T.pack "fedora-rawhide" - --- fails on rawhide - only use on other releases -releaseMajorVersion :: Release -> Int -releaseMajorVersion = read . T.unpack . releaseVersion - -releaseDist :: Release -> Dist -releaseDist = Fedora . releaseMajorVersion - -releaseDists :: [Release] -> [Dist] -releaseDists rels = - map mkDist rels - where - mkDist :: Release -> Dist - mkDist r | releaseProductVersionId r == rawhideVersionId = newerDist latestbranch - | otherwise = releaseDist r - - latestbranch = maximum $ filter (\p -> releaseProductVersionId p /= rawhideVersionId) rels - - newerDist = Fedora . (+ 1) . releaseMajorVersion - --- | get list of current Fedora Dist's -getFedoraDists :: IO [Dist] -getFedoraDists = releaseDists <$> getFedoraReleases - --- | get current Dist for Fedora Rawhide -getRawhideDist :: IO Dist -getRawhideDist = - head . releaseDists <$> getFedoraReleases - --- | get newest Fedora branch -getLatestFedoraDist :: IO Dist -getLatestFedoraDist = - releaseDist . maximum . filter (\p -> releaseProductVersionId p /= rawhideVersionId) <$> getFedoraReleases - --- | get newest EPEL release -getLatestEPELDist :: IO Dist -getLatestEPELDist = - EPEL . releaseMajorVersion . maximum <$> getEPELReleases - --- activeRelease :: Text -> IO Bool --- activeRelease pv = do --- res <- filter (\p -> releaseProductVersionId p == pv) <$> getReleases --- return $ not (null res) - --- | Maps `Dist` to package dist-git branch name, relative to latest branch --- --- > distBranch (Fedora 32) (Fedora 33) == "rawhide" --- > distBranch (Fedora 32) (Fedora 31) == "f31" -distBranch :: Dist -- ^ latest branch - -> Dist -> String -distBranch branch (Fedora n) | Fedora n > branch = "rawhide" -distBranch _ d = show d - --- | Map `Dist` to DNF/YUM repo name, relative to latest branch -distRepo :: Dist -> Dist -> String -distRepo branched (Fedora n) | Fedora n > branched = "rawhide" - | otherwise = "fedora" -distRepo _ (EPEL _) = "epel" -distRepo _ (RHEL _) = "rhel" - --- | Map `Dist` to Maybe the DNF/YUM updates repo name, relative to latest branch -distUpdates :: Dist -> Dist -> Maybe String -distUpdates branched (Fedora n) | Fedora n > branched = Nothing -distUpdates _ (Fedora _) = Just "updates" -distUpdates _ _ = Nothing - --- | Whether dist has overrides in Bodhi, relative to latest branch -distOverride :: Dist -> Dist -> Bool -distOverride branch (Fedora n) = Fedora n <= branch -distOverride _ (EPEL n) = n < 9 -distOverride _ _ = False - --- | OS release major version for `Dist`, relative to latest branch -distVersion :: Dist -> Dist -> String -distVersion branch (Fedora n) | Fedora n > branch = "rawhide" -distVersion _ (Fedora n) = show n -distVersion _ (EPEL n) = show n -distVersion _ (RHEL n) = show n - --- | Mock configuration for `Dist` and arch, relative to latest branch -mockConfig :: Dist -> Dist -> String -> String -mockConfig branch dist arch = - let prefix = - case dist of - Fedora _ -> "fedora" - _ -> distRepo branch dist - in - prefix ++ "-" ++ distVersion branch dist ++ "-" ++ arch - --- | `Dist` tag (appended to rpm package release field) -rpmDistTag :: Dist -> String -rpmDistTag (Fedora n) = ".fc" ++ show n -rpmDistTag (EPEL n) = ".el" ++ show n -rpmDistTag (RHEL v) = ".el" ++ (show . head . versionBranch) v - --- | Command line tool for `Dist` (eg "koji") -kojicmd :: Dist -> String -kojicmd (RHEL _) = "brew" -kojicmd _ = "koji" - --- | rpkg command for `Dist` (eg "fedpkg") -rpkg :: Dist -> String -rpkg (RHEL _) = "rhpkg" -rpkg _ = "fedpkg" diff --git a/libs/fedora-dists/src/Distribution/Fedora/Branch.hs b/libs/fedora-dists/src/Distribution/Fedora/Branch.hs deleted file mode 100644 --- a/libs/fedora-dists/src/Distribution/Fedora/Branch.hs +++ /dev/null @@ -1,181 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} - --- | --- Module : Distribution.Fedora.Branch --- Copyright : (C) 2020 Jens Petersen --- --- Maintainer : Jens Petersen --- --- Explanation: Fedora Branch type and functions - --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- (at your option) any later version. - -module Distribution.Fedora.Branch - ( Branch(..) - , readBranch - , readBranch' - , eitherBranch - , eitherBranch' - , readActiveBranch - , readActiveBranch' - , eitherActiveBranch - , newerBranch - , releaseBranch - , getFedoraBranches - , getFedoraBranched - , branchDestTag - , branchDist - , branchTarget - ) -where - -#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0)) -#else -import Control.Applicative ((<$>)) -#endif - -import Data.Char (isDigit) -import qualified Data.Text as T - -import qualified Distribution.Fedora as Dist - --- | Branch datatype --- --- Branch can be rawhide, or a fedora or epel branch -data Branch = EPEL Int | Fedora Int | Rawhide - deriving (Eq, Ord) - --- | Read a Fedora Branch name, otherwise return branch string -eitherBranch :: String -> Either String Branch -eitherBranch "rawhide" = Right Rawhide -eitherBranch ('f':ns) | all isDigit ns = let br = Fedora (read ns) in Right br -eitherBranch ('e':'p':'e':'l':n) | all isDigit n = let br = EPEL (read n) in Right br -eitherBranch ('e':'l':n) | all isDigit n = let br = EPEL (read n) in Right br -eitherBranch cs = Left cs - --- | Read a Fedora Branch name, otherwise return an error message -eitherBranch' :: String -> Either String Branch -eitherBranch' cs = case eitherBranch cs of - Right br -> Right br - Left xs -> Left $ xs ++ " is not a known Fedora/EPEL branch" - --- | Read a Fedora Branch name -readBranch :: String -> Maybe Branch -readBranch bs = - case eitherBranch bs of - Left _ -> Nothing - Right br -> Just br - --- | Unsafely read a Fedora Branch name: errors for unknown branches -readBranch' :: String -> Branch -readBranch' bs = - case eitherBranch bs of - Left e -> error' $! "unknown Fedora branch: " ++ e - Right br -> br - --- | Read a Branch name (one of the list of active branches) --- --- Provides error strings for inactive or unknown branches. -eitherActiveBranch :: [Branch] -> String -> Either String Branch -eitherActiveBranch active bs = - case eitherBranch bs of - Left e -> Left e - Right br -> if br `elem` active - then Right br - else Left bs - --- | Read a Branch name (one of the list of active branches) --- --- Similar to eitherActiceBranch but ignores any error string -readActiveBranch :: [Branch] -> String -> Maybe Branch -readActiveBranch active cs = - case eitherActiveBranch active cs of - Left _ -> Nothing - Right br -> Just br - --- | Read a Branch name (one of the list of active branches) --- --- Like readActiveBranch, but errors for inactive or unknown branches. -readActiveBranch' :: [Branch] -> String -> Branch -readActiveBranch' active cs = - case eitherActiveBranch active cs of - Left e -> error' $ "inactive Fedora branch: " ++ e - Right br -> br - -instance Show Branch where - show Rawhide = "rawhide" - show (Fedora n) = "f" ++ show n - show (EPEL n) = (if n <= 6 then "el" else "epel") ++ show n - --- | Map Branch to Koji destination tag -branchDestTag :: Branch -> String -branchDestTag Rawhide = "rawhide" -branchDestTag (Fedora n) = show (Fedora n) ++ "-updates-candidate" -branchDestTag (EPEL n) = show (EPEL n) ++ "-testing-candidate" - --- | Default build target associated with a branch -branchTarget :: Branch -> String -branchTarget (Fedora n) = show (Fedora n) -branchTarget (EPEL n) = show (EPEL n) -branchTarget Rawhide = "rawhide" - ---getLatestBranch :: IO Branch - --- | Returns newer branch than given one from supplied active branches. --- --- Branches should be in descending order, eg from getFedoraBranches -newerBranch :: Branch -> [Branch] -> Branch -newerBranch Rawhide _ = Rawhide -newerBranch (Fedora n) branches = - if Fedora n `elem` branches - then if Fedora (n+1) `elem` branches - then Fedora (n+1) - else Rawhide - else error' $ "Unsupported branch: " ++ show (Fedora n) -newerBranch (EPEL n) branches = - if EPEL n `elem` branches - then if EPEL (n+1) `elem` branches - then EPEL (n+1) - else EPEL n - else error' $ "Unsupported branch: " ++ show (EPEL n) - ---olderBranch :: Branch -> Branch ---olderBranch Rawhide = latestBranch ---olderBranch (Fedora n) = Fedora (n-1) - --- | Returns list of active Fedora branches, including rawhide and EPEL -getFedoraBranches :: IO [Branch] -getFedoraBranches = map releaseBranch <$> Dist.getReleaseIds - --- | Maps release-id to Branch -releaseBranch :: T.Text -> Branch -releaseBranch "fedora-rawhide" = Rawhide -releaseBranch rel | "fedora-" `T.isPrefixOf` rel = - let (_,ver) = T.breakOnEnd "-" rel in - Fedora $ read . T.unpack $ ver - | "epel-" `T.isPrefixOf` rel = - let (_,ver) = T.breakOnEnd "-" rel in - EPEL $ read . T.unpack $ ver - | otherwise = error' $ "Unsupport release: " ++ T.unpack rel - --- | Returns list of active Fedora branches, excluding rawhide -getFedoraBranched :: IO [Branch] -getFedoraBranched = filter (/= Rawhide) <$> getFedoraBranches - --- from simple-cmd -error' :: String -> a -#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,9,0)) -error' = errorWithoutStackTrace -#else -error' = error -#endif - --- | Convert a Branch to a Dist -branchDist :: Branch -> IO Dist.Dist -branchDist (Fedora n) = return $ Dist.Fedora n -branchDist (EPEL n) = return $ Dist.EPEL n -branchDist Rawhide = Dist.getRawhideDist diff --git a/libs/fedora-dists/src/Distribution/Fedora/Products.hs b/libs/fedora-dists/src/Distribution/Fedora/Products.hs deleted file mode 100644 --- a/libs/fedora-dists/src/Distribution/Fedora/Products.hs +++ /dev/null @@ -1,52 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} - -module Distribution.Fedora.Products - ( Release(releaseProductVersionId,releaseVersion,releaseProduct) - , parseReleases - ) -where - -import qualified Data.ByteString.Lazy.Char8 as BL -import Control.Monad (mzero) -import Data.Aeson(eitherDecode, Value(..), FromJSON(..), ToJSON(..), - pairs, - (.:), (.=), object) -#if !MIN_VERSION_base(4,13,0) -import Data.Monoid((<>)) -#endif -import Data.Text (Text) -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>), (<*>)) -#endif - -data Release = Release { - releaseProductVersionId :: Text, - releaseReleases :: [Text], - releaseAllowedPushTargets :: [[Maybe Value]], - releaseActive :: Bool, - releaseName :: Text, - releaseVersion :: Text, - releaseShort :: Text, - releaseProduct :: Text - } deriving (Show,Eq) - -instance Ord Release where - compare r1 r2 = - compare (releaseProductVersionId r1) (releaseProductVersionId r2) - -instance FromJSON Release where - parseJSON (Object v) = Release <$> v .: "product_version_id" <*> v .: "releases" <*> v .: "allowed_push_targets" <*> v .: "active" <*> v .: "name" <*> v .: "version" <*> v .: "short" <*> v .: "product" - parseJSON _ = mzero - -instance ToJSON Release where - toJSON Release {..} = object ["product_version_id" .= releaseProductVersionId, "releases" .= releaseReleases, "allowed_push_targets" .= releaseAllowedPushTargets, "active" .= releaseActive, "name" .= releaseName, "version" .= releaseVersion, "short" .= releaseShort, "product" .= releaseProduct] - toEncoding Release {..} = pairs ("product_version_id" .= releaseProductVersionId<>"releases" .= releaseReleases<>"allowed_push_targets" .= releaseAllowedPushTargets<>"active" .= releaseActive<>"name" .= releaseName<>"version" .= releaseVersion<>"short" .= releaseShort<>"product" .= releaseProduct) - -parseReleases :: FilePath -> IO [Release] -parseReleases filename = do - input <- BL.readFile filename - case eitherDecode input of - Left err -> error $ "Invalid JSON file: " ++ filename ++ "\n" ++ err - Right r -> return r diff --git a/libs/fedora-dists/src/Distribution/Fedora/ReadProducts.hs b/libs/fedora-dists/src/Distribution/Fedora/ReadProducts.hs deleted file mode 100644 --- a/libs/fedora-dists/src/Distribution/Fedora/ReadProducts.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} - -module Distribution.Fedora.ReadProducts - (getProductsFile) -where - -import Control.Monad -import Data.Aeson(encode) -import qualified Data.ByteString.Lazy.Char8 as BL -import Data.Time.Clock (diffUTCTime, getCurrentTime) -import Fedora.PDC (makeKey, pdcProductVersions) -import System.Directory -import System.FilePath (()) - -getProductsFile :: IO FilePath -getProductsFile = do - home <- getHomeDirectory - let dir = home ".fedora" - dirExists <- doesDirectoryExist dir - unless dirExists $ createDirectory dir - let file = dir "product-versions-2.json" - recent <- do - have <- doesFileExist file - if have then do - ts <- getModificationTime file - t <- getCurrentTime - -- about 5.5 hours - return $ diffUTCTime t ts < 20000 - else return False - unless recent $ - pdcProductVersions "pdc.fedoraproject.org" (makeKey "active" "true") >>= - BL.writeFile file . encode - return file diff --git a/libs/pagure-hs/LICENSE b/libs/pagure-hs/LICENSE deleted file mode 100644 --- a/libs/pagure-hs/LICENSE +++ /dev/null @@ -1,339 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 2, June 1991 - - Copyright (C) 1989, 1991 Free Software Foundation, Inc., - 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -License is intended to guarantee your freedom to share and change free -software--to make sure the software is free for all its users. This -General Public License applies to most of the Free Software -Foundation's software and to any other program whose authors commit to -using it. (Some other Free Software Foundation software is covered by -the GNU Lesser General Public License instead.) You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -this service if you wish), that you receive source code or can get it -if you want it, that you can change the software or use pieces of it -in new free programs; and that you know you can do these things. - - To protect your rights, we need to make restrictions that forbid -anyone to deny you these rights or to ask you to surrender the rights. -These restrictions translate to certain responsibilities for you if you -distribute copies of the software, or if you modify it. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must give the recipients all the rights that -you have. You must make sure that they, too, receive or can get the -source code. And you must show them these terms so they know their -rights. - - We protect your rights with two steps: (1) copyright the software, and -(2) offer you this license which gives you legal permission to copy, -distribute and/or modify the software. - - Also, for each author's protection and ours, we want to make certain -that everyone understands that there is no warranty for this free -software. If the software is modified by someone else and passed on, we -want its recipients to know that what they have is not the original, so -that any problems introduced by others will not reflect on the original -authors' reputations. - - Finally, any free program is threatened constantly by software -patents. We wish to avoid the danger that redistributors of a free -program will individually obtain patent licenses, in effect making the -program proprietary. To prevent this, we have made it clear that any -patent must be licensed for everyone's free use or not licensed at all. - - The precise terms and conditions for copying, distribution and -modification follow. - - GNU GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License applies to any program or other work which contains -a notice placed by the copyright holder saying it may be distributed -under the terms of this General Public License. The "Program", below, -refers to any such program or work, and a "work based on the Program" -means either the Program or any derivative work under copyright law: -that is to say, a work containing the Program or a portion of it, -either verbatim or with modifications and/or translated into another -language. (Hereinafter, translation is included without limitation in -the term "modification".) Each licensee is addressed as "you". - -Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running the Program is not restricted, and the output from the Program -is covered only if its contents constitute a work based on the -Program (independent of having been made by running the Program). -Whether that is true depends on what the Program does. - - 1. You may copy and distribute verbatim copies of the Program's -source code as you receive it, in any medium, provided that you -conspicuously and appropriately publish on each copy an appropriate -copyright notice and disclaimer of warranty; keep intact all the -notices that refer to this License and to the absence of any warranty; -and give any other recipients of the Program a copy of this License -along with the Program. - -You may charge a fee for the physical act of transferring a copy, and -you may at your option offer warranty protection in exchange for a fee. - - 2. You may modify your copy or copies of the Program or any portion -of it, thus forming a work based on the Program, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - - a) You must cause the modified files to carry prominent notices - stating that you changed the files and the date of any change. - - b) You must cause any work that you distribute or publish, that in - whole or in part contains or is derived from the Program or any - part thereof, to be licensed as a whole at no charge to all third - parties under the terms of this License. - - c) If the modified program normally reads commands interactively - when run, you must cause it, when started running for such - interactive use in the most ordinary way, to print or display an - announcement including an appropriate copyright notice and a - notice that there is no warranty (or else, saying that you provide - a warranty) and that users may redistribute the program under - these conditions, and telling the user how to view a copy of this - License. (Exception: if the Program itself is interactive but - does not normally print such an announcement, your work based on - the Program is not required to print an announcement.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Program, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Program, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Program. - -In addition, mere aggregation of another work not based on the Program -with the Program (or with a work based on the Program) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may copy and distribute the Program (or a work based on it, -under Section 2) in object code or executable form under the terms of -Sections 1 and 2 above provided that you also do one of the following: - - a) Accompany it with the complete corresponding machine-readable - source code, which must be distributed under the terms of Sections - 1 and 2 above on a medium customarily used for software interchange; or, - - b) Accompany it with a written offer, valid for at least three - years, to give any third party, for a charge no more than your - cost of physically performing source distribution, a complete - machine-readable copy of the corresponding source code, to be - distributed under the terms of Sections 1 and 2 above on a medium - customarily used for software interchange; or, - - c) Accompany it with the information you received as to the offer - to distribute corresponding source code. (This alternative is - allowed only for noncommercial distribution and only if you - received the program in object code or executable form with such - an offer, in accord with Subsection b above.) - -The source code for a work means the preferred form of the work for -making modifications to it. For an executable work, complete source -code means all the source code for all modules it contains, plus any -associated interface definition files, plus the scripts used to -control compilation and installation of the executable. However, as a -special exception, the source code distributed need not include -anything that is normally distributed (in either source or binary -form) with the major components (compiler, kernel, and so on) of the -operating system on which the executable runs, unless that component -itself accompanies the executable. - -If distribution of executable or object code is made by offering -access to copy from a designated place, then offering equivalent -access to copy the source code from the same place counts as -distribution of the source code, even though third parties are not -compelled to copy the source along with the object code. - - 4. You may not copy, modify, sublicense, or distribute the Program -except as expressly provided under this License. Any attempt -otherwise to copy, modify, sublicense or distribute the Program is -void, and will automatically terminate your rights under this License. -However, parties who have received copies, or rights, from you under -this License will not have their licenses terminated so long as such -parties remain in full compliance. - - 5. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Program or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Program (or any work based on the -Program), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Program or works based on it. - - 6. Each time you redistribute the Program (or any work based on the -Program), the recipient automatically receives a license from the -original licensor to copy, distribute or modify the Program subject to -these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties to -this License. - - 7. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Program at all. For example, if a patent -license would not permit royalty-free redistribution of the Program by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Program. - -If any portion of this section is held invalid or unenforceable under -any particular circumstance, the balance of the section is intended to -apply and the section as a whole is intended to apply in other -circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system, which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 8. If the distribution and/or use of the Program is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Program under this License -may add an explicit geographical distribution limitation excluding -those countries, so that distribution is permitted only in or among -countries not thus excluded. In such case, this License incorporates -the limitation as if written in the body of this License. - - 9. The Free Software Foundation may publish revised and/or new versions -of the General Public License from time to time. Such new versions will -be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - -Each version is given a distinguishing version number. If the Program -specifies a version number of this License which applies to it and "any -later version", you have the option of following the terms and conditions -either of that version or of any later version published by the Free -Software Foundation. If the Program does not specify a version number of -this License, you may choose any version ever published by the Free Software -Foundation. - - 10. If you wish to incorporate parts of the Program into other free -programs whose distribution conditions are different, write to the author -to ask for permission. For software which is copyrighted by the Free -Software Foundation, write to the Free Software Foundation; we sometimes -make exceptions for this. Our decision will be guided by the two goals -of preserving the free status of all derivatives of our free software and -of promoting the sharing and reuse of software generally. - - NO WARRANTY - - 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY -FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN -OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES -PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED -OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS -TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE -PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, -REPAIR OR CORRECTION. - - 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR -REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, -INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING -OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED -TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY -YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER -PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE -POSSIBILITY OF SUCH DAMAGES. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -convey the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License along - with this program; if not, write to the Free Software Foundation, Inc., - 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - -Also add information on how to contact you by electronic and paper mail. - -If the program is interactive, make it output a short notice like this -when it starts in an interactive mode: - - Gnomovision version 69, Copyright (C) year name of author - Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, the commands you use may -be called something other than `show w' and `show c'; they could even be -mouse-clicks or menu items--whatever suits your program. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the program, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the program - `Gnomovision' (which makes passes at compilers) written by James Hacker. - - , 1 April 1989 - Ty Coon, President of Vice - -This General Public License does not permit incorporating your program into -proprietary programs. If your program is a subroutine library, you may -consider it more useful to permit linking proprietary applications with the -library. If this is what you want to do, use the GNU Lesser General -Public License instead of this License. diff --git a/libs/pagure-hs/src/Fedora/Pagure.hs b/libs/pagure-hs/src/Fedora/Pagure.hs deleted file mode 100644 --- a/libs/pagure-hs/src/Fedora/Pagure.hs +++ /dev/null @@ -1,236 +0,0 @@ -{-# LANGUAGE CPP, OverloadedStrings #-} - -{- | -Copyright: (c) 2020 Jens Petersen -SPDX-License-Identifier: GPL-2.0-only -Maintainer: Jens Petersen - -Pagure REST client library --} - -module Fedora.Pagure - ( pagureProjectInfo - , pagureListProjects - , pagureListProjectIssues - , IssueTitleStatus(..) - , pagureListProjectIssueTitlesStatus - , pagureProjectIssueInfo - , pagureListGitBranches - , pagureListGitBranchesWithCommits - , pagureListUsers - , pagureUserForks - , pagureUserInfo - , pagureUserRepos - , pagureListGroups - , pagureProjectGitURLs - , queryPagure - , queryPagureSingle - , queryPagurePaged - , queryPagureCount - , makeKey - , makeItem - , maybeKey - , Query - , QueryItem - , lookupKey - , lookupKey' - ) where - -import Control.Monad -#if (defined(VERSION_lens_aeson)) -import Control.Lens -import Data.Aeson.Lens -#else -import Lens.Micro -import Lens.Micro.Aeson -#endif -import Data.Aeson.Types -import Data.Maybe -import Data.Text (Text) -import qualified Data.Text as T -import Network.HTTP.Query -import System.IO (hPutStrLn, stderr) - --- | Project info --- --- `pagureProjectInfo server ""` --- `pagureProjectInfo server "/"` --- --- https://pagure.io/api/0/#projects-tab -pagureProjectInfo :: String -> String -> IO (Either String Value) -pagureProjectInfo server project = do - let path = project - queryPagureSingle server path [] - --- | List projects --- --- https://pagure.io/api/0/#projects-tab -pagureListProjects :: String -> Query -> IO Value -pagureListProjects server params = do - let path = "projects" - queryPagure server path params - --- | List project issues --- --- https://pagure.io/api/0/#issues-tab -pagureListProjectIssues :: String -> String -> Query -> IO (Either String Value) -pagureListProjectIssues server repo params = do - let path = repo +/+ "issues" - queryPagureSingle server path params - -data IssueTitleStatus = - IssueTitleStatus { pagureIssueId :: Integer - , pagureIssueTitle :: String - , pagureIssueStatus :: T.Text - , pagureIssueCloseStatus :: Maybe T.Text - } - --- | List project issue titles --- --- https://pagure.io/api/0/#issues-tab -pagureListProjectIssueTitlesStatus :: String -> String -> Query - -> IO (Either String [IssueTitleStatus]) -pagureListProjectIssueTitlesStatus server repo params = do - let path = repo +/+ "issues" - res <- queryPagureSingle server path params - return $ case res of - Left e -> Left e - Right v -> Right $ v ^.. key (T.pack "issues") . values . _Object & mapMaybe parseIssue - where - parseIssue :: Object -> Maybe IssueTitleStatus - parseIssue = - parseMaybe $ \obj -> do - id' <- obj .: "id" - title <- obj .: "title" - status <- obj .: "status" - mcloseStatus <- obj .:? "close_status" - return $ IssueTitleStatus id' (T.unpack title) status mcloseStatus - --- | Issue information --- --- https://pagure.io/api/0/#issues-tab -pagureProjectIssueInfo :: String -> String -> Int -> IO (Either String Object) -pagureProjectIssueInfo server repo issue = do - let path = repo +/+ "issue" +/+ show issue - res <- queryPagureSingle server path [] - return $ case res of - Left e -> Left e - Right v -> Right $ v ^. _Object - --- | List repo branches --- --- https://pagure.io/api/0/#projects-tab -pagureListGitBranches :: String -> String -> IO (Either String [String]) -pagureListGitBranches server repo = do - let path = repo +/+ "git/branches" - res <- queryPagureSingle server path [] - return $ case res of - Left e -> Left e - Right v -> Right $ v ^.. key (T.pack "branches") . values . _String & map T.unpack - --- | List repo branches with commits --- --- https://pagure.io/api/0/#projects-tab -pagureListGitBranchesWithCommits :: String -> String -> IO (Either String Object) -pagureListGitBranchesWithCommits server repo = do - let path = repo +/+ "git/branches" - params = makeKey "with_commits" "1" - res <- queryPagureSingle server path params - return $ case res of - Left e -> Left e - Right v -> Right $ v ^. key (T.pack "branches") . _Object - --- | List users --- --- https://pagure.io/api/0/#users-tab -pagureListUsers :: String -> String -> IO Value -pagureListUsers server pat = do - let path = "users" - params = makeKey "pattern" pat - queryPagure server path params - --- | User information --- --- https://pagure.io/api/0/#users-tab -pagureUserInfo :: String -> String -> Query -> IO (Either String Value) -pagureUserInfo server user params = do - let path = "user" +/+ user - queryPagureSingle server path params - --- | List groups --- --- https://pagure.io/api/0/#groups-tab -pagureListGroups :: String -> Maybe String -> Query -> IO Value -pagureListGroups server mpat paging = do - let path = "groups" - params = maybeKey "pattern" mpat ++ paging - queryPagure server path params - --- | Project Git URLs --- --- https://pagure.io/api/0/#projects-tab -pagureProjectGitURLs :: String -> String -> IO (Either String Value) -pagureProjectGitURLs server repo = do - let path = repo +/+ "git/urls" - queryPagureSingle server path [] - - --- | low-level query -queryPagure :: String -> String -> Query -> IO Value -queryPagure server path params = - let url = "https://" ++ server +/+ "api/0" +/+ path - in webAPIQuery url params - --- | single query -queryPagureSingle :: String -> String -> Query -> IO (Either String Value) -queryPagureSingle server path params = do - res <- queryPagure server path params - if isJust (res ^? key "error") then - return $ Left (res ^. key "error" . _String & T.unpack) - else - return $ Right res - --- | count total number of hits -queryPagureCount :: String -> String -> Query -> String -> IO (Maybe Integer) -queryPagureCount server path params pagination = do - res <- queryPagure server path (params ++ makeKey "per_page" "1") - return $ res ^? key (T.pack pagination) . key "pages" . _Integer - --- | get all pages of results --- --- Note this can potentially download very large amount of data. --- For potentially large queries, it is a good idea to queryPagureCount first. -queryPagurePaged :: String -> String -> Query -> (String,String) -> IO [Value] -queryPagurePaged server path params (pagination,paging) = do - -- FIXME allow overriding per_page - let maxPerPage = "100" - res1 <- queryPagure server path (params ++ makeKey "per_page" maxPerPage) - let mpages = res1 ^? key (T.pack pagination) . key "pages" . _Integer - case mpages of - Nothing -> return [] - Just pages -> do - when (pages > 1) $ - hPutStrLn stderr $ "receiving " ++ show pages ++ " pages × " ++ maxPerPage ++ " results..." - rest <- mapM nextPage [2..pages] - return $ res1 : rest - where - nextPage p = - queryPagure server path (params ++ makeKey "per_page" "100" ++ makeKey paging (show p)) - --- | list user's repos -pagureUserRepos :: String -> String -> IO [Text] -pagureUserRepos server user = do - let path = "user" +/+ user - pages <- queryPagurePaged server path [] ("repos_pagination", "repopage") - return $ concatMap (getRepos "repos") pages - -getRepos :: Text -> Value -> [Text] -getRepos field result = - result ^.. key field . values . key "fullname" . _String - --- | list user's forks -pagureUserForks :: String -> String -> IO [Text] -pagureUserForks server user = do - let path = "user" +/+ user - pages <- queryPagurePaged server path [] ("forks_pagination", "forkpage") - return $ concatMap (getRepos "forks") pages diff --git a/libs/pdc-hs/LICENSE b/libs/pdc-hs/LICENSE deleted file mode 100644 --- a/libs/pdc-hs/LICENSE +++ /dev/null @@ -1,21 +0,0 @@ -MIT License - -Copyright (c) 2020 Jens Petersen - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. diff --git a/libs/pdc-hs/src/Fedora/PDC.hs b/libs/pdc-hs/src/Fedora/PDC.hs deleted file mode 100644 --- a/libs/pdc-hs/src/Fedora/PDC.hs +++ /dev/null @@ -1,209 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} - -{- | -Copyright: (c) 2020 Jens Petersen -SPDX-License-Identifier: MIT -Maintainer: Jens Petersen - -Fedora PDC web api client library --} - -module Fedora.PDC - ( fedoraPDC - , pdcArches - , pdcChangesets - , pdcComponentBranches - , pdcComponentBranchSLAs - , pdcComponentRelationshipTypes - , pdcComponentSLATypes - , pdcComposes - , pdcComposeImages - , pdcComposeImageRttTests - , pdcComposeRpms - , pdcComposeTreeRttTests - , pdcContentDeliveryContentFormats - , pdcGlobalComponents - , pdcImages - , pdcModules - , pdcProductVersions - , pdcProducts - , pdcReleases - , pdcWhereToFileBugs - , pdcRpms - , queryPDC - , lookupKey - , lookupKey' - , makeKey - , makeItem - , maybeKey - , Query - , QueryItem - , getResultsList - ) -where - -import Data.Aeson.Types -import Network.HTTP.Query - -fedoraPDC :: String -fedoraPDC = "pdc.fedoraproject.org" - --- | Arch List --- --- https://pdc.fedoraproject.org/rest_api/v1/arches/ -pdcArches :: String -> IO [Object] -pdcArches server = - lookupKey' "results" <$> queryPDC server "arches" [] - --- https://pdc.fedoraproject.org/rest_api/v1/auth/ * - --- https://pdc.fedoraproject.org/rest_api/v1/base-products/ no-op? - --- https://pdc.fedoraproject.org/rest_api/v1/bugzilla-components/ no-op? - --- | Changeset List --- --- https://pdc.fedoraproject.org/rest_api/v1/changesets/ -pdcChangesets :: String -> Query -> IO Object -pdcChangesets server = - queryPDC server "changesets" - --- | Sla To Component Branch List --- --- https://pdc.fedoraproject.org/rest_api/v1/component-branch-slas/ -pdcComponentBranchSLAs :: String -> Query -> IO Object -pdcComponentBranchSLAs server = - queryPDC server "component-branch-slas" - --- | Component Branch List --- --- https://pdc.fedoraproject.org/rest_api/v1/component-branches/ -pdcComponentBranches :: String -> Query -> IO Object -pdcComponentBranches server = - queryPDC server "component-branches" - --- | Release Component Relationship Type List --- --- https://pdc.fedoraproject.org/rest_api/v1/component-relationship-types/ -pdcComponentRelationshipTypes :: String -> IO [Object] -pdcComponentRelationshipTypes server = - lookupKey' "results" <$> queryPDC server "component-relationship-types" [] - --- | Sla List --- --- https://pdc.fedoraproject.org/rest_api/v1/component-sla-types/ -pdcComponentSLATypes :: String -> Query -> IO [Object] -pdcComponentSLATypes server params = - lookupKey' "results" <$> queryPDC server "component-sla-types" params - --- | Compose Image Rtt Test List --- --- https://pdc.fedoraproject.org/rest_api/v1/compose-image-rtt-tests/ (all untested?) -pdcComposeImageRttTests :: String -> Query -> IO Object -pdcComposeImageRttTests server = - queryPDC server "compose-image-rtt-tests" - --- | Compose Image Instance --- --- https://pdc.fedoraproject.org/rest_api/v1/compose-images/ {compose_id}/ -pdcComposeImages :: String -> String -> IO Object -pdcComposeImages server compose = - queryPDC server ("compose-images" +/+ compose ++ "/") [] - --- | Compose Rpm List (seems heavy) --- --- https://pdc.fedoraproject.org/rest_api/v1/compose-rpms/ {compose_id}/ -pdcComposeRpms :: String -> String -> IO Object -pdcComposeRpms server compose = - queryPDC server ("compose-rpms" +/+ compose ++ "/") [] - --- | Compose Tree Rtt Test List --- --- https://pdc.fedoraproject.org/rest_api/v1/compose-tree-rtt-tests/ -pdcComposeTreeRttTests :: String -> Query -> IO Object -pdcComposeTreeRttTests server = - queryPDC server "compose-tree-rtt-tests" - --- | Compose List --- --- https://pdc.fedoraproject.org/rest_api/v1/composes/ -pdcComposes :: String -> Maybe String -> Query -> IO Object -pdcComposes server mcompose params = do - let path = "composes" +/+ maybe "" (++ "/") mcompose - queryPDC server path params - --- https://pdc.fedoraproject.org/rest_api/v1/composes/%7Bcompose_id%7D/rpm-mapping/%7Bpackage%7D/ - --- | Content Format List --- --- https://pdc.fedoraproject.org/rest_api/v1/content-delivery-content-formats/ -pdcContentDeliveryContentFormats :: String -> Query -> IO [Object] -pdcContentDeliveryContentFormats server params = - lookupKey' "results" <$> queryPDC server "content-delivery-content-formats" params - --- | Global Component List --- --- https://pdc.fedoraproject.org/rest_api/v1/global-components/ -pdcGlobalComponents :: String -> Query -> IO Object -pdcGlobalComponents server = - queryPDC server "global-components" - --- | Image List --- --- https://pdc.fedoraproject.org/rest_api/v1/images/ -pdcImages :: String -> Query -> IO Object -pdcImages server = - queryPDC server "images" - --- | Module List --- --- https://pdc.fedoraproject.org/rest_api/v1/modules/ -pdcModules :: String -> Query -> IO Object -pdcModules server = - queryPDC server "modules" - --- | Product Version List --- --- https://pdc.fedoraproject.org/rest_api/v1/product-versions/ -pdcProductVersions :: String -> Query -> IO [Object] -pdcProductVersions server params = - lookupKey' "results" <$> queryPDC server "product-versions" params - --- | Product List --- --- https://pdc.fedoraproject.org/rest_api/v1/products/ -pdcProducts :: String -> Query -> IO [Object] -pdcProducts server params = - lookupKey' "results" <$> queryPDC server "products" params - --- | Release List --- --- https://pdc.fedoraproject.org/rest_api/v1/releases/ -pdcReleases :: String -> Query -> IO Object -pdcReleases server = - queryPDC server "releases" - --- | Filter Bugzilla Products And Components List --- --- https://pdc.fedoraproject.org/rest_api/v1/rpc/where-to-file-bugs/ -pdcWhereToFileBugs :: String -> Query -> IO Object -pdcWhereToFileBugs server = - queryPDC server "rpc/where-to-file-bugs" - --- | Rpm List --- --- https://pdc.fedoraproject.org/rest_api/v1/rpms/ -pdcRpms :: String -> Query -> IO Object -pdcRpms server = - queryPDC server "rpms" - --- | low-level query -queryPDC :: String -> String -> Query -> IO Object -queryPDC server path params = - let url = "https://" ++ server +/+ "rest_api/v1" +/+ path - in webAPIQuery url params - --- | Get results key from a response object -getResultsList :: Object -> [Object] -getResultsList = lookupKey' "results" diff --git a/src/Bodhi.hs b/src/Bodhi.hs --- a/src/Bodhi.hs +++ b/src/Bodhi.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP, OverloadedStrings #-} module Bodhi ( bodhiCreateOverride, @@ -8,6 +8,9 @@ ) where +#if MIN_VERSION_aeson(2,0,0) +import Data.Aeson.Key (fromText) +#endif import Data.Aeson.Types (Object, (.:), parseEither) import Data.Char (toLower) import Fedora.Bodhi hiding (bodhiUpdate) @@ -34,7 +37,12 @@ lookupKey'' k obj = let errMsg e = error $ e ++ " " ++ show obj in -- bodhi-hs has lookupKeyEither - either errMsg id $ parseEither (.: k) obj + either errMsg id $ parseEither (.: fromText k) obj + +#if !MIN_VERSION_aeson(2,0,0) + fromText :: T.Text -> T.Text + fromText = id +#endif -- FIXME should determine 3 days for branched devel release -- FIXME handle expired override? diff --git a/src/Branches.hs b/src/Branches.hs --- a/src/Branches.hs +++ b/src/Branches.hs @@ -6,7 +6,7 @@ isEPELBranch, localBranches, pagurePkgBranches, - mockConfig, + mockRoot, module Distribution.Fedora.Branch, AnyBranch(..), anyBranch, @@ -17,8 +17,11 @@ listOfBranches, listOfAnyBranches, gitCurrentBranch, + gitCurrentBranch', + checkOnBranch, systemBranch, getReleaseBranch, + getReleaseBranchWarn, branchVersion, anyBranchToRelease, getRequestedBranches, @@ -26,12 +29,13 @@ ) where import Common +import Common.System import Data.Either import Data.Tuple import Distribution.Fedora.Branch -import SimpleCmd import SimpleCmd.Git +import System.Info (arch) import Pagure import Prompt @@ -99,10 +103,12 @@ where include p e = e ++ ": " ++ p -mockConfig :: Branch -> String -mockConfig Rawhide = "fedora-rawhide-x86_64" -mockConfig (Fedora n) = "fedora-" ++ show n ++ "-x86_64" -mockConfig (EPEL n) = "epel-" ++ show n ++ "-x86_64" +mockRoot :: Branch -> String +mockRoot br = do + case br of + Rawhide -> "fedora-rawhide-" ++ arch + Fedora n -> "fedora-" ++ show n ++ "-" ++ arch + EPEL n -> "epel-" ++ show n ++ "-" ++ arch ------ @@ -167,9 +173,37 @@ getReleaseBranch = gitCurrentBranch >>= anyBranchToRelease +getReleaseBranchWarn :: IO Branch +getReleaseBranchWarn = + gitCurrentBranchWarn >>= anyBranchToRelease + gitCurrentBranch :: IO AnyBranch -gitCurrentBranch = +gitCurrentBranch = do + br <- gitCurrentBranch' + if br == OtherBranch "HEAD" + then do + dir <- getDirectoryName + prompt_ $ dir ++ ": " ++ show br ++ " is not a branch, please fix" + gitCurrentBranch + else return br + +gitCurrentBranch' :: IO AnyBranch +gitCurrentBranch' = do anyBranch <$> git "rev-parse" ["--abbrev-ref", "HEAD"] + +gitCurrentBranchWarn :: IO AnyBranch +gitCurrentBranchWarn = do + br <- gitCurrentBranch + if br == OtherBranch "master" + then do + dir <- getDirectoryName + prompt_ $ dir ++ ": " ++ show br ++ " is not a valid branch, please use 'rename-rawhide'" + gitCurrentBranchWarn + else return br + + +checkOnBranch :: IO () +checkOnBranch = void gitCurrentBranch anyBranchToRelease :: AnyBranch -> IO Branch anyBranchToRelease (RelBranch rbr) = return rbr diff --git a/src/Bugzilla.hs b/src/Bugzilla.hs --- a/src/Bugzilla.hs +++ b/src/Bugzilla.hs @@ -6,10 +6,13 @@ BugId, -- session BugzillaSession, - bugIdsSession, bugsSession, - bzLoginSession, + bugsAnon, + bugIdsAnon, + bzAnonSession, bzReviewSession, + bzReviewAnon, + getBzUser, reviewBugIdSession, approvedReviewBugIdSession, approvedReviewBugSession, @@ -56,7 +59,6 @@ putBugId, -- request newBzRequest, - intAsText, makeTextItem ) where @@ -65,7 +67,6 @@ import qualified Common.Text as T import Prompt -import Control.Exception (finally) import Data.Aeson.Types (Array, Object) import qualified Data.ByteString.Char8 as B import Data.ByteString.UTF8 @@ -73,12 +74,10 @@ import Network.HTTP.Conduit import Network.HTTP.Query import Network.HTTP.Simple -import System.Environment import System.Environment.XDG.BaseDir -import System.IO (hSetEcho, stdin) import qualified Text.Email.Validate as Email -import Web.Bugzilla.RedHat -import Web.Bugzilla.RedHat.Search +import Web.RedHatBugzilla +import Web.RedHatBugzilla.Search createBug :: BugzillaSession -> [(String,String)] -> IO Int createBug session params = do @@ -136,14 +135,25 @@ brc :: T.Text brc = "bugzilla.redhat.com" -bzReviewSession :: IO (Maybe BugId,BugzillaSession) +bzReviewAnon :: IO (Maybe BugId) +bzReviewAnon = do + pkg <- getDirectoryName + bids <- bugIdsAnon $ + pkgReviews pkg .&&. statusOpen .&&. reviewApproved + return $ case bids of + [bid] -> Just bid + _ -> Nothing + +bzReviewSession :: IO (Maybe (BugId,BugzillaSession)) bzReviewSession = do pkg <- getDirectoryName - (bids,session) <- bugIdsSession $ - pkgReviews pkg .&&. statusOpen .&&. reviewApproved + bids <- bugIdsAnon $ + pkgReviews pkg .&&. statusOpen .&&. reviewApproved case bids of - [bid] -> return (Just bid, session) - _ -> return (Nothing, session) + [bid] -> do + session <- bzApiKeySession + return $ Just (bid, session) + _ -> return Nothing newtype BzUserRC = BzUserRC {rcUserEmail :: UserEmail} deriving (Eq, Show) @@ -151,89 +161,75 @@ emailIsValid :: String -> Bool emailIsValid = Email.isValid . B.pack --- FIXME support bugzilla API key -bzLoginSession :: IO (BugzillaSession, UserEmail) -bzLoginSession = do - user <- getBzUser - ctx <- newBugzillaContext brc - session <- getBzLoginSession ctx user - return (session,user) +getBzUser :: IO UserEmail +getBzUser = do + config <- getUserConfigFile "fbrnch" "bugzilla" + haveConfig <- doesFileExist config + if haveConfig + then readIniConfig config rcParser rcUserEmail + else do + -- FIXME: option to override email + email <- prompt "Bugzilla Username" + when (emailIsValid email) $ do + let configDir = takeDirectory config + configDirExists <- doesDirectoryExist configDir + unless configDirExists $ createDirectory configDir + T.writeFile config $ "[" <> brc <> "]\nuser = " <> T.pack email <> "\n" + putStrLn $ "Saved in " ++ config ++ "\n" + getBzUser where - getBzUser :: IO UserEmail - getBzUser = do - home <- getEnv "HOME" - let rc = home ".bugzillarc" - -- FIXME assumption if file exists then it has b.r.c user - ifM (doesFileExist rc) - (readIniConfig rc rcParser rcUserEmail) $ - do - -- FIXME: option to override email - email <- prompt "Bugzilla Username" - when (emailIsValid email) $ do - T.writeFile rc $ "[" <> brc <> "]\nuser = " <> T.pack email <> "\n" - putStrLn $ "Saved in " ++ rc - getBzUser - where - rcParser :: IniParser BzUserRC - rcParser = - section brc $ - BzUserRC <$> fieldOf "user" string + rcParser :: IniParser BzUserRC + rcParser = + section brc $ + BzUserRC <$> fieldOf "user" string - getBzLoginSession :: BugzillaContext -> UserEmail -> IO BugzillaSession - getBzLoginSession ctx user = do - cache <- getUserCacheFile "python-bugzilla" "bugzillatoken" - let cacheDir = takeDirectory cache - cacheDirExists <- doesDirectoryExist cacheDir - unless cacheDirExists $ createDirectory cacheDir - tokenstatus <- ifM (notM (doesFileExist cache)) (return NoToken) $ - do - token <- readIniConfig cache rcParser bzToken - let session = LoginSession ctx $ BugzillaToken token - let validreq = setRequestCheckStatus $ - newBzRequest session ["valid_login"] [("login",Just user)] - valid <- lookupKey' "result" . getResponseBody <$> httpJSON validreq - return $ if valid then ValidToken session else InvalidToken token - case tokenstatus of - ValidToken session -> return session - InvalidToken oldtoken -> do - token <- bzLogin - cmd_ "sed" ["-i", "s/" ++ T.unpack oldtoken ++ "/" ++ T.unpack token ++ "/", cache] - return $ LoginSession ctx $ BugzillaToken token - NoToken -> do - token <- bzLogin - T.writeFile cache $ "[" <> brc <> "]\ntoken = " <> token <> "\n" - putStrLn $ "Saved in " ++ cache - return $ LoginSession ctx $ BugzillaToken token - where - rcParser :: IniParser BzTokenConf - rcParser = - section brc $ - BzTokenConf <$> fieldOf "token" string +bzAnonSession :: BugzillaSession +bzAnonSession = anonymousSession brc - bzLogin :: IO T.Text - bzLogin = do - putStrLn "No valid bugzilla login token, please login:" - passwd <- withoutEcho $ prompt "Bugzilla Password" - if null passwd then bzLogin - else do - let anonsession = AnonymousSession ctx - tokenReq = setRequestCheckStatus $ - newBzRequest anonsession ["login"] - [("login", Just user), - makeTextItem "password" passwd] - res <- getResponseBody <$> httpJSON tokenReq - case lookupKey "token" res of - Nothing -> T.putStrLn (lookupKey' "message" res) >> bzLogin - Just token -> return token +-- bzAnonSession' :: IO (BugzillaSession,BugzillaContext) +-- bzAnonSession' = +-- context <- newBugzillaContext brc +-- return (AnonymousSession context, context) - withoutEcho :: IO a -> IO a - withoutEcho action = - finally (hSetEcho stdin False >> action) (hSetEcho stdin True) +bzApiKeySession :: IO BugzillaSession +bzApiKeySession = do + (config,exists) <- do + rc1 <- getUserConfigFile "python-bugzilla" "bugzillarc" + haveRc1 <- doesFileExist rc1 + if haveRc1 + then return (rc1,haveRc1) + else do + home <- getHomeDirectory + let rc2 = home ".bugzillarc" + haveRc2 <- doesFileExist rc2 + return $ if haveRc2 + then (rc2,haveRc2) + else (rc1,False) + if not exists + then + -- do + -- let configDir = takeDirectory config + -- configDirExists <- doesDirectoryExist configDir + -- unless configDirExists $ createDirectory configDir + error' $ unlines + ["No Bugzilla API key found", + "Create a key at https://bugzilla.redhat.com/userprefs.cgi?tab=apikey", + "Save the key under in '" ++ config ++ "' under:", + "[bugzilla.redhat.com]", + apiKeyField ++ " = "] + else do + apikey <- readIniConfig config rcParser bzApiKey + return $ ApiKeySession brc $ BugzillaApiKey apikey + where + apiKeyField = "api_key" -newtype BzTokenConf = BzTokenConf {bzToken :: T.Text} - deriving (Eq, Show) + rcParser :: IniParser BzApiKeyConf + rcParser = + section brc $ + BzApiKeyConf <$> fieldOf (T.pack apiKeyField) string -data BzTokenStatus = ValidToken BugzillaSession | InvalidToken T.Text | NoToken +newtype BzApiKeyConf = BzApiKeyConf {bzApiKey :: T.Text} + deriving (Eq, Show) bugIdIs :: BugId -> SearchExpression bugIdIs bid = BugIdField .==. bid @@ -286,42 +282,49 @@ summaryContains keywrd = SummaryField `contains` T.pack keywrd -bugIdsSession :: SearchExpression -> IO ([BugId],BugzillaSession) -bugIdsSession query = do - (session,_) <- bzLoginSession - bugs <- searchBugs' session query - return (bugs, session) +bugIdsAnon :: SearchExpression -> IO [BugId] +bugIdsAnon = searchBugs' bzAnonSession +bugsAnon :: SearchExpression -> IO [Bug] +bugsAnon = searchBugs bzAnonSession + +-- FIXME name is ambiguous bugsSession :: SearchExpression -> IO ([Bug],BugzillaSession) bugsSession query = do - (session,_) <- bzLoginSession + session <- bzApiKeySession bugs <- searchBugs session query return (bugs, session) reviewBugIdSession :: String -> IO (BugId,BugzillaSession) reviewBugIdSession pkg = do - (bugs,session) <- bugIdsSession $ pkgReviews pkg .&&. statusOpen + bugs <- bugIdsAnon $ pkgReviews pkg .&&. statusOpen case bugs of [] -> error $ "No review bug found for " ++ pkg - [bug] -> return (bug, session) + [bug] -> do + session <- bzApiKeySession + return (bug, session) _ -> error' "more than one review bug found!" approvedReviewBugIdSession :: String -> IO (BugId,BugzillaSession) approvedReviewBugIdSession pkg = do - (bugs,session) <- bugIdsSession $ - pkgReviews pkg .&&. statusOpen .&&. reviewApproved + bugs <- bugIdsAnon $ + pkgReviews pkg .&&. statusOpen .&&. reviewApproved case bugs of [] -> error $ "No review bug found for " ++ pkg - [bug] -> return (bug, session) + [bug] -> do + session <- bzApiKeySession + return (bug, session) _ -> error' "more than one review bug found!" approvedReviewBugSession :: String -> IO (Bug,BugzillaSession) approvedReviewBugSession pkg = do - (bugs,session) <- bugsSession $ - pkgReviews pkg .&&. statusOpen .&&. reviewApproved + bugs <- bugsAnon $ + pkgReviews pkg .&&. statusOpen .&&. reviewApproved case bugs of [] -> error $ "No review bug found for " ++ pkg - [bug] -> return (bug, session) + [bug] -> do + session <- bzApiKeySession + return (bug, session) _ -> error' "more than one review bug found!" reviewBugToPackage :: Bug -> String @@ -378,11 +381,11 @@ putReviewBug :: Bool -> Bug -> IO () putReviewBug short bug = do - if short then putStr $ reviewBugToPackage bug ++ " " + if short + then putStr $ reviewBugToPackage bug ++ " " else do - putStrLn $ reviewBugToPackage bug ++ " (" ++ T.unpack (bugStatus bug) ++ ")" + putStr $ T.unpack (bugStatus bug) ++ " " ++ reviewBugToPackage bug ++ ": " putBugId $ bugId bug - putStrLn "" putBug :: Bug -> IO () putBug bug = do @@ -398,8 +401,8 @@ prodVersion = T.unwords (bugVersion bug) putBugId :: BugId -> IO () -putBugId = - T.putStrLn . (("https://" <> brc <> "/show_bug.cgi?id=") <>) . intAsText +putBugId bid = + putStrLn $ "https://" <> T.unpack brc <> "/show_bug.cgi?id=" <> show bid -- uniq for lists dropDuplicates :: Eq a => [a] -> [a] diff --git a/src/Cmd/Bugs.hs b/src/Cmd/Bugs.hs --- a/src/Cmd/Bugs.hs +++ b/src/Cmd/Bugs.hs @@ -17,5 +17,5 @@ case keyword of Nothing -> statusOpen Just key -> statusOpen .&&. summaryContains key - (bugs, _) <- bugsSession $ pkgBugs (unPackage pkg) .&&. query + bugs <- bugsAnon $ pkgBugs (unPackage pkg) .&&. query mapM_ putBugVer $ sortBugsByProduct bugs diff --git a/src/Cmd/Build.hs b/src/Cmd/Build.hs --- a/src/Cmd/Build.hs +++ b/src/Cmd/Build.hs @@ -27,20 +27,23 @@ , buildoptNoFailFast :: Bool , buildoptTarget :: Maybe String , buildoptOverride :: Bool + , buildoptWaitrepo :: Maybe Bool , buildoptDryrun :: Bool , buildoptUpdateType :: Maybe UpdateType + , buildoptUseChangelog :: Bool + , buildoptByPackage :: Bool } +-- FIXME --sort -- FIXME --add-to-update nvr --- FIXME vertical vs horizontal builds (ie by package or branch) -- FIXME --rpmlint (only run for rawhide?) -- FIXME support --wait-build=NVR -- FIXME build from ref -- FIXME provide direct link to failed task/build.log -- FIXME --auto-override for deps in testing --- FIXME -B fails to find new branches --- FIXME --no-wait +-- FIXME -B fails to find new branches (fixed?) -- FIXME --ignore-dirty?? +-- FIXME disallow override for autoupdate? buildCmd :: BuildOpts -> (BranchesReq, [String]) -> IO () buildCmd opts (breq, pkgs) = do let singleBrnch = if isJust (buildoptTarget opts) @@ -49,7 +52,13 @@ let mlastOfPkgs = if length pkgs > 1 then Just (Package (last pkgs)) else Nothing - withPackageByBranches (Just False) cleanGitFetchActive singleBrnch (buildBranch mlastOfPkgs opts) (breq, pkgs) + if not (buildoptByPackage opts) && breq /= Branches [] && length pkgs > 1 + then do + brs <- listOfBranches True True breq + forM_ brs $ \br -> + withPackageByBranches (Just False) cleanGitFetchActive singleBrnch (buildBranch mlastOfPkgs opts) (Branches [br], pkgs) + else + withPackageByBranches (Just False) cleanGitFetchActive singleBrnch (buildBranch mlastOfPkgs opts) (breq, pkgs) -- FIXME what if untracked files buildBranch :: Maybe Package -> BuildOpts -> Package -> AnyBranch -> IO () @@ -73,25 +82,28 @@ let spec = packageSpec pkg checkForSpecFile spec checkSourcesMatch spec - nvr <- pkgNameVerRel' br spec unpushed <- gitShortLog $ "origin/" ++ show br ++ "..HEAD" - unless (null unpushed) $ - putStrLn $ "\n" ++ nvr ++ "\n" - when (not merged || br == Rawhide) $ - unless (null unpushed) $ do - putStrLn "Local commits:" - mapM_ putStrLn unpushed + nvr <- pkgNameVerRel' br spec + putStrLn "" mpush <- if null unpushed then return Nothing - else + else do + when (not merged || br == Rawhide) $ do + putStrLn $ nvr ++ "\n" + putStrLn "Local commits:" + mapM_ putStrLn unpushed + putStrLn "" -- see mergeBranch for: unmerged == 1 (774b5890) if tty && (not merged || (newrepo && ancestor && length unmerged == 1)) - then refPrompt unpushed $ "Press Enter to push and build" ++ (if length unpushed > 1 then "; or give a ref to push" else "") ++ (if not newrepo then "; or 'no' to skip pushing" else "") - else return $ Just Nothing + then do + refPrompt unpushed $ "Press Enter to push and build" ++ (if length unpushed > 1 then "; or give a ref to push" else "") ++ (if not newrepo then "; or 'no' to skip pushing" else "") + else return $ Just Nothing let dryrun = buildoptDryrun opts buildstatus <- maybeTimeout 30 $ kojiBuildStatus nvr let mtarget = buildoptTarget opts target = fromMaybe (branchTarget br) mtarget + mwaitrepo = buildoptWaitrepo opts + override = buildoptOverride opts case buildstatus of Just BuildComplete -> do putStrLn $ nvr ++ " is already built" @@ -102,13 +114,14 @@ autoupdate <- checkAutoBodhiUpdate br unless autoupdate $ do unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-updates-pending", show br ++ "-updates-testing", show br ++ "-updates-testing-pending"]) $ do - mbug <- fst <$> bzReviewSession + mbug <- bzReviewAnon bodhiUpdate dryrun mbug spec nvr unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $ - when (buildoptOverride opts) $ + when override $ bodhiCreateOverride dryrun Nothing nvr - when (isJust mlastpkg && mlastpkg /= Just pkg) $ - when (buildoptOverride opts || autoupdate) $ + when (isJust mlastpkg && mlastpkg /= Just pkg || mwaitrepo == Just True) $ + when ((override && mwaitrepo /= Just False) || + (autoupdate && mwaitrepo == Just True)) $ kojiWaitRepo dryrun target nvr Just BuildBuilding -> do putStrLn $ nvr ++ " is already building" @@ -132,8 +145,10 @@ let tag = fromMaybe (branchDestTag br) mtarget mlatest <- kojiLatestNVR tag $ unPackage pkg if equivNVR nvr (fromMaybe "" mlatest) - then error' $ nvr ++ " is already latest" ++ if Just nvr /= mlatest then " (modulo disttag)" else "" + then putStrLn $ nvr ++ " is already latest" ++ if Just nvr /= mlatest then " (modulo disttag)" else "" else do + when (null unpushed || merged && br /= Rawhide) $ do + putStrLn $ nvr ++ "\n" firstBuild <- do mtestingRepo <- bodhiTestingRepo br case mtestingRepo of @@ -162,11 +177,7 @@ kojiBuildBranch target pkg mbuildref ["--fail-fast" | not (buildoptNoFailFast opts)] mBugSess <- if firstBuild - then do - (mbid, session) <- bzReviewSession - return $ case mbid of - Just bid -> Just (bid,session) - Nothing -> Nothing + then bzReviewSession else return Nothing autoupdate <- checkAutoBodhiUpdate br if autoupdate @@ -177,17 +188,20 @@ -- FIXME diff previous changelog? bodhiUpdate dryrun (fmap fst mBugSess) spec nvr -- FIXME prompt for override note - when (buildoptOverride opts) $ + when override $ bodhiCreateOverride dryrun Nothing nvr - when (isJust mlastpkg && mlastpkg /= Just pkg) $ - when (buildoptOverride opts || autoupdate) $ + when (isJust mlastpkg && mlastpkg /= Just pkg || mwaitrepo == Just True) $ + when ((override && mwaitrepo /= Just False) || + (autoupdate && mwaitrepo == Just True)) $ kojiWaitRepo dryrun target nvr where bodhiUpdate :: Bool -> Maybe BugId -> FilePath -> String -> IO () bodhiUpdate dryrun mreview spec nvr = do changelog <- if isJust mreview then getSummaryURL spec - else getChangeLog (Just "update") spec + else if buildoptUseChangelog opts + then cleanChangelog spec + else changeLogPrompt (Just "update") spec let cbugs = mapMaybe extractBugReference $ lines changelog bugs = let bids = [show rev | Just rev <- [mreview]] ++ cbugs in if null bids then [] else ["--bugs", intercalate "," bids] diff --git a/src/Cmd/Bump.hs b/src/Cmd/Bump.hs --- a/src/Cmd/Bump.hs +++ b/src/Cmd/Bump.hs @@ -10,39 +10,58 @@ import Koji import Package -bumpPkgs :: Maybe CommitOpt -> (BranchesReq,[String]) -> IO () -bumpPkgs mopt = - withPackageByBranches (Just False) cleanGitFetchActive AnyNumber bumpPkg +import System.IO.Extra + +-- FIXME --force +-- FIXME --target +-- FIXME detect rpmautospec and add empty commit +bumpPkgs :: Bool -> Maybe CommitOpt -> (BranchesReq,[String]) -> IO () +bumpPkgs local mopt = + withPackageByBranches (Just local) (if local then cleanGit else cleanGitFetchActive) + AnyNumber bumpPkg where bumpPkg :: Package -> AnyBranch -> IO () bumpPkg pkg br = do - -- FIXME or check for unpushed bump - mlatest <- - case br of - RelBranch rbr -> - let tag = branchDestTag rbr in - kojiLatestNVR tag $ unPackage pkg - _ -> return Nothing - spec <- localBranchSpecFile pkg br - rbr <- - case br of - RelBranch rbr -> return rbr - OtherBranch _ -> systemBranch - nvr <- pkgNameVerRel' rbr spec - if equivNVR nvr (fromMaybe "" mlatest) then do - git_ "log" ["origin..HEAD", "--pretty=oneline"] - let clmsg = - case mopt of - Just (CommitMsg msg) -> msg - _ -> "rebuild" - cmd_ "rpmdev-bumpspec" ["-c", clmsg, spec] - let copts = - case mopt of - Nothing -> ["-m", "bump release"] - Just opt -> - case opt of - CommitMsg msg -> ["-m", msg] - -- FIXME reject amend if already pushed - CommitAmend -> ["--amend", "--no-edit"] - git_ "commit" $ "-a" : copts - else putStrLn "already bumped" + dead <- doesFileExist "dead.package" + if dead + then putStrLn "dead package" + else do + spec <- localBranchSpecFile pkg br + rbr <- + case br of + RelBranch rbr -> return rbr + OtherBranch _ -> systemBranch + newnvr <- pkgNameVerRel' rbr spec + moldnvr <- + if local + then do + withTempFile $ \tempfile -> do + git "show" ["origin:" ++ spec] >>= writeFile tempfile + pkgNameVerRel rbr tempfile + else + case br of + RelBranch rbr' -> + let tag = branchDestTag rbr' in + kojiLatestNVR tag $ unPackage pkg + -- FIXME fallback to local? + _ -> return Nothing + if equivNVR newnvr (fromMaybe "" moldnvr) + then do + git_ "log" ["origin..HEAD", "--pretty=oneline"] + let clmsg = + case mopt of + Just (CommitMsg msg) -> msg + _ -> "rebuild" + -- FIXME check for rpmautospec first + cmd_ "rpmdev-bumpspec" ["-c", clmsg, spec] + let copts = + case mopt of + Nothing -> ["-m", "bump release"] + Just opt -> + case opt of + CommitMsg msg -> ["-m", msg] + -- FIXME reject amend if already pushed + CommitAmend -> ["--amend", "--no-edit"] + -- FIXME quiet commit? + git_ "commit" $ "-a" : copts + else putStrLn "already bumped" diff --git a/src/Cmd/Clone.hs b/src/Cmd/Clone.hs --- a/src/Cmd/Clone.hs +++ b/src/Cmd/Clone.hs @@ -11,7 +11,7 @@ data CloneRequest = CloneUser (Maybe String) | ClonePkgs [String] -- FIXME allow pagure repo wildcard --- FIXME --anonymous (detect commit rights? or a ssh key?) +-- FIXME (detect commit rights or a ssh key?) cloneCmd :: Maybe Branch -> CloneRequest -> IO () cloneCmd mbr request = do pkgs <- case request of @@ -20,4 +20,6 @@ map (takeFileName . T.unpack) <$> pagureUserRepos srcfpo userid -- FIXME detect/prevent "path/dir" ClonePkgs ps -> return ps - mapM_ (clonePkg False mbr) pkgs + mfas <- maybeFasIdFromKrb + let cloneuser = maybe AnonClone (const UserClone) mfas + mapM_ (clonePkg False cloneuser mbr) pkgs diff --git a/src/Cmd/Commit.hs b/src/Cmd/Commit.hs --- a/src/Cmd/Commit.hs +++ b/src/Cmd/Commit.hs @@ -10,8 +10,11 @@ import Prompt -- FIXME use branches after all? -commitPkgs :: Maybe CommitOpt -> [String] -> IO () -commitPkgs mopt args = +-- FIXME handle multiline changelog entries with "-m description" +commitPkgs :: Maybe CommitOpt -> Bool -> Bool -> [String] -> IO () +commitPkgs mopt firstLine notstaged args = do + when (isJust mopt && firstLine) $ + error' "--first-line cannot be used with other commit msg options" if null args then commitPkg "." else mapM_ commitPkg args @@ -30,19 +33,31 @@ Nothing -> do changelog <- do spec <- findSpecfile - clog <- cleanChangelog <$> cmd "rpmspec" ["-q", "--srpm", "--qf", "%{changelogtext}", spec] - when (length (lines clog) > 1) $ - putStrLn clog - diff <- git "diff" ["-U0", "HEAD"] - if ("+- " ++ clog) `elem` lines diff - then putStrLn clog >> return clog - else putStrLn diff >> readCommitMsg + clog <- lines <$> cleanChangelog spec + case clog of + [] -> readCommitMsg + [msg] -> putStrLn msg >> return msg + msgs -> + if firstLine + then return $ removePrefix "- " $ head msgs + else do + diff <- git "diff" ["-U0", "HEAD"] + let newlogs = + filter (\c -> ("+- " ++ c) `elem` lines diff) clog + case newlogs of + [] -> putStrLn diff >> readCommitMsg + [msg] -> putStrLn msg >> return (removePrefix "- " msg) + _ -> mapM_ putStrLn newlogs >> readCommitMsg return ["-m", changelog] - git_ "commit" $ "-a" : opts + git_ "commit" $ ["-a" | notstaged] ++ opts readCommitMsg :: IO String readCommitMsg = do - clog <- prompt "\nPlease input the commit message" - if null clog - then readCommitMsg - else return clog + tty <- isTty + if tty + then do + clog <- prompt "\nPlease input the commit message" + if null clog + then readCommitMsg + else return clog + else error' "please input commit message in a terminal" diff --git a/src/Cmd/Copr.hs b/src/Cmd/Copr.hs --- a/src/Cmd/Copr.hs +++ b/src/Cmd/Copr.hs @@ -12,6 +12,7 @@ import Common.System import qualified Common.Text as T import Package +import Types (Archs(..)) import Data.Ini.Config import Network.HTTP.Query (lookupKey, lookupKey') @@ -30,9 +31,12 @@ -- FIXME repo config with a setup command? -- FIXME interact with copr dist-git -- FIXME parallel copr builds -coprCmd :: Bool -> Bool -> BuildBy -> [String] -> String +-- FIXME --exclude-arch +-- FIXME skip existing builds +-- FIXME distless srpm +coprCmd :: Bool -> Bool -> BuildBy -> Maybe Archs -> String -> (BranchesReq,[String]) -> IO () -coprCmd dryrun listchroots buildBy archs project (breq, pkgs) = do +coprCmd dryrun listchroots buildBy marchs project (breq, pkgs) = do chroots <- coprGetChroots if listchroots then mapM_ putStrLn chroots @@ -53,12 +57,18 @@ if null brs then return $ (map (releaseBranch . T.pack) . nub . map removeArch) chroots else listOfBranches False False breq + BranchOpt AllFedora -> filter isFedoraBranch <$> getFedoraBranches + BranchOpt AllEPEL -> filter isEPELBranch <$> getFedoraBranched _ -> listOfBranches False False breq let buildroots = reverseSort $ - if null archs - then [chroot | chroot <- chroots, removeArch chroot `elem` map branchRelease branches] - else [chroot | arch <- archs, br <- branches, let chroot = branchRelease br ++ "-" ++ arch, chroot `elem` chroots] + case marchs of + Nothing -> + [chroot | chroot <- chroots, removeArch chroot `elem` map branchRelease branches] + Just (Archs archs) -> + [chroot | arch <- archs, br <- branches, let chroot = branchRelease br ++ "-" ++ arch, chroot `elem` chroots] + Just (ExcludedArchs exarchs) -> + [chroot | chroot <- chroots, takeArch chroot `notElem` exarchs, removeArch chroot `elem` map branchRelease branches] if null buildroots then error' "No valid chroots" else return buildroots @@ -92,6 +102,7 @@ staggerBuilds srpm initialChroots remainingChroots removeArch relarch = init $ dropWhileEnd (/= '-') relarch + takeArch relarch = takeWhileEnd (/= '-') relarch staggerBuilds srpm initialChroots remainingChroots = do mapM_ (coprBuild dryrun project srpm) initialChroots diff --git a/src/Cmd/Diff.hs b/src/Cmd/Diff.hs --- a/src/Cmd/Diff.hs +++ b/src/Cmd/Diff.hs @@ -1,5 +1,6 @@ module Cmd.Diff ( diffCmd, + DiffFilter(..), DiffFormat(..), DiffWork(..) ) where @@ -11,65 +12,80 @@ import Package data DiffFormat = - DiffDefault | DiffQuiet | DiffContext Int | DiffMinimal | DiffStats - deriving (Eq) + DiffDefault | DiffContext Int | DiffMinimal | DiffStatus | DiffStats + deriving Eq data DiffWork = DiffWorkAll | DiffWorkUnstage | DiffWorkStaged - deriving (Eq) + deriving Eq +data DiffFilter = + DiffMatch String | DiffNotMatch String + -- | DiffRegex String | DiffNotRegex String + deriving Eq + -- FIXME diff other branches without switching -- FIXME --older/--newer branch -diffCmd :: Bool -> DiffWork -> DiffFormat -> Maybe AnyBranch +diffCmd :: Bool -> DiffWork -> DiffFormat -> Bool -> Maybe DiffFilter -> Maybe AnyBranch -> (Maybe Branch,[String]) -> IO () -diffCmd speconly work fmt mwbr = +diffCmd speconly work fmt quiet mpatt mwbr = withPackagesMaybeBranch Nothing dirtyGit ZeroOrOne diffPkg where diffPkg :: Package -> AnyBranch -> IO () diffPkg pkg br = do gitSwitchBranch br - let contxt = case fmt of - DiffContext n -> ["--unified=" ++ show n] - DiffMinimal -> ["--unified=0"] - -- FIXME hide "files changed" and "insertions" summary - DiffStats -> ["--compact-summary"] - _ -> [] - (workOpts,workArgs) = - case work of - DiffWorkAll -> ([],["HEAD" | isNothing mwbr]) - DiffWorkUnstage -> ([],[]) - DiffWorkStaged -> (["--cached"],[]) - file = [packageSpec pkg | speconly] - withBranch <- - case mwbr of - Nothing -> return [] - Just wbr -> - let brn = show wbr in - if '/' `elem` brn - then return [brn] - else do - localbrs <- gitLines "branch" ["--format=%(refname:short)"] - if brn `elem` localbrs - then return [brn] - else return ["origin/" ++ brn] - let revdiff = case mwbr of - Nothing -> [] - Just wbr -> case (wbr,br) of - (RelBranch rwbr, RelBranch rbr) -> ["-R" | rwbr > rbr] - _ -> [] - diff <- git "diff" $ contxt ++ workOpts ++ revdiff ++ withBranch ++ workArgs ++ file - unless (null diff) $ - case fmt of - DiffQuiet -> putStrLn $ unPackage pkg - DiffMinimal -> do - putPkgAnyBrnchHdr pkg br - putStr $ minifyDiff diff - _ -> do + speconlyNone <- + if speconly + then notM $ doesFileExist $ packageSpec pkg + else return False + if speconlyNone + then do + dead <- doesFileExist "dead.package" + unless dead $ putStrLn $ "no " ++ packageSpec pkg + else do + let contxt = case fmt of + DiffContext n -> ["--unified=" ++ show n] + DiffMinimal -> ["--unified=0"] + DiffStatus -> ["--name-status"] + -- FIXME hide "files changed" and "insertions" summary + DiffStats -> ["--compact-summary"] + _ -> [] + (workOpts,workArgs) = + case work of + DiffWorkAll -> ([],["HEAD" | isNothing mwbr]) + DiffWorkUnstage -> ([],[]) + DiffWorkStaged -> (["--cached"],[]) + file = [packageSpec pkg | speconly] + withBranch <- + case mwbr of + Nothing -> return [] + Just wbr -> + let brn = show wbr in + if '/' `elem` brn + then return [brn] + else do + localbrs <- gitLines "branch" ["--format=%(refname:short)"] + if brn `elem` localbrs + then return [brn] + else return ["origin/" ++ brn] + let revdiff = case mwbr of + Nothing -> [] + Just wbr -> case (wbr,br) of + (RelBranch rwbr, RelBranch rbr) -> ["-R" | rwbr > rbr] + _ -> [] + diff <- gitLines "diff" $ contxt ++ workOpts ++ revdiff ++ withBranch ++ workArgs ++ file + let diffout = (maybe id filterPattern mpatt . simplifyDiff fmt) diff + -- FIXME: sometimes we may want to list even if diff but no diffout + unless (null diffout) $ + if quiet + then putStrLn $ unPackage pkg + else do putPkgAnyBrnchHdr pkg br - putStrLn diff + mapM_ putStrLn diffout where - minifyDiff = - unlines . maybeRemoveDiffGit . filterCommon . lines + simplifyDiff :: DiffFormat -> [String] -> [String] + simplifyDiff DiffMinimal ds = + (maybeRemoveDiffGit . filterCommon) ds where filterCommon = -- flist is from swish @@ -83,3 +99,11 @@ if gitDiffs == [specDiffGit] then delete specDiffGit ls else ls + -- drop "2 files changed, 113 insertions(+)" + simplifyDiff DiffStats ds = if null ds then ds else init ds + simplifyDiff _ ds = ds + + filterPattern :: DiffFilter -> [String] -> [String] + filterPattern (DiffMatch patt) = filter (patt `isInfixOf`) + filterPattern (DiffNotMatch patt) = filter (not . (patt `isInfixOf`)) + -- void $ runProcess $ setStderr nullStream $ proc "grep" [pat, file] diff --git a/src/Cmd/Import.hs b/src/Cmd/Import.hs --- a/src/Cmd/Import.hs +++ b/src/Cmd/Import.hs @@ -34,7 +34,7 @@ dir <- getCurrentDirectory when (pkg /= takeFileName dir) $ do -- FIXME check git repo exists - clonePkg True Nothing pkg + clonePkg True UserClone Nothing pkg putStrLn "" setCurrentDirectory pkg -- FIXME: check branch is rawhide diff --git a/src/Cmd/Install.hs b/src/Cmd/Install.hs --- a/src/Cmd/Install.hs +++ b/src/Cmd/Install.hs @@ -16,6 +16,7 @@ -- FIXME --ignore-uninstalled subpackages -- FIXME --skip-unavailable -- FIXME --check any/all of package installed +-- FIXME add --debug or respect --verbose for dnf commands installCmd :: Bool -> Bool -> Maybe ForceShort -> [BCond] -> Bool -> (Maybe Branch,[String]) -> IO () installCmd verbose recurse mforceshort bconds reinstall (mbr, pkgs) = do @@ -93,13 +94,14 @@ repoquerySrc = do putStrLn $ "Repoquerying" +-+ p - repoquery rbr ["--qf=%{source_name}", "--whatprovides", p] + sysbr <- systemBranch + repoquery sysbr rbr ["--qf=%{source_name}", "--whatprovides", p] filterDebug = filter (\p -> not (any (`isInfixOf` p) ["-debuginfo-", "-debugsource-"])) notInstalledCmd :: (Maybe Branch,[String]) -> IO () notInstalledCmd = - withPackagesMaybeBranch Nothing Nothing ZeroOrOne notInstalledPkg + withPackagesMaybeBranchNoHeadergit ZeroOrOne notInstalledPkg where notInstalledPkg :: Package -> AnyBranch -> IO () notInstalledPkg pkg br = do diff --git a/src/Cmd/ListBranches.hs b/src/Cmd/ListBranches.hs --- a/src/Cmd/ListBranches.hs +++ b/src/Cmd/ListBranches.hs @@ -42,8 +42,7 @@ else withExistingDirectory path $ if skipdead then - ifM (doesFileExist "dead.package") - (return ()) + unlessM (doesFileExist "dead.package") doBranchesPkg else doBranchesPkg where @@ -55,7 +54,7 @@ pkg <- getPackageName path if mode == Current then do - br <- gitCurrentBranch + br <- gitCurrentBranch' let onbranch = case br of RelBranch rbr -> Branches [rbr] == breq diff --git a/src/Cmd/ListPackages.hs b/src/Cmd/ListPackages.hs --- a/src/Cmd/ListPackages.hs +++ b/src/Cmd/ListPackages.hs @@ -29,7 +29,7 @@ let path = "projects" params = makeKey "short" "1" ++ fork ++ packager ++ makeKey "namespace" "rpms" ++ maybeKey "pattern" mpattern pages <- queryPaged srcfpo count path params ("pagination", "page") - mapM_ (printPage . toObject) pages + mapM_ printPage pages where packager = case mpackager of @@ -45,12 +45,8 @@ in mapM_ (T.putStrLn . lookupKey' "name") projects - toObject :: Value -> Object - toObject (Object obj) = obj - toObject v = error $ "not object: " ++ show v - -- FIXME limit max number of pages (10?) or --pages -queryPaged :: String -> Bool -> String -> Query -> (String,String) -> IO [Value] +queryPaged :: String -> Bool -> String -> Query -> (String,String) -> IO [Object] queryPaged server count path params (pagination,paging) = if count then do diff --git a/src/Cmd/Local.hs b/src/Cmd/Local.hs --- a/src/Cmd/Local.hs +++ b/src/Cmd/Local.hs @@ -1,9 +1,9 @@ module Cmd.Local ( commandCmd, + countCmd, installDepsCmd, localCmd, nvrCmd, - prepCmd, srpmCmd, renameMasterCmd ) where @@ -18,7 +18,6 @@ import Common import Common.System import Git -import InterleaveOutput (cmdSilent') import Package -- FIXME generate build.log files @@ -44,46 +43,13 @@ srpmCmd :: Bool -> (Maybe Branch,[String]) -> IO () srpmCmd force = - withPackagesMaybeBranch Nothing Nothing ZeroOrOne srpmBuildPkg + withPackagesMaybeBranchNoHeadergit ZeroOrOne srpmBuildPkg where srpmBuildPkg :: Package -> AnyBranch -> IO () srpmBuildPkg pkg br = do spec <- localBranchSpecFile pkg br void $ generateSrpm' force (Just br) spec --- FIXME option to clone package -prepCmd :: (Maybe Branch,[String]) -> IO () -prepCmd (breq,pkgs) = - withPackagesMaybeBranch Nothing Nothing ZeroOrOne prepPackage (breq,pkgs) - where - prepPackage :: Package -> AnyBranch -> IO () - prepPackage pkg br = do - dead <- doesFileExist "dead.package" - if dead - then do - when (length pkgs > 1)$ - putStr $ unPackage pkg ++ ": " - putStrLn "dead.package" - else do - spec <- localBranchSpecFile pkg br - unlessM (doesFileExist spec) $ - error' $ spec ++ " not found" - cwd <- getCurrentDirectory - void $ getSources spec - gitDir <- isGitRepo - let rpmdirs = - [ "--define="++ mcr +-+ cwd | gitDir, - mcr <- ["_builddir", "_sourcedir"]] - args = rpmdirs ++ ["-bp", spec] - case br of - RelBranch rbr -> do - nvr <- pkgNameVerRel' rbr spec - -- newline avoids error starting on same line - putStr $ "Prepping " ++ nvr ++ ": " - _ -> return () - cmdSilent' "rpmbuild" args - putStrLn "done" - nvrCmd :: (BranchesReq, [String]) -> IO () nvrCmd = withPackageByBranches Nothing Nothing AnyNumber nvrBranch @@ -134,8 +100,32 @@ renameMasterBranch :: Package -> AnyBranch -> IO () renameMasterBranch _pkg _br = do locals <- gitLines "branch" ["--format=%(refname:short)"] + -- FIXME dangling warning in current output: + -- From ssh://pkgs.fedoraproject.org/rpms/hedgewars + -- - [deleted] (none) -> origin/master + -- (refs/remotes/origin/HEAD has become dangling) + -- Branch 'rawhide' set up to track remote branch 'rawhide' from 'origin'. + -- compare commands with github rename when ("rawhide" `notElem` locals) $ do git_ "fetch" ["--prune"] git_ "branch" ["--move", "master", "rawhide"] git_ "remote" ["set-head", "origin", "rawhide"] git_ "branch" ["--set-upstream-to", "origin/rawhide", "rawhide"] + +countCmd :: (Maybe Branch,[String]) -> IO () +countCmd (mbr,pkgs) = + foldM countPkg 0 pkgs >>= print + where + -- FIXME dead.package? + countPkg :: Int -> String -> IO Int + countPkg n path = + withExistingDirectory path $ do + whenJust mbr $ gitSwitchBranch . RelBranch + mspec <- if ".spec" `isExtensionOf` path + then return $ Just $ takeFileName path + else maybeFindSpecfile + case mspec of + Just spec -> do + exists <- doesFileExist spec + return $ n + if exists then 1 else 0 + Nothing -> return n diff --git a/src/Cmd/Merge.hs b/src/Cmd/Merge.hs --- a/src/Cmd/Merge.hs +++ b/src/Cmd/Merge.hs @@ -85,5 +85,6 @@ else conflictPrompt unmerged $ "Press Enter to skip merge" ++ (if build then " and build" else "") ++ "; or give a ref to attempt merge" -- ensure still on same branch! gitSwitchBranch (RelBranch br) - whenJust mmerge $ \ ref -> + whenJust mmerge $ \ ref -> do git_ "merge" [ref] + git_ "rebase" [] diff --git a/src/Cmd/Mock.hs b/src/Cmd/Mock.hs --- a/src/Cmd/Mock.hs +++ b/src/Cmd/Mock.hs @@ -1,5 +1,6 @@ module Cmd.Mock - ( mockCmd + ( mockCmd, + NoClean(..) ) where @@ -11,10 +12,15 @@ import Git import Package --- FIXME handle non-release branches -mockCmd :: Bool -> Bool -> Bool -> Bool -> Maybe Branch +data NoClean = NoCleanBefore | NoCleanAfter | NoCleanAll + deriving Eq + +-- FIXME handle non-release branches (on-branch works) +-- FIXME option for --shell without rebuild +-- FIXME add --no-clean-all +mockCmd :: Bool -> Maybe NoClean -> Bool -> Bool -> Maybe Branch -> (BranchesReq, [String]) -> IO () -mockCmd dryrun noclean network noCleanAfter mroot (breq, ps) = do +mockCmd dryrun mnoclean network mockshell mroot (breq, ps) = do branches <- case breq of Branches [] -> @@ -40,7 +46,22 @@ in ["--resultdir=results" verrel] _ -> [] let command = if length pkgs > 1 then "--chain" else "--rebuild" - (if dryrun then cmdN else cmd_) "mock" $ [command, "--root", mockConfig rootBr] ++ ["--no-clean" | noclean] ++ ["--no-clean-after" | noCleanAfter] ++ ["--config-opts=cleanup_on_failure=False" | not noCleanAfter] ++ ["--enable-network" | network] ++ resultdir ++ srpms + noclean = case mnoclean of + Nothing -> [] + Just NoCleanBefore -> ["--no-clean"] + Just NoCleanAfter -> ["--no-cleanup-after"] + Just NoCleanAll -> ["--no-cleanup-all"] + mockopts_common c = [c, "--root", mockRoot rootBr] ++ noclean ++ ["--enable-network" | network] + mockbuild_opts = mockopts_common command ++ ["--config-opts=cleanup_on_failure=False" | mnoclean `elem` [Nothing, Just NoCleanBefore]] ++ resultdir ++ srpms + mockshell_opts = mockopts_common "--shell" ++ ["--no-clean"] + if dryrun + then do + cmdN "mock" mockbuild_opts + when mockshell $ cmdN "mock" mockshell_opts + else do + ok <- cmdBool "mock" mockbuild_opts + when mockshell $ cmd_ "mock" mockshell_opts + unless ok $ error' "mockbuild failed" where prepSrpm :: AnyBranch -> FilePath -> IO FilePath prepSrpm rbr pkgdir = diff --git a/src/Cmd/Parallel.hs b/src/Cmd/Parallel.hs --- a/src/Cmd/Parallel.hs +++ b/src/Cmd/Parallel.hs @@ -33,12 +33,18 @@ -- FIXME option to build multiple packages over branches in parallel -- FIXME use --wait-build=NVR --- FIXME check sources asap -parallelBuildCmd :: Bool -> Maybe SideTagTarget -> Maybe UpdateType -> (BranchesReq, [String]) -> IO () -parallelBuildCmd dryrun msidetagTarget mupdatetype (breq, pkgs) = do +-- FIXME check sources as early as possible +-- FIXME --single-layer to build packages at once regardless +-- FIXME Haskell subpackages require release bump even with version bump +parallelBuildCmd :: Bool -> Int -> Maybe SideTagTarget -> Maybe UpdateType + -> (BranchesReq, [String]) -> IO () +parallelBuildCmd dryrun firstlayer msidetagTarget mupdatetype (breq, pkgs) = do branches <- case pkgs of - [] -> listOfBranches True True breq + [] -> do + unlessM isPkgGitSshRepo $ + error' "Please specify at least one package" + listOfBranches True True breq [p] -> withExistingDirectory p $ listOfBranches True True breq _ -> case breq of Branches [] -> error' "please specify a branch" @@ -50,21 +56,22 @@ when (isJust mtarget && length branches > 1) $ error' "You can only specify target with one branch" case pkgs of - [] -> do - unlessM isPkgGitSshRepo $ - error' "Please specify at least one package" - parallelBranches branches + [] -> parallelBranches branches [p] -> withExistingDirectory p $ parallelBranches branches _ -> forM_ branches $ \ rbr -> do - layers <- dependencyLayers pkgs - when (isNothing msidetagTarget && length layers > 1) $ + allLayers <- dependencyLayers pkgs + let layers = drop firstlayer allLayers + when (isNothing msidetagTarget && length allLayers > 1) $ unlessM (checkAutoBodhiUpdate rbr) $ error' "You must use --target/--sidetag to build package layers for this branch" when (length branches > 1) $ putStrLn $ "# " ++ show rbr - targets <- mapM (parallelBuild rbr) $ zip (reverse [0..(length layers - 1)]) layers + -- FIXME: pass remaining layers for failure error + targets <- mapM (parallelBuild rbr) + $ zip [firstlayer..length allLayers] + $ init $ tails layers -- tails ends in [] when (isJust msidetagTarget && null targets && not dryrun) $ error' "No target was returned from jobs!" unless (isNothing msidetagTarget || null targets || dryrun) $ do @@ -76,7 +83,7 @@ parallelBranches :: [Branch] -> IO () parallelBranches brs = do krbTicket - putStrLn $ "Building " ++ show (length brs) ++ " branches in parallel:" + putStrLn $ "= Building " ++ show (length brs) ++ " branches in parallel:" putStrLn $ unwords $ map show brs jobs <- mapM setupBranch brs (failures,_mtarget) <- watchJobs Nothing [] jobs @@ -86,52 +93,60 @@ setupBranch :: Branch -> IO Job setupBranch br = do job <- startBuild False False br "." >>= async - unless dryrun $ sleep 5 + unless dryrun $ sleep 3 return (show br,job) - parallelBuild :: Branch -> (Int,[String]) -> IO String - parallelBuild br (layersleft,layer) = do + parallelBuild :: Branch -> (Int,[[String]]) -> IO String + parallelBuild _ (_,[]) = return "" -- should not reach here + parallelBuild br (layernum, layer:nextLayers) = do krbTicket - putStrLn $ "\nBuilding parallel layer of" ++ + putStrLn $ "\n= Building parallel layer #" ++ show layernum ++ if nopkgs > 1 - then " " ++ show nopkgs ++ " packages:" + then " (" ++ show nopkgs ++ " packages):" else ":" putStrLn $ unwords layer - putStrLn $ "(" ++ show layersleft ++ " more layer" ++ - if layersleft > 1 then "s" else "" - ++ " left)" + -- maybe print total pending packages + unless (null nextLayers) $ + putStrLn $ plural layersleft "more layer" ++ " left with " ++ + let layerspkgs = map length nextLayers + in case layerspkgs of + [l] -> plural l "package" + _ -> show layerspkgs ++ " packages" jobs <- mapM setupBuild layer (failures,mtarget) <- watchJobs Nothing [] jobs - unless (null failures) $ - error' $ "Build failures: " ++ unwords failures + -- FIXME prompt to continue? + unless (null failures) $ do + let pending = sum $ map length nextLayers + error' $ "Build failures in layer " ++ show layernum ++ ": " ++ + unwords failures ++ "\n\n" ++ + show pending ++ " pending packages:\n" ++ + unwords (map unwords nextLayers) when (null jobs) $ error' "No jobs run" return $ fromMaybe (error' "No target determined") mtarget where nopkgs = length layer + layersleft = length nextLayers setupBuild :: String -> IO Job setupBuild pkg = do job <- startBuild (layersleft > 0) (nopkgs > 5) br pkg >>= async - unless dryrun $ sleep 5 + unless dryrun $ sleep 3 return (pkg,job) watchJobs :: Maybe String -> [String] -> [Job] -> IO ([String],Maybe String) watchJobs mtarget fails [] = return (fails,mtarget) watchJobs mtarget fails (job:jobs) = do - sleep 1 status <- poll (snd job) case status of - Nothing -> watchJobs mtarget fails (jobs ++ [job]) + Nothing -> sleep 1 >> watchJobs mtarget fails (jobs ++ [job]) Just (Right (target,nvr)) -> do - putStrLn "" - putStrLn $ nvr ++ " job " ++ color Yellow "completed" ++ " (" ++ show (length jobs) ++ " jobs left)" + putStrLn $ color Yellow nvr ++ " job completed (" ++ show (length jobs) ++ " jobs left in layer)" watchJobs (Just target) fails jobs Just (Left except) -> do - putStrLn "" print except let pkg = fst job - putStrLn $ "** " ++ pkg ++ " job " ++ color Magenta "failed" ++ " ** (" ++ show (length jobs) ++ " jobs left)" + putStrLn $ "** " ++ color Magenta pkg ++ " job " ++ color Magenta "failed" ++ " ** (" ++ show (length jobs) ++ " jobs left in layer)" watchJobs mtarget (pkg : fails) jobs -- FIXME prefix output with package name @@ -159,12 +174,14 @@ case tags of [] -> do out <- head . lines <$> fedpkg "request-side-tag" [] - if "Side tag '" `isPrefixOf` out then + if "Side tag '" `isPrefixOf` out + then do + putStrLn out return $ init . dropWhileEnd (/= '\'') $ dropPrefix "Side tag '" out else error' "'fedpkg request-side-tag' failed" [tag] -> return tag _ -> error' $ "More than one user side-tag found for " ++ show br - putStrLn $ nvr ++ " (" ++ target ++ ")\n" + putStrLn $ nvr ++ " (" ++ target ++ ")" -- FIXME should compare git refs -- FIXME check for target buildstatus <- kojiBuildStatus nvr @@ -172,7 +189,7 @@ mlatest <- kojiLatestNVR tag $ unPackage pkg case buildstatus of Just BuildComplete -> do - putStrLn $ nvr ++ " is " ++ color Green "already built" + putStrLn $ color Green nvr ++ " is " ++ color Green "already built" when (br /= Rawhide && morelayers && target == branchTarget br) $ do tags <- kojiNVRTags nvr unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $ @@ -210,24 +227,20 @@ kojiWaitTaskAndRepo :: Bool -> String -> String -> TaskID -> IO (String,String) kojiWaitTaskAndRepo newpkg nvr target task = do finish <- kojiWaitTask task - putStrLn "" if finish then putStrLn $ color Green $ nvr ++ " build success" + -- FIXME print koji task url else error' $ color Red $ nvr ++ " build failed" autoupdate <- checkAutoBodhiUpdate br if autoupdate then when newpkg $ do - mBugSess <- do - (mbid, session) <- bzReviewSession - return $ case mbid of - Just bid -> Just (bid,session) - Nothing -> Nothing - whenJust mBugSess $ - \ (bid,session) -> putBugBuild dryrun session bid nvr + mBugSess <- bzReviewSession + whenJust mBugSess $ \(bid,session) -> + putBugBuild dryrun session bid nvr else do when (target == branchTarget br && morelayers) $ -- -- FIXME: avoid prompt in - -- changelog <- getChangeLog Nothing spec + -- changelog <- changeLogPrompt Nothing spec -- bodhiUpdate (fmap fst mBugSess) changelog nvr bodhiCreateOverride dryrun Nothing nvr when morelayers $ diff --git a/src/Cmd/PkgReview.hs b/src/Cmd/PkgReview.hs --- a/src/Cmd/PkgReview.hs +++ b/src/Cmd/PkgReview.hs @@ -12,7 +12,7 @@ import qualified Common.Text as T import Data.Char -import Network.HTTP.Directory +import Network.HTTP.Directory (httpExists, httpManager) import Branches import Bugzilla @@ -82,7 +82,7 @@ error' "This NVR was already posted on the review bug: please bump" mockRpmLint mock (scratchOpt == ScratchBuild) pkg spec srpm (mkojiurl,specSrpmUrls) <- buildAndUpload scratchOpt srpm pkg spec - changelog <- getChangeLog Nothing spec + changelog <- changeLogPrompt Nothing spec commentBug session bid (specSrpmUrls <> (if null changelog then "" else "\n\n" <> changelog) <> maybe "" ("\n\nKoji scratch build: " <>) mkojiurl) -- putStrLn "Review bug updated" where @@ -120,7 +120,7 @@ if mock then do -- FIXME check that mock is installed let resultsdir = "results_" ++ pkg - cmd_ "mock" ["--root", mockConfig Rawhide, "--resultdir=" ++ resultsdir, srpm] + cmd_ "mock" ["--root", mockRoot Rawhide, "--resultdir=" ++ resultsdir, srpm] map (resultsdir ) . filter ((== ".rpm") . takeExtension) <$> listDirectory resultsdir else builtRpms (RelBranch Rawhide) spec >>= filterM doesFileExist @@ -134,9 +134,10 @@ reviewPackage mpkg = do -- FIXME if spec file exists use it directly pkg <- maybe getDirectoryName return mpkg - (bugs, _) <- if all isDigit pkg - then bugsSession $ packageReview .&&. statusNewAssigned .&&. bugIdIs (read pkg) - else bugsSession $ pkgReviews pkg .&&. statusNewAssigned + bugs <- bugsAnon $ + if all isDigit pkg + then packageReview .&&. statusNewAssigned .&&. bugIdIs (read pkg) + else pkgReviews pkg .&&. statusNewAssigned case bugs of [bug] -> do putReviewBug False bug diff --git a/src/Cmd/Prep.hs b/src/Cmd/Prep.hs new file mode 100644 --- /dev/null +++ b/src/Cmd/Prep.hs @@ -0,0 +1,71 @@ +module Cmd.Prep ( + prepCmd, + PrepPre(..) + ) where + +import Branches +import Cmd.Clone +import Common +import Common.System +import Git +import InterleaveOutput (cmdSilent') +import Package + +data PrepPre = PrepClone | PrepPull + deriving Eq + +prepCmd :: Maybe PrepPre -> Bool -> (Maybe Branch,[String]) -> IO () +prepCmd mpre verbose (mbr,pkgs) = do + when (mpre == Just PrepClone) $ + cloneCmd mbr (ClonePkgs pkgs) + withPackagesMaybeBranchNoHeadergit ZeroOrOne prepPackage (mbr,pkgs) + where + prepPackage :: Package -> AnyBranch -> IO () + prepPackage pkg br = do + when (mpre == Just PrepPull) $ + git_ "pull" [] + dead <- doesFileExist "dead.package" + if dead + then do + when (length pkgs > 1)$ + putStr $ unPackage pkg ++ ": " + putStrLn "dead.package" + else do + spec <- localBranchSpecFile pkg br + unlessM (doesFileExist spec) $ + error' $ spec ++ " not found" + cwd <- getCurrentDirectory + void $ getSources spec + installMissingMacros spec + gitDir <- isGitRepo + let rpmdirs = + [ "--define="++ mcr +-+ cwd | gitDir, + mcr <- ["_builddir", "_sourcedir"]] + args = rpmdirs ++ ["-bp", spec] + case br of + RelBranch rbr -> do + nvr <- pkgNameVerRel' rbr spec + -- newline avoids error starting on same line + putStr $ "Prepping " ++ nvr ++ ": " + _ -> return () + (if verbose then cmdLog else cmdSilent') "rpmbuild" args + putStrLn "done" + + +srpmMacros :: [(String,String)] +srpmMacros = + [("%gometa", "go-rpm-macros"), + ("fontpkgname", "fonts-rpm-macros"), + ("%cargo_prep", "rust-packaging")] + +needSrpmMacro :: FilePath -> (String,String) -> IO (Maybe String) +needSrpmMacro spec (meta, macros) = do + contents <- readFile spec + return $ if meta `isInfixOf` contents then Just macros else Nothing + +installMissingMacros :: FilePath -> IO () +installMissingMacros spec = do + macros <- mapMaybeM (needSrpmMacro spec) srpmMacros + missing <- filterM notInstalled macros + unless (null missing) $ + cmd_ "/usr/bin/sudo" $ ["/usr/bin/dnf", "install", "--assumeyes"] ++ missing diff --git a/src/Cmd/Pull.hs b/src/Cmd/Pull.hs deleted file mode 100644 --- a/src/Cmd/Pull.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Cmd.Pull (pullPkgs) where - -import Branches -import Git -import Package - --- FIXME pulling more than one branch --- FIXME print nvr after pulling or old -> new -pullPkgs :: (BranchesReq, [String]) -> IO () -pullPkgs = - withPackageByBranches (Just False) cleanGitFetch AnyNumber pullPkg - where - pullPkg :: Package -> AnyBranch -> IO () - pullPkg _pkg _br = - getReleaseBranch >>= gitMergeOrigin diff --git a/src/Cmd/PullPush.hs b/src/Cmd/PullPush.hs new file mode 100644 --- /dev/null +++ b/src/Cmd/PullPush.hs @@ -0,0 +1,34 @@ +module Cmd.PullPush (pullPkgs, pushPkgs) where + +import Branches +import Git +import Package + +-- FIXME pulling more than one branch +-- FIXME print nvr after pulling or old -> new +pullPkgs :: Bool -> (BranchesReq, [String]) -> IO () +pullPkgs lenient = + withPackageByBranches (Just False) (if lenient then Nothing else cleanGitFetch) AnyNumber pullPkg + where + pullPkg :: Package -> AnyBranch -> IO () + pullPkg pkg _br = + if lenient + then do + haveGit <- isPkgGitRepo + if haveGit + then doPullPkg + else putStrLn $ "ignoring " ++ unPackage pkg + else doPullPkg + where + doPullPkg :: IO () + doPullPkg = + getReleaseBranchWarn >>= gitMergeOrigin + +pushPkgs :: (BranchesReq, [String]) -> IO () +pushPkgs = + withPackageByBranches (Just False) cleanGitFetch AnyNumber pushPkg + where + pushPkg :: Package -> AnyBranch -> IO () + pushPkg _pkg _br = do + gitShortLog1 Nothing >>= putStrLn + gitPushSilent Nothing diff --git a/src/Cmd/Repoquery.hs b/src/Cmd/Repoquery.hs --- a/src/Cmd/Repoquery.hs +++ b/src/Cmd/Repoquery.hs @@ -6,14 +6,19 @@ import Common.System import Package +import qualified Data.List as L + repoqueryCmd :: (BranchesReq, [String]) -> IO () repoqueryCmd (breq, pkgs) = do query <- if null pkgs then pure <$> getDirectoryName else return pkgs brs <- listOfBranches True False breq - mapM_ (repoquery_ query) brs + sysbr <- systemBranch + mapM_ (repoquery_ sysbr query) brs where - repoquery_ :: [String] -> Branch -> IO () - repoquery_ query br = - repoquery br query >>= putStrLn + repoquery_ :: Branch -> [String] -> Branch -> IO () + repoquery_ sysbr query br = do + let qf = ["--queryformat=%{repoid}: %{name}-%{version}-%{release}.%{arch}" + | not (any ("--qf" `L.isPrefixOf`) query)] + repoquery sysbr br (qf ++ query) >>= putStrLn diff --git a/src/Cmd/RequestBranch.hs b/src/Cmd/RequestBranch.hs --- a/src/Cmd/RequestBranch.hs +++ b/src/Cmd/RequestBranch.hs @@ -35,14 +35,14 @@ branches <- getRequestedBranches breq newbranches <- filterExistingBranchRequests branches unless (null newbranches) $ do - (mbid,session) <- bzReviewSession + mbidsession <- bzReviewSession urls <- forM newbranches $ \ br -> do - when mock $ fedpkg_ "mockbuild" ["--root", mockConfig br] + when mock $ fedpkg_ "mockbuild" ["--root", mockRoot br] when multiple $ putStr (unPackage pkg ++ " ") - when (length newbranches > 1) $ putStr (show br ++ " ") + when (length newbranches > 1) $ print br fedpkg "request-branch" [show br] - case mbid of - Just bid -> commentBug session bid + case mbidsession of + Just (bid,session) -> commentBug session bid Nothing -> putStrLn $ unlines urls where diff --git a/src/Cmd/RequestRepo.hs b/src/Cmd/RequestRepo.hs --- a/src/Cmd/RequestRepo.hs +++ b/src/Cmd/RequestRepo.hs @@ -68,7 +68,7 @@ putStrLn "" branches <- getRequestedBranches breq forM_ branches $ \ br -> do - when mock $ fedpkg_ "mockbuild" ["--root", mockConfig br] + when mock $ fedpkg_ "mockbuild" ["--root", mockRoot br] putStr (show br ++ " ") fedpkg_ "request-branch" ["--repo", pkg, show br] putStrLn "" diff --git a/src/Cmd/Reviews.hs b/src/Cmd/Reviews.hs --- a/src/Cmd/Reviews.hs +++ b/src/Cmd/Reviews.hs @@ -18,5 +18,5 @@ findReview :: String -> IO () findReview pkg = do - (bugs, _) <- bugIdsSession $ pkgReviews pkg - mapM_ putBugId bugs + bugIdsAnon (pkgReviews pkg) + >>= mapM_ putBugId diff --git a/src/Cmd/Scratch.hs b/src/Cmd/Scratch.hs --- a/src/Cmd/Scratch.hs +++ b/src/Cmd/Scratch.hs @@ -11,16 +11,15 @@ import Git import Koji import Package - -data Archs = Archs [String] | ExcludedArchs [String] +import Types (Archs(..)) -- FIXME default to rawhide/main? -- FIXME build from a specific git ref --- FIXME print message about uploading srpm +-- FIXME allow multiple --target's (parallel too) scratchCmd :: Bool -> Bool -> Bool -> Maybe Archs -> Maybe String -> Maybe String -> (BranchesReq, [String]) -> IO () scratchCmd dryrun rebuildSrpm nofailfast marchopts mtarget mref (breq,pkgs) = - withPackageByBranches (Just False) Nothing AnyNumber scratchBuild (breq,pkgs) + withPackageByBranches (Just True) Nothing AnyNumber scratchBuild (breq,pkgs) where scratchBuild :: Package -> AnyBranch -> IO () scratchBuild pkg br = do diff --git a/src/Cmd/Sort.hs b/src/Cmd/Sort.hs --- a/src/Cmd/Sort.hs +++ b/src/Cmd/Sort.hs @@ -6,8 +6,9 @@ where import Control.Monad.Extra -import Distribution.RPM.Build.Graph -- (dependencySortRpmOpts) -import Distribution.RPM.Build.Order (dependencySortRpmOpts) +import Distribution.RPM.Build.Graph +import Distribution.RPM.Build.Order (dependencySortRpmOpts, + dependencySortParallel) import Branches import Git @@ -15,13 +16,15 @@ data RpmWith = RpmWith String | RpmWithout String -sortCmd :: Maybe RpmWith -> (Maybe Branch,[String]) -> IO () -sortCmd _ (_,[]) = return () -sortCmd mrpmwith (mbr, pkgs) = do - withPackagesMaybeBranch Nothing Nothing ExactlyOne noop (mbr, pkgs) +sortCmd :: Bool -> Maybe RpmWith -> (Maybe Branch,[String]) -> IO () +sortCmd _ _ (_,[]) = return () +sortCmd parallel mrpmwith (mbr, pkgs) = do + withPackagesMaybeBranchNoHeadergit ExactlyOne noop (mbr, pkgs) let rpmopts = maybe [] toRpmOption mrpmwith - packages <- dependencySortRpmOpts rpmopts $ reverse pkgs - putStrLn $ unwords packages + if parallel + -- reverse because rpmbuild-order reverses the order of independent pkgs? + then dependencySortParallel (reverse pkgs) >>= mapM_ (putStrLn . unwords) + else dependencySortRpmOpts rpmopts (reverse pkgs) >>= putStrLn . unwords noop :: Package -> AnyBranch -> IO () noop _pkg br = @@ -33,7 +36,7 @@ graphCmd :: Bool -> Maybe RpmWith -> (Maybe Branch,[FilePath]) -> IO () graphCmd dot mrpmwith (mbr, pkgs) = do - withPackagesMaybeBranch Nothing Nothing ZeroOrOne noop (mbr, pkgs) + withPackagesMaybeBranchNoHeadergit ZeroOrOne noop (mbr, pkgs) let rpmopts = maybe [] toRpmOption mrpmwith createGraph'''' False [] rpmopts False False True Nothing pkgs >>= if dot then printGraph else renderGraph diff --git a/src/Cmd/Status.hs b/src/Cmd/Status.hs --- a/src/Cmd/Status.hs +++ b/src/Cmd/Status.hs @@ -107,11 +107,7 @@ let (days,nomRest) = diff `divMod'` nominalDay :: (Int,NominalDiffTime) nominalHour = 3600 :: NominalDiffTime hours = nomRest `div'` nominalHour :: Int - putStr $ " " ++ showUnits days "day" +-+ showUnits hours "hour" - - showUnits :: Int -> String -> String - showUnits i uni = show i ++ " " ++ uni ++ - if i == 1 then "" else "s" + putStr $ " " ++ plural days "day" +-+ plural hours "hour" #if MIN_VERSION_time(1,8,0) #else diff --git a/src/Cmd/Update.hs b/src/Cmd/Update.hs --- a/src/Cmd/Update.hs +++ b/src/Cmd/Update.hs @@ -3,8 +3,6 @@ ) where -import SimpleCmd - import Branches import Common import Common.System @@ -13,32 +11,51 @@ import Krb import Package -updateCmd :: (Maybe Branch,[String]) -> IO () -updateCmd (mbr,args) = do +import Data.RPM.VerCmp + +-- FIXME check EVR increased +-- FIXME if multiple sources might need to bump release +updateCmd :: Bool -> Bool -> Bool -> (Maybe Branch,[String]) -> IO () +updateCmd onlysources force allowHEAD (mbr,args) = do pkgGit <- isPkgGitSshRepo - let (mver,pkgs) = case args of - [a] -> if pkgGit then (Just a,[]) else (Nothing,[a]) - _ -> (Nothing,args) - withPackagesMaybeBranch (Just False) dirtyGitFetch ZeroOrOne (updatePkg mver) (mbr, pkgs) + (mver,pkgs) <- + case args of + [a] -> do + if pkgGit + then return (Just a,[]) + else do + mspec <- maybeFindSpecfile + return $ if isJust mspec + then (Just a,[]) + else (Nothing,[a]) + _ -> return (Nothing,args) + let mgitops = + let dirty = if allowHEAD then dirtyGitHEAD else dirtyGitFetch + in if pkgGit + then dirty + else if null pkgs then Nothing else dirty + withPackagesMaybeBranch (Just False) mgitops ZeroOrOne (updatePkg mver) (mbr, pkgs) where updatePkg :: Maybe String -> Package -> AnyBranch -> IO () updatePkg mver pkg br = do - spec <- localBranchSpecFile pkg br + spec <- if allowHEAD + then findSpecfile + else localBranchSpecFile pkg br (curver,_) <- pkgVerRel spec vdiff <- filter ("Version:" `isInfixOf`) . filter (not . ("@@ " `isPrefixOf`)) <$> gitLines "diff" ["-U0", "HEAD", spec] - when (isNothing mver) $ do - when (null vdiff) $ - error' "please specify version or edit in spec file" - unless (length vdiff == 2) $ - error' $ "diff contains complex version change:\n" ++ unlines vdiff - if Just curver == mver - then putStrLn $ "already new version " ++ curver - else do - --FIXME: compare rpm versions - -- if newver < oldver - -- then putStrLn $ "current" +-+ display oldver +-+ "is newer!" - -- else do - pkgGit <- isPkgGitSshRepo + unless (length vdiff `elem` [0,2]) $ + error' $ "diff contains complex version change:\n" ++ unlines vdiff + case mver of + Nothing -> do + when (null vdiff && not onlysources) $ + error' "specify or edit version to update" + putStrLn $ "current version: " ++ curver + Just nver -> do + when (length vdiff == 2) $ + error' $ "spec version already bumped to " ++ curver + when (curver == nver) $ + putStrLn $ "already new version " ++ curver + unless onlysources $ do let (oldver,newver) = case mver of Just nver -> (curver,nver) @@ -46,27 +63,47 @@ case map (last . words) vdiff of [old,new] -> (old,new) _ -> error' "complex version change" + -- FIXME take epoch into account + when (rpmVerCompare oldver newver == GT) $ + putStrLn $ "current" +-+ oldver +-+ "is newer!" putStrLn $ oldver ++ " ->\n" ++ newver - when (curver /= newver) $ do + if curver /= newver + then do editSpecField "Version" newver spec editSpecField "Release" "0%{?dist}" spec cmd_ "rpmdev-bumpspec" ["-c", "update to " ++ newver, spec] - when pkgGit $ do - sources <- map sourceFieldFile <$> cmdLines "spectool" ["-S", spec] - cmd_ "sed" ["-i", "/" ++ unPackage pkg ++ "-" ++ oldver ++ "./d", "sources"] - allExist <- and <$> mapM doesFileExist sources - unless allExist $ do - cmd_ "fedpkg" ["sources"] + -- FIXME should be sure sources exists for distgit + whenM (doesFileExist "sources") $ + cmd_ "sed" ["-i", "/" ++ unPackage pkg ++ "-" ++ oldver ++ "./d", "sources"] + else do + versions <- changelogVersions spec + let missing = null versions || not ((newver ++ "-") `isPrefixOf` head versions) + when missing $ do + cmd_ "rpmdev-bumpspec" ["-c", "update to " ++ newver, spec] + -- FIXME need to commit after add sources + git_ "commit" ["-a", "-m", "update to " ++ newver] + whenM isPkgGitSshRepo $ do + -- FIXME forM_ + sources <- map sourceFieldFile <$> cmdLines "spectool" ["-S", spec] + existing <- filterM doesFileExist sources + unless (existing == sources) $ do + cmd_ "fedpkg" ["sources"] + unless force $ + -- FIXME only if not all exist cmd_ "spectool" ["-g", "-S", spec] - krbTicket - copyFile "sources" "sources.fbrnch" - cmd_ "fedpkg" $ "new-sources" : filter (".tar." `isInfixOf`) sources - shell_ $ "cat sources.fbrnch >>" +-+ "sources" - removeFile "sources.fbrnch" - putStr "Prepping... " - cmdSilent' "rpmbuild" ["-bp", spec] - putStrLn "done" - cmd_ "git" ["commit", "-a", "-m", "update to " ++ newver] + when force $ do + let archives = filter isArchiveFile existing + forM_ archives removeFile + cmd_ "spectool" ["-g", "-S", spec] + krbTicket + copyFile "sources" "sources.fbrnch" + cmd_ "fedpkg" $ "new-sources" : filter isArchiveFile sources + --shell_ $ "cat sources.fbrnch >>" +-+ "sources" + removeFile "sources.fbrnch" + putStr "Prepping... " + cmdSilent' "rpmbuild" ["-bp", spec] + putStrLn "done" + -- FIXME git amend (if previous commit was update) sourceFieldFile :: String -> FilePath sourceFieldFile field = @@ -74,6 +111,11 @@ -- should be impossible error "empty source field!" else (takeFileName . last . words) field + + -- FIXME handle .tgz? + isArchiveFile :: FilePath -> Bool + isArchiveFile f = + ".tar." `isInfixOf` f || ".zip" `isSuffixOf` f pkgVerRel :: FilePath -> IO (String,String) pkgVerRel spec = do diff --git a/src/Cmd/WaitRepo.hs b/src/Cmd/WaitRepo.hs --- a/src/Cmd/WaitRepo.hs +++ b/src/Cmd/WaitRepo.hs @@ -9,6 +9,7 @@ import Koji import Package +-- FIXME first check/wait for build to actually exist waitrepoCmd :: Bool -> Maybe String -> (BranchesReq, [String]) -> IO () waitrepoCmd dryrun mtarget = do withPackageByBranches (Just False) cleanGitFetchActive AnyNumber waitrepoBranch diff --git a/src/Common.hs b/src/Common.hs --- a/src/Common.hs +++ b/src/Common.hs @@ -7,7 +7,8 @@ #if !MIN_VERSION_base(4,11,0) (<>), #endif - (+/+) + (+/+), + plural ) where import Control.Monad.Extra @@ -19,3 +20,13 @@ #endif import Network.HTTP.Query ((+/+)) + +plural :: Int -> String -> String +plural i ns = + mconcat + [ + show i, + " ", + ns, + if i == 1 then "" else "s" + ] diff --git a/src/Common/System.hs b/src/Common/System.hs --- a/src/Common/System.hs +++ b/src/Common/System.hs @@ -7,11 +7,17 @@ getDirectoryName, isTty, setNoBuffering, +#if !MIN_VERSION_filepath(1,4,2) + isExtensionOf, +#endif #if !MIN_VERSION_simple_cmd(0,2,3) cmdFull #endif ) where +#if !MIN_VERSION_filepath(1,4,2) +import Data.List +#endif import SimpleCmd #if MIN_VERSION_simple_cmd(0,2,1) hiding (ifM,whenM) @@ -47,4 +53,10 @@ if last str == '\n' then init str else str +#endif + +#if !MIN_VERSION_filepath(1,4,2) +isExtensionOf :: String -> FilePath -> Bool +isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions +isExtensionOf ext = isSuffixOf ('.':ext) . takeExtensions #endif diff --git a/src/Git.hs b/src/Git.hs --- a/src/Git.hs +++ b/src/Git.hs @@ -89,6 +89,7 @@ gitPushSilent :: Maybe String -> IO () gitPushSilent mref = do + checkOnBranch putStr "git pushing... " out <- cmdQuiet "git" $ ["push", "--quiet", "origin"] ++ maybeToList mref putStrLn $ if null out then "done\n" else "\n" ++ out @@ -158,13 +159,15 @@ gitLines c args = lines <$> git c args gitSwitchBranch :: AnyBranch -> IO () +gitSwitchBranch (OtherBranch "HEAD") = do + dir <- getDirectoryName + error' $ dir ++ ": HEAD is not a branch" gitSwitchBranch br = do localbranches <- gitLines "branch" ["--format=%(refname:short)"] if show br `elem` localbranches then do - current <- git "rev-parse" ["--abbrev-ref", "HEAD"] - when (current /= show br) $ - -- cmdSilent - git_ "checkout" ["-q", show br] + current <- gitCurrentBranch + when (current /= br) $ + git_ "switch" ["-q", show br] else do -- check remote branch exists remotebranch <- diff --git a/src/InterleaveOutput.hs b/src/InterleaveOutput.hs --- a/src/InterleaveOutput.hs +++ b/src/InterleaveOutput.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - module InterleaveOutput (cmdSilent', cmdSilentBool) where import Data.ByteString.Lazy.UTF8 as B diff --git a/src/Koji.hs b/src/Koji.hs --- a/src/Koji.hs +++ b/src/Koji.hs @@ -28,11 +28,13 @@ import Control.Concurrent (threadDelay) import qualified Data.ByteString.Lazy.Char8 as B +import Data.Fixed (Micro) import Distribution.Koji import qualified Distribution.Koji.API as Koji import System.Exit import System.Process.Typed -import System.Time.Extra (sleep, timeout) +import System.Timeout (timeout) +import System.Time.Extra (sleep) import Branches import Common @@ -93,7 +95,6 @@ kojiBuild' :: Bool -> String -> [String] -> IO KojiBuildTask kojiBuild' wait target args = do krbTicket - cmd_ "date" [] let srpm = if null args then error' "no args passed to koji build" else ".src.rpm" `isSuffixOf` last args @@ -104,16 +105,16 @@ -- [ERROR] koji: AuthError: unable to obtain a session -- readCreateProcess: koji "build" "--nowait" "f33-build-side-25385" "--fail-fast" "--background" ... (exit 1): failed (ret,out) <- readProcessStdout $ proc "koji" $ ["build", "--nowait", target] ++ args - B.putStrLn $ if srpm - -- drop uploading line until doing tee - then (B.unlines . tail . B.lines) out - else out + -- for srpm: drop uploading line until doing tee + -- for git: drop "Created task: " + -- init to drop final newline + logMsg $ (B.unpack . B.init . B.unlines . tail . B.lines) out if ret == ExitSuccess then do let kojiurl = B.unpack $ last $ B.words out task = (TaskId . read) $ takeWhileEnd isDigit kojiurl when wait $ do kojiWatchTask task - cmd_ "date" [] + cmd_ "date" ["+%T"] return $ if wait then Right kojiurl else Left task else do prompt_ "Press Enter to resubmit Koji build" @@ -137,7 +138,7 @@ mst <- kojiGetTaskState fedoraHub task case mst of Just TaskClosed -> return () - Just TaskFailed -> error "Task failed!" + Just TaskFailed -> error' "Task failed!" Just TaskCanceled -> return () _ -> kojiWatchTask task @@ -151,7 +152,8 @@ Just ts -> if ts `elem` openTaskStates then do - putChar '.' + -- this makes parallel too noisy + --putChar '.' sleep 20 kojiWaitTask task else return $ ts == TaskClosed @@ -188,8 +190,7 @@ waitRepo :: String -> Maybe Struct -> IO () waitRepo buildtag moldrepo = do when (isJust moldrepo) $ do - threadDelay (50 * 1000 * 1000) -- 50s - putChar '.' + threadDelay (fromEnum (50 :: Micro)) -- 50s mrepo <- kojiGetRepo fedoraHub buildtag Nothing Nothing case mrepo of Nothing -> error' $ "failed to find koji repo for " ++ buildtag @@ -203,13 +204,13 @@ Just event -> do latest <- kojiLatestNVRRepo buildtag event (nameOfNVR nvr) if latest == Just nvr - then if isNothing moldrepo - then putStrLn $ nvr ++ " is in " ++ buildtag - else putStrLn "done" + then logMsg $ nvr ++ + if isNothing moldrepo + then " is in " ++ buildtag + else " appeared" else do - when (isNothing moldrepo) $ do - cmd_ "date" [] - putStrLn $ "Waiting for " ++ buildtag ++ " to have " ++ nvr + when (isNothing moldrepo) $ + logMsg $ "Waiting for " ++ buildtag ++ " to have " ++ nvr waitRepo buildtag mrepo kojiTagArchs :: String -> IO [String] @@ -230,9 +231,9 @@ Just (buildtag,_desttag) -> do kojiListSideTags fedoraKojiHub (Just buildtag) (Just user) -maybeTimeout :: Double -> IO a -> IO a +maybeTimeout :: Micro -> IO a -> IO a maybeTimeout secs act = do - mres <- timeout secs act + mres <- timeout (fromEnum secs) act case mres of Nothing -> do warning "Connection timed out: retrying" diff --git a/src/Krb.hs b/src/Krb.hs --- a/src/Krb.hs +++ b/src/Krb.hs @@ -1,5 +1,6 @@ module Krb ( fasIdFromKrb, + maybeFasIdFromKrb, krbTicket ) where @@ -9,7 +10,7 @@ krbTicket :: IO () krbTicket = do - krb <- words . fromMaybe "" . find ("@FEDORAPROJECT.ORG" `isInfixOf`) . lines <$> cmd "klist" ["-l"] + krb <- klistEntryFedora if null krb then error' "No krb5 ticket found for FEDORAPROJECT.ORG" else @@ -18,9 +19,21 @@ cmd_ "fkinit" [] putStrLn "" +maybeFasIdFromKrb :: IO (Maybe String) +maybeFasIdFromKrb = + fmap (removeSuffix "@FEDORAPROJECT.ORG") . find ("@FEDORAPROJECT.ORG" `isSuffixOf`) <$> klistEntryFedora + fasIdFromKrb :: IO String fasIdFromKrb = do - mfasid <- (removeSuffix "@FEDORAPROJECT.ORG" <$>) . find ("@FEDORAPROJECT.ORG" `isSuffixOf`) . words <$> cmd "klist" ["-l"] + mfasid <- maybeFasIdFromKrb case mfasid of Nothing -> error' "Could not determine fasid from klist" Just fasid -> return fasid + +klistEntryFedora :: IO [String] +klistEntryFedora = do + mres <- cmdMaybe "klist" ["-l"] + return $ + maybe [] + (words . fromMaybe "" . find ("@FEDORAPROJECT.ORG" `isInfixOf`) . lines) + mres diff --git a/src/ListReviews.hs b/src/ListReviews.hs --- a/src/ListReviews.hs +++ b/src/ListReviews.hs @@ -30,13 +30,14 @@ listReviewsAll :: Bool -> ReviewStatus -> IO [Bug] listReviewsAll = listReviewsFull False Nothing Nothing +-- FIXME should not require login listReviewsFull :: Bool -> Maybe String -> Maybe String -> Bool -> ReviewStatus-> IO [Bug] listReviewsFull assignee muser mpat allopen status = do - (session,user) <- bzLoginSession + let session = bzAnonSession accountid <- do case muser of - Nothing -> return user + Nothing -> getBzUser Just userid -> if emailIsValid userid then return $ T.pack userid else do diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -27,7 +27,8 @@ import Cmd.Override import Cmd.Parallel import Cmd.PkgReview -import Cmd.Pull +import Cmd.Prep +import Cmd.PullPush --import Cmd.Repoquery import Cmd.RequestBranch import Cmd.RequestRepo @@ -92,6 +93,7 @@ , Subcommand "parallel" "Parallel build packages in Koji" $ parallelBuildCmd <$> dryrunOpt + <*> optionalWith auto 'l' "skip-to-layer" "LAYERNO" "Skip the first N layers [default 0]" 0 <*> optional sidetagTargetOpt <*> updatetypeOpt <*> branchesPackages @@ -120,14 +122,20 @@ <*> branchesPackages , Subcommand "update" "Update package in dist-git to newer version" $ updateCmd - <$> maybeBranchPackages False + <$> switchWith 's' "sources-only" "Only update sources" + <*> switchWith 'f' "force" "Download upstream sources even if they exist locally" + <*> switchWith 'H' "allow-head" "For updating inside rebase" + <*> maybeBranchPackages False , Subcommand "sort" "Sort packages in build dependency order" $ sortCmd - <$> optional rpmWithOpt + <$> switchWith 'p' "parallel" "Group dependent packages on separate lines" + <*> optional rpmWithOpt <*> maybeBranchPackages True , Subcommand "prep" "Prep sources" $ prepCmd - <$> maybeBranchPackages False + <$> optional prepPreOpts + <*> switchWith 'v' "verbose" "show rpmbuild output" + <*> maybeBranchPackages False , Subcommand "local" "Build locally" $ localCmd <$> optional forceshortOpt @@ -139,12 +147,14 @@ <*> maybeBranchPackages False , Subcommand "diff" "Diff local changes" $ diffCmd - <$> diffSpecOnly + <$> switchWith 'o' "spec-only" "Only diff spec file" <*> diffWorkOpt <*> diffFormatOpt - <*> diffBranchOpt + <*> switchWith 'q' "quiet" "Just output package name" + <*> optional diffFilterOpt + <*> optional (optionWith anyBranchM 'w' "with-branch" "BRANCH" "branch") <*> maybeBranchPackages False - , Subcommand "log" "Show commits between branches" $ + , Subcommand "compare" "Show commits between branches" $ logCmd <$> switchWith 'l' "long" "show full commit log" <*> anyBranchArg @@ -152,10 +162,10 @@ <*> manyPackages , Subcommand "mock" "Local mock build" $ mockCmd - <$> switchWith 'd' "dry-run" "Do not build (but creates srpm)" - <*> switchWith 'n' "no-clean" "Do not clean chroot before building a package" + <$> switchWith 'n' "dry-run" "Do not build (but creates srpm)" + <*> optional nocleanOpt <*> switchWith 'w' "network" "Use network during build" - <*> switchWith 'N' "no-clean-after" "Don't clean chroot after building a package" + <*> switchWith 's' "shell" "Enter chroot shell after building" <*> optional (optionWith branchM 'r' "root" "BRANCH" "Mock config to use") <*> branchesPackages , Subcommand "install-deps" "Install package build dependencies" $ @@ -179,14 +189,21 @@ <*> manyPackages , Subcommand "bump" "Bump release for package" $ bumpPkgs - <$> optional commitOpts + <$> switchWith 'l' "local" "Use local origin rather than checking latest koji" + <*> optional commitOpts <*> branchesPackages , Subcommand "commit" "Git commit packages" $ commitPkgs <$> optional commitOpts + <*> switchWith '1' "first-line" "use first line of changelog" + <*> switchWith 'u' "unstaged" "include unstaged changes" <*> manyPackages , Subcommand "pull" "Git pull packages" $ pullPkgs + <$> switchWith 'l' "lenient" "Ignore non-git dirs and files" + <*> branchesPackages + , Subcommand "push" "Git push packages" $ + pushPkgs <$> branchesPackages , Subcommand "create-review" "Create a Package Review request" $ createReview @@ -240,12 +257,15 @@ <$> dryrunOpt <*> switchWith 'l' "list-chroots" "Show project chroots" <*> buildByOpt - <*> many archOpt + <*> optional archesOpt <*> pkgArg "PROJECT" <*> branchesPackages - , Subcommand "rename-master" "Rename local master branch to rawhide" $ + , Subcommand "rename-rawhide" "Rename local 'master' branch to 'rawhide'" $ renameMasterCmd <$> manyPackages + , Subcommand "count" "Count number of living packages" $ + countCmd + <$> maybeBranchPackages True , Subcommand "graph" "Output dependency graph" $ graphCmd <$> switchWith 'o' "output" "Output graph in gv/dot format" @@ -343,6 +363,11 @@ Just req | null brs -> (BranchOpt req, pkgs) | otherwise -> error' "cannot have branch option and branch list" + prepPreOpts :: Parser PrepPre + prepPreOpts = + flagWith' PrepClone 'c' "clone" "Try to clone package repo first" <|> + flagWith' PrepPull 'p' "pull" "Git pull before preping" + rpmWithOpt :: Parser RpmWith rpmWithOpt = RpmWith <$> strOptionWith 'w' "with" "BCOND" "rpmspec --with option" <|> @@ -355,8 +380,10 @@ rebuildSrpmOpt = switchWith 's' "rebuild-srpm" "rebuild srpm in Koji" - buildOpts = BuildOpts <$> mergeOpt <*> noFailFastOpt <*> mtargetOpt <*> overrideOpt <*> dryrunOpt <*> updatetypeOpt + buildOpts = BuildOpts <$> mergeOpt <*> noFailFastOpt <*> mtargetOpt <*> overrideOpt <*> waitrepoOpt <*> dryrunOpt <*> updatetypeOpt <*> useChangelogOpt <*> switchWith 'p' "by-package" "Build by each package across brs" + useChangelogOpt = switchWith 'c' "changelog-notes" "Use spec changelog for Bodhi notes" + -- yesOpt = switchWith 'y' "yes" "Assume yes for questions" nopromptOpt = switchWith 'm' "no-prompt" "Merge without prompt" @@ -382,8 +409,12 @@ checkNotRawhide "rawhide" = error' "'rawhide' is not a valid target!" checkNotRawhide t = t - overrideOpt = switchWith 'o' "override" "Create a buildroot override and wait-repo" + overrideOpt = switchWith 'o' "override" "Create a buildroot override: implies --wait-repo" + waitrepoOpt = + optional (flagWith' True 'w' "waitrepo" "Waitrepo for each build" <|> + flagWith' False 'M' "no-waitrepo" "Do not waitrepo for each build") + dryrunOpt = switchWith 'n' "dry-run" "Do not write (push, build, post, override)" updatetypeOpt = flagWith' Nothing 'U' "no-update" "Do not generate a Bodhi update" <|> Just <$> optionalWith auto 'u' "update-type" "TYPE" "security, bugfix, enhancement (default), or newpackage" EnhancementUpdate @@ -396,20 +427,18 @@ diffFormatOpt = DiffContext <$> optionWith auto 'u' "unified" "CONTEXT" "Lines of context" <|> flagWith' DiffMinimal 'm' "minimal" "Minimize diff noise" <|> - flagWith' DiffStats 's' "stats" "Only show diff stats" <|> - flagWith DiffDefault DiffQuiet 'q' "quiet" "Just output package name" + flagWith' DiffStatus 'n' "status" "Show diff --name-status" <|> + flagWith DiffDefault DiffStats 's' "stats" "Show diff --stat" - diffSpecOnly :: Parser Bool - diffSpecOnly = switchWith 'o' "spec-only" "Only diff spec file" + diffFilterOpt :: Parser DiffFilter + diffFilterOpt = + DiffMatch <$> strOptionWith 'f' "filter" "PATTERN" "filter diff with pattern" <|> DiffNotMatch <$> strOptionWith 'F' "filter-not" "PATTERN" "negative filter for diff with pattern" diffWorkOpt :: Parser DiffWork diffWorkOpt = flagWith' DiffWorkStaged 'S' "staged" "Diff staged changes (git diff --cached)" <|> flagWith DiffWorkAll DiffWorkUnstage 'U' "unstaged" "Diff unstaged changes (git diff) [default is 'git diff HEAD']" - diffBranchOpt :: Parser (Maybe AnyBranch) - diffBranchOpt = optional (optionWith anyBranchM 'w' "with-branch" "BRANCH" "branch") - commitOpts :: Parser CommitOpt commitOpts = CommitMsg <$> strOptionWith 'm' "message" "COMMITMSG" "commit message" <|> @@ -424,9 +453,7 @@ Target <$> targetOpt <|> flagWith' SideTag 's' "sidetag" "Use the existing branch side-tag to build or creates one for you (with 'fedpkg request-side-tag --base-tag')" - packagerOpt = Owner <$> ownerOpt <|> Committer <$> usernameOpt - usernameOpt = strOptionWith 'u' "username" "USERNAME" "Packages user can commit to" - ownerOpt = strOptionWith 'o' "owner" "OWNER" "Package owner" + packagerOpt = Owner <$> strOptionWith 'o' "owner" "OWNER" "Package owner" <|> Committer <$> strOptionWith 'u' "username" "USERNAME" "Packages user can commit to" bcondOpt = BuildWith <$> strOptionWith 'w' "with" "FEATURE" "Turn on package FEATURE for build" <|> BuildWithout <$> strOptionWith 'W' "without" "FEATURE" "Turn off package FEATURE for build" @@ -440,3 +467,9 @@ scratchOpt = ScratchTask <$> optionWith auto 's' "scratch-build" "TASKID" "Existing scratch build taskid" <|> flagWith ScratchBuild SkipScratch 'S' "no-scratch" "Skip scratch build" + + nocleanOpt :: Parser NoClean + nocleanOpt = + flagWith' NoCleanBefore 'c' "no-clean" "Do not clean chroot before building" + <|> flagWith' NoCleanAfter 'C' "no-clean-after" "Do not clean chroot after building" + <|> flagWith' NoCleanAll 'A' "no-clean-all" "Do not clean chroot before or after building" diff --git a/src/Package.hs b/src/Package.hs --- a/src/Package.hs +++ b/src/Package.hs @@ -3,15 +3,17 @@ module Package ( builtRpms, clonePkg, + CloneUser(..), fedpkg, fedpkg_, checkForSpecFile, cleanChangelog, - getChangeLog, - getDirectoryName, + changelogVersions, + changeLogPrompt, getPackageName, getSummaryURL, findSpecfile, + maybeFindSpecfile, localBranchSpecFile, generateSrpm, generateSrpm', @@ -26,17 +28,16 @@ putPkgAnyBrnchHdr, withExistingDirectory, initialPkgRepo, --- splitBranchesPkgs, --- withBranchByPackages, withPackageByBranches, --- withPackageByBranches', withPackagesMaybeBranch, + withPackagesMaybeBranchNoHeadergit, LimitBranches(..), cleanGit, cleanGitFetch, cleanGitFetchActive, dirtyGit, dirtyGitFetch, + dirtyGitHEAD, Package(..), packageSpec, pkgNameVerRel, @@ -56,9 +57,11 @@ import Data.Char (isDigit) import Data.Either (partitionEithers) import Data.RPM -import Distribution.Fedora +import Distribution.Fedora hiding (Fedora,EPEL) +import Network.HTTP.Directory (Manager, httpExists, httpManager) import SimpleCmd.Rpm import System.Console.Pretty +import System.Posix.Files import Branches import Git @@ -79,25 +82,32 @@ have <- doesFileExist spec unless have $ error' $ spec ++ " not found" -getChangeLog :: Maybe String -> FilePath -> IO String -getChangeLog mcontext spec = do - clog <- cleanChangelog <$> cmd "rpmspec" ["-q", "--srpm", "--qf", "%{changelogtext}", spec] +changeLogPrompt :: Maybe String -> FilePath -> IO String +changeLogPrompt mcontext spec = do + clog <- cleanChangelog spec putStrLn "" putStrLn "```" putStrLn clog putStrLn "```" - ifM (not <$> isTty) - (return clog) $ - do - userlog <- prompt $ "Press Enter to use above or input " ++ fromMaybe "change" mcontext ++ " summary now" - return $ if null userlog then clog else userlog + -- FIXME is this actually useful? + tty <- isTty + if not tty + then return clog + else do + userlog <- prompt $ "Press Enter to use above or input " ++ fromMaybe "change" mcontext ++ " summary now" + return $ if null userlog then clog else userlog -cleanChangelog :: String -> String -cleanChangelog [] = error' "empty changelog" -- should not happen -cleanChangelog cs = +changelogVersions :: FilePath -> IO [String] +changelogVersions spec = do + ns <- cmdLines "rpmspec" ["-q", "--srpm", "--qf", "%{changelogname}", spec] + return $ map (removePrefix "- " . dropWhile (/= '-')) ns + +cleanChangelog :: FilePath -> IO String +cleanChangelog spec = do + cs <- cmd "rpmspec" ["-q", "--srpm", "--qf", "%{changelogtext}", spec] let ls = lines cs no = length $ filter ("- " `isPrefixOf`) ls - in if no == 1 then removePrefix "- " cs else cs + return $ if no == 1 then removePrefix "- " cs else cs getSummaryURL :: FilePath -> IO String getSummaryURL spec = do @@ -124,19 +134,18 @@ mspec <- maybeFindSpecfile case mspec of Just spec -> return spec - Nothing -> error' "No spec file found" + Nothing -> do + dir <- getDirectoryName + error' $ "No spec file found in: " ++ dir +-- adapted from fileWithExtension maybeFindSpecfile :: IO (Maybe FilePath) -maybeFindSpecfile = fileWithExtension ".spec" - where - -- looks in dir for a unique file with given extension - fileWithExtension :: String -> IO (Maybe FilePath) - fileWithExtension ext = do - files <- filter (ext `isExtensionOf`) <$> listDirectory "." - case files of - [] -> return Nothing - [spec] -> return $ Just spec - _ -> error' $ "No unique " ++ ext ++ " file found" +maybeFindSpecfile = do + files <- filter (".spec" `isExtensionOf`) <$> listDirectory "." + case files of + [] -> return Nothing + [spec] -> return $ Just spec + _ -> error' $ "More than one .spec file: " ++ unwords files localBranchSpecFile :: Package -> AnyBranch -> IO FilePath localBranchSpecFile pkg br = do @@ -153,7 +162,7 @@ Just spc -> do putStrLn $ "Warning: directory name differs from " ++ spc ++ "\n" return spc - Nothing -> error' "No spec file" + Nothing -> error' $ "No spec file for: " ++ unPackage pkg else findSpecfile rpmEval :: String -> IO (Maybe String) @@ -161,6 +170,11 @@ res <- cmd "rpm" ["--eval", s] return $ if null res || res == s then Nothing else Just res +-- rpmEval' :: String -> IO String +-- rpmEval' s = do +-- mres <- rpmEval s +-- fromMaybe (error' (show s ++ " undefined!")) mres + generateSrpm :: Maybe AnyBranch -> FilePath -> IO FilePath generateSrpm = generateSrpm' False @@ -173,34 +187,24 @@ dist <- getBranchDist br return ["--define", "dist " ++ rpmDistTag dist] srpmfile <- cmd "rpmspec" $ ["-q", "--srpm"] ++ distopt ++ ["--qf", "%{name}-%{version}-%{release}.src.rpm", spec] - srcrpmdir <- - ifM isPkgGitRepo - (return ".") $ - rpmEval "%{_srcrpmdir}" >>= maybe (error' "%_srcrpmdir undefined!") return - let srpm = srcrpmdir srpmfile - srpmdiropt = if null srcrpmdir then [] - else ["--define", "_srcrpmdir " ++ srcrpmdir] - sourcedir <- - ifM isPkgGitRepo - (return ".") $ - rpmEval "%{_sourcedir}" >>= maybe (error' "%_sourcedir undefined!") return - let sourcediropt = if null sourcedir then [] - else ["--define", "_sourcedir " ++ sourcedir] + cwd <- getCurrentDirectory + let srpmdiropt = ["--define", "_srcrpmdir " ++ cwd] + sourcediropt = ["--define", "_sourcedir " ++ cwd] if force then buildSrpm (distopt ++ srpmdiropt ++ sourcediropt) else do - exists <- doesFileExist srpm + exists <- doesFileExist srpmfile if not exists then buildSrpm (distopt ++ srpmdiropt ++ sourcediropt) else do - srpmTime <- getModificationTime srpm + srpmTime <- getModificationTime srpmfile fileTimes <- mapM getModificationTime (spec:srcs) if any (srpmTime <) fileTimes then buildSrpm (distopt ++ srpmdiropt ++ sourcediropt) else do -- pretty print with ~/ - putStrLn $ srpm ++ " is up to date" - return srpm + putStrLn $ srpmfile ++ " is up to date" + return srpmfile where buildSrpm opts = do srpm <- last . words <$> cmd "rpmbuild" (opts ++ ["-bs", spec]) @@ -244,7 +248,8 @@ rpmdirs = [ "--define="++ mcr +-+ cwd | gitDir, mcr <- ["_builddir", "_rpmdir", "_srcrpmdir", "_sourcedir"]] - args = rpmdirs ++ ["--define", "dist " ++ rpmDistTag dist] ++ buildopt ++ map show bconds ++ [spec] + args = rpmdirs ++ ["--define", "dist " ++ rpmDistTag dist] ++ + buildopt ++ map show bconds ++ [spec] ok <- if not quiet || shortcircuit then do @@ -266,8 +271,8 @@ installDeps strict spec = do missingdeps <- nub <$> (buildRequires spec >>= filterM notInstalled) unless (null missingdeps) $ do - putStrLn $ "Running dnf builddep " ++ unwords missingdeps - cmd_ "/usr/bin/sudo" $ "/usr/bin/dnf":"--quiet":"builddep": ["--skip-unavailable" | not strict] ++ ["--assumeyes", spec] + putStrLn $ "Running 'dnf install' " ++ unwords missingdeps + cmd_ "/usr/bin/sudo" $ "/usr/bin/dnf":"install": ["--skip-broken" | not strict] ++ ["--assumeyes"] ++ missingdeps checkSourcesMatch :: FilePath -> IO () checkSourcesMatch spec = do @@ -275,41 +280,81 @@ sourcefiles <- map (takeFileName . last . words) <$> cmdLines "spectool" [spec] sources <- lines <$> readFile "sources" gitfiles <- gitLines "ls-files" [] - forM_ sourcefiles $ \ src -> - unless (isJust (find (src `isInfixOf`) sources) || src `elem` gitfiles) $ do - prompt_ $ color Red $ src ++ " not in sources, please fix" + let missing = filter (\src -> isNothing (find (src `isInfixOf`) sources) && + src `notElem` gitfiles) + sourcefiles + unless (null missing) $ do + prompt_ $ color Red $ unwords missing ++ " not in sources, please fix" + checkOnBranch checkSourcesMatch spec + mgr <- httpManager + let pkg = takeBaseName spec + mapM_ (checkLookasideCache mgr pkg) sources + where + checkLookasideCache :: Manager -> String -> String -> IO () + checkLookasideCache mgr pkg source = do + case words source of + ("SHA512":('(':fileparen):"=":[hash]) -> do + let file = dropSuffix ")" fileparen + url = "https://src.fedoraproject.org/lookaside/pkgs" +/+ pkg +/+ file +/+ "sha512" +/+ hash +/+ file + unlessM (httpExists mgr url) $ do + putStrLn $ url ++ " not found" + putStrLn $ "uploading " ++ file ++ " to lookaside source repo" + fedpkg_ "upload" [file] + _ -> error' $ "invalid/unknown source:\n" ++ source getSources :: FilePath -> IO [FilePath] getSources spec = do gitDir <- isGitRepo - srcdir <- getSourceDir gitDir + cwd <- getCurrentDirectory + -- FIXME fallback to ~/rpmbuild/SOURCES? + msrcdir <- do + msourcedir <- rpmEval "%{_sourcedir}" + case msourcedir of + Nothing -> return Nothing + Just srcdir -> + if msourcedir == Just cwd + then return Nothing + else do + dir <- doesDirectoryExist srcdir + if dir + then return msourcedir + else return Nothing (patches,srcs) <- partitionEithers . map sourceFieldFile <$> cmdLines "spectool" ["-a", spec] - unless gitDir $ - unlessM (doesDirectoryExist srcdir) $ - createDirectoryIfMissing True srcdir - forM_ srcs $ \ src -> - unlessM (doesFileExist (srcdir src)) $ do - uploaded <- - if gitDir then do - have_sources <- doesFileExist "sources" - if have_sources then - grep_ src "sources" + forM_ srcs $ \ src -> do + exists <- doesFileExist src &&^ checkCompression src + inSrcdir <- doesSourceDirFileExist msrcdir src + unless exists $ do + if inSrcdir + then maybeSourceDir createLink msrcdir src + else do + uploaded <- + if gitDir then do + have_sources <- doesFileExist "sources" + if have_sources then + grep_ src "sources" + else return False else return False - else return False - mfedpkg <- findExecutable "fedpkg" - if uploaded && isJust mfedpkg - then cmd_ "fedpkg" ["sources"] - else do - cmd_ "spectool" ["-g", "-S", "-C", srcdir, spec] - unlessM (doesFileExist (srcdir src)) $ - error' $ "download failed: " ++ src + mfedpkg <- findExecutable "fedpkg" + if uploaded && isJust mfedpkg + then cmd_ "fedpkg" ["sources"] + else do + cmd_ "spectool" ["-g", "-S", spec] + unlessM (doesFileExist src) $ + error' $ "download failed: " ++ src + unless inSrcdir $ + whenJust msrcdir $ \srcdir -> + createLink src (srcdir src) forM_ patches $ \patch -> - unlessM (doesFileExist (srcdir patch)) $ do - cmd_ "spectool" ["-g", "-P", "-C", srcdir, spec] - unlessM (doesFileExist (srcdir patch)) $ - error' $ "missing patch: " ++ patch + unlessM (doesFileExist patch) $ do + inSrcdir <- doesSourceDirFileExist msrcdir patch + if inSrcdir + then maybeSourceDir copyFile msrcdir patch + else do + cmd_ "spectool" ["-g", "-P", spec] + unlessM (doesFileExist patch) $ + error' $ "missing patch: " ++ patch return $ srcs ++ patches where sourceFieldFile :: String -> Either FilePath FilePath @@ -324,12 +369,32 @@ _ -> error' $! "illegal field: " ++ f) $ takeFileName v - getSourceDir :: Bool -> IO FilePath - getSourceDir gitDir = - if gitDir - then getCurrentDirectory - else fromJust <$> rpmEval "%{_sourcedir}" + checkCompression :: FilePath -> IO Bool + checkCompression file = + case + case takeExtension file of + ".gz" -> Just "gzip" + ".tgz" -> Just "gzip" + ".bz2" -> Just "bzip2" + ".xz" -> Just "xz" + ".lz" -> Just "lzip" + ".zstd" -> Just "zstd" + _ -> Nothing + of + Just prog -> cmdBool prog ["-t", file] + Nothing -> return True + maybeSourceDir :: (FilePath -> FilePath -> IO ()) + -> Maybe FilePath -> FilePath -> IO () + maybeSourceDir act mdir file = + whenJust mdir $ \dir -> + act (dir file) file + + doesSourceDirFileExist :: Maybe FilePath -> FilePath -> IO Bool + doesSourceDirFileExist Nothing _ = return False + doesSourceDirFileExist (Just srcdir) file = + doesFileExist (srcdir file) + withExistingDirectory :: FilePath -> IO a -> IO a withExistingDirectory dir act = ifM (doesDirectoryExist dir) @@ -426,41 +491,21 @@ { gitOptClean :: Bool , gitOptFetch :: Bool , gitOptActive :: Bool + , gitOptHEAD :: Bool -- allow detached head/rebase state } -cleanGit, cleanGitFetch, cleanGitFetchActive, dirtyGit, dirtyGitFetch :: Maybe GitOpts --- clean fetch active -cleanGit = Just $ GitOpts True False False -cleanGitFetch = Just $ GitOpts True True False -cleanGitFetchActive = Just $ GitOpts True True True -dirtyGit = Just $ GitOpts False False False -dirtyGitFetch = Just $ GitOpts False True False +cleanGit, cleanGitFetch, cleanGitFetchActive, dirtyGit, dirtyGitFetch, dirtyGitHEAD :: Maybe GitOpts +-- clean fetch active HEAD +cleanGit = Just $ GitOpts True False False False +cleanGitFetch = Just $ GitOpts True True False False +cleanGitFetchActive = Just $ GitOpts True True True False +dirtyGit = Just $ GitOpts False False False False +dirtyGitFetch = Just $ GitOpts False True False False +dirtyGitHEAD = Just $ GitOpts False False False True data LimitBranches = AnyNumber | Zero | ZeroOrOne | ExactlyOne deriving Eq --- do package over branches --- withPackageByBranches :: Maybe Bool --- -> Maybe GitOpts --- -> Maybe BranchOpts --- -> Bool --- -> LimitBranches --- -> (Package -> AnyBranch -> IO ()) --- -> [String] --- -> IO () --- withPackageByBranches mheader mgitopts mbrnchopts exists limitBranches action args = do --- (brs,pkgs) <- splitBranchesPkgs (have gitOptActive) mbrnchopts exists args --- let mheader' = --- case mheader of --- Nothing -> Nothing --- Just _ | length pkgs < 2 && length brs < 2 && isNothing mbrnchopts -> Nothing --- _ -> mheader --- withPackageByBranches' mheader' mgitopts mbrnchopts limitBranches action (brs,pkgs) --- where --- have :: (GitOpts -> Bool) -> Bool --- have opt = maybe False opt mgitopts - - -- FIXME rename to withPackages* -- FIXME countdown packages withPackageByBranches :: Maybe Bool @@ -504,9 +549,18 @@ haveGit <- isPkgGitRepo when (isJust mgitopts && not haveGit) $ error' $ "Not a pkg git dir: " ++ unPackage pkg - mcurrentbranch <- if haveGit then Just <$> gitCurrentBranch - else return Nothing - brs <- listOfAnyBranches haveGit (have gitOptActive) breq + mcurrentbranch <- + if haveGit + then + if have gitOptHEAD + then do + cur <- gitCurrentBranch' + if cur == OtherBranch "HEAD" + then warning "detached HEAD" >> return Nothing + else return $ Just cur + else Just <$> gitCurrentBranch + else return Nothing + brs <- listOfAnyBranches (haveGit && not (have gitOptHEAD)) (have gitOptActive) breq case limitBranches of ZeroOrOne | length brs > 1 -> -- FIXME: could be handled better (testcase: run long list of packages in wrong directory) @@ -523,9 +577,9 @@ _ -> when (fetch || isJust mheader) $ putPkgHdr pkg when haveGit $ when (have gitOptClean) checkWorkingDirClean - when fetch $ gitFetchSilent >> putStrLn "" + when fetch gitFetchSilent -- FIXME!! no branch restriction - when (breq == BranchOpt AllBranches) $ + when (breq `elem` map BranchOpt [AllBranches,AllFedora,AllEPEL]) $ putStrLn $ "Branches: " ++ unwords (map show brs) ++ "\n" -- FIXME add newline at end? let action' p b = do @@ -547,41 +601,51 @@ withPackagesMaybeBranch mheader mgitopts limitBranches action (mbr, pkgs) = withPackageByBranches mheader mgitopts limitBranches action (Branches (maybeToList mbr),pkgs) --- -- do branch over packages --- withBranchByPackages :: (Branch -> [String] -> IO ()) -> (Branches,[String]) -> IO () --- withBranchByPackages action (brs,pkgs) = do --- when (null brs) $ --- error' "Please specify at least one branch" --- when (null pkgs) $ --- error' "Please give at least one package" --- forM_ brs $ \ br -> --- -- forM_ (map packagePath pkgs) $ \ (dir,pkg) -> --- -- withExistingDirectory dir $ do --- -- void $ setupGit False pkg True --- action br pkgs +withPackagesMaybeBranchNoHeadergit :: LimitBranches + -> (Package -> AnyBranch -> IO ()) + -> (Maybe Branch,[String]) + -> IO () +withPackagesMaybeBranchNoHeadergit = + withPackagesMaybeBranch Nothing Nothing -clonePkg :: Bool -> Maybe Branch -> String -> IO () -clonePkg quiet mbr pkg = - ifM (doesDirectoryExist pkg) - {-then-} (putStrLn $ pkg ++ "/ already exists") $ - {-else-} do - let mbranch = case mbr of - Nothing -> [] - Just br -> ["--branch", show br] - fasid <- fasIdFromKrb - putStr $ - if quiet - then "cloning..." - else "Cloning: " ++ pkg - git_ "clone" $ ["--quiet"] ++ mbranch ++ ["ssh://" ++ fasid ++ "@pkgs.fedoraproject.org/rpms/" ++ pkg] - putStrLn "" +data CloneUser = AnonClone | UserClone +clonePkg :: Bool -> CloneUser -> Maybe Branch -> String -> IO () +clonePkg quiet cloneuser mbr pkg = do + exists <- doesDirectoryExist pkg + if exists + then putStrLn $ pkg ++ "/ already exists" + else do + let mbranch = case mbr of + Nothing -> [] + Just br -> ["--branch", show br] + case cloneuser of + AnonClone -> do + msgout + git_ "clone" $ ["--quiet"] ++ mbranch ++ ["https://src.fedoraproject.org/rpms/" ++ pkg <.> "git"] + UserClone -> do + fasid <- fasIdFromKrb + msgout + git_ "clone" $ ["--quiet"] ++ mbranch ++ ["ssh://" ++ fasid ++ "@pkgs.fedoraproject.org/rpms/" ++ pkg <.> "git"] + putStrLn "" + where + msgout = + putStr $ if quiet then "cloning..." else "Cloning: " ++ pkg + pkgNameVerRel :: Branch -> FilePath -> IO (Maybe String) pkgNameVerRel br spec = do - dist <- branchDist br + disttag <- rpmDistTag <$> branchDist br -- workaround dist with bootstrap hostdist <- cmd "rpm" ["--eval", "%{dist}"] - fmap (replace hostdist (rpmDistTag dist)) . listToMaybe <$> rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") spec + -- FIXME more precise regexp with "Release:" + autorelease <- grep_ " %autorelease" spec + fmap (replace hostdist disttag) . listToMaybe <$> + if autorelease + then do + -- FIXME use ? + autorel <- last . words <$> cmd "rpmautospec" ["calculate-release", spec] + rpmspec ["--srpm"] (Just ("%{name}-%{version}-" ++ autorel ++ disttag)) spec + else rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") spec pkgNameVerRel' :: Branch -> FilePath -> IO String pkgNameVerRel' br spec = do @@ -593,7 +657,12 @@ builtRpms :: AnyBranch -> FilePath -> IO [FilePath] builtRpms br spec = do dist <- getBranchDist br - rpms <- rpmspec ["--builtrpms", "--define", "dist " ++ rpmDistTag dist] (Just "%{arch}/%{name}-%{version}-%{release}.%{arch}.rpm") spec + rpmdir <- do + pkggit <- isPkgGitRepo + if pkggit + then return "" + else fromMaybe "" <$> rpmEval "%{_rpmdir}" + rpms <- rpmspec ["--builtrpms", "--define", "dist " ++ rpmDistTag dist] (Just (rpmdir "%{arch}/%{name}-%{version}-%{release}.%{arch}.rpm")) spec if null rpms then error' $ spec ++ " does not seem to create any rpms" else return rpms @@ -604,9 +673,24 @@ -- from fedora-haskell-tools buildRequires :: FilePath -> IO [String] -buildRequires spec = - -- FIXME should resolve meta - map (head . words) <$> rpmspec ["--buildrequires"] Nothing spec +buildRequires spec = do + dynbr <- grep_ "^%generate_buildrequires" spec + mapMaybe primary <$> + if dynbr + then do + out <- cmdIgnoreErr "rpmbuild" ["-br", "--nodeps", spec] "" + -- Wrote: /current/dir/SRPMS/name-version-release.buildreqs.nosrc.rpm + cmdLines "rpm" ["-qp", "--requires", last (words out)] + else + -- FIXME should resolve meta + rpmspec ["--buildrequires"] Nothing spec + where + primary dep = + case (head . words) dep of + '(':rest -> Just rest + d -> if "rpmlib(" `isPrefixOf` d + then Nothing + else Just d notInstalled :: String -> IO Bool notInstalled pkg = @@ -620,9 +704,20 @@ pkgInstalled pkg = cmdBool "rpm" ["--quiet", "-q", pkg] -repoquery :: Branch -> [String] -> IO String -repoquery br args = - cmd "dnf" (["repoquery", "--quiet", "--releasever=" ++ branchVersion br] ++ args) +repoquery :: Branch -> Branch -> [String] -> IO String +repoquery sysbr br args = do + let brOpts = + if sysbr == br + then [] + else + case br of + Rawhide -> ["--disablerepo=*", "--enablerepo=rawhide"] + Fedora _ -> ["--disablerepo=*", "--enablerepo=fedora", + "--enablerepo=updates", + "--releasever=" ++ branchVersion br] + EPEL _ -> ["--disablerepo=*", "--enablerepo=epel", + "--releasever=" ++ branchVersion br] + cmd "dnf" (["repoquery", "--quiet"] ++ brOpts ++ args) -- FIXME should be more strict about dist tag (eg .fcNN only) equivNVR :: String -> String -> Bool @@ -646,12 +741,6 @@ nameOfNVR = removeSeg . removeSeg where removeSeg = init . dropWhileEnd (/= '-') - -#if !MIN_VERSION_filepath(1,4,2) -isExtensionOf :: String -> FilePath -> Bool -isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions -isExtensionOf ext = isSuffixOf ('.':ext) . takeExtensions -#endif -- FIXME: drop when rpm-nvr has nvrVerRel showNVRVerRel :: NVR -> String diff --git a/src/Prompt.hs b/src/Prompt.hs --- a/src/Prompt.hs +++ b/src/Prompt.hs @@ -33,9 +33,10 @@ then return $ Just (Just ref) else refPrompt commits txt +-- FIXME also include branch conflictPrompt :: [String] -> String -> IO (Maybe String) conflictPrompt commits txt = do - let commitrefs = tail $ map (head . words) commits + let commitrefs = map (head . words) commits ref <- prompt txt if null ref then return Nothing else if ref `elem` commitrefs diff --git a/src/Types.hs b/src/Types.hs new file mode 100644 --- /dev/null +++ b/src/Types.hs @@ -0,0 +1,6 @@ +module Types ( + Archs(..) + ) +where + +data Archs = Archs [String] | ExcludedArchs [String]