fbrnch 0.8.0 → 0.9
raw patch · 37 files changed
+616/−1810 lines, 37 filesdep +kojidep −haxrdep −mtldep ~rpmbuild-orderPVP ok
version bump matches the API change (PVP)
Dependencies added: koji
Dependencies removed: haxr, mtl
Dependency ranges changed: rpmbuild-order
API changes (from Hackage documentation)
Files
- CHANGELOG.md +26/−0
- README.md +111/−64
- fbrnch.cabal +8/−14
- libs/copr-hs/src/Web/Fedora/Copr/API.hs +3/−3
- libs/fedora-dists/src/Distribution/Fedora/Branch.hs +1/−0
- libs/koji-hs/LICENSE +0/−339
- libs/koji-hs/src/Fedora/Koji.hs +0/−308
- libs/koji-hs/src/Fedora/Koji/Internal.hs +0/−824
- src/Bodhi.hs +4/−4
- src/Branches.hs +24/−18
- src/Cmd/Build.hs +17/−13
- src/Cmd/Copr.hs +35/−11
- src/Cmd/Diff.hs +2/−2
- src/Cmd/Import.hs +3/−3
- src/Cmd/Install.hs +11/−6
- src/Cmd/ListBranches.hs +47/−21
- src/Cmd/Local.hs +6/−25
- src/Cmd/Merge.hs +16/−8
- src/Cmd/Override.hs +10/−6
- src/Cmd/Parallel.hs +18/−10
- src/Cmd/PkgReview.hs +26/−19
- src/Cmd/Pull.hs +1/−1
- src/Cmd/RequestBranch.hs +5/−4
- src/Cmd/RequestRepo.hs +7/−3
- src/Cmd/Scratch.hs +4/−2
- src/Cmd/SideTags.hs +4/−6
- src/Cmd/Sort.hs +39/−0
- src/Cmd/Status.hs +1/−1
- src/Cmd/Update.hs +5/−6
- src/Cmd/WaitRepo.hs +22/−0
- src/Common.hs +4/−1
- src/Git.hs +35/−24
- src/Koji.hs +45/−26
- src/Main.hs +48/−16
- src/Package.hs +23/−19
- src/Pagure.hs +2/−2
- src/Prompt.hs +3/−1
CHANGELOG.md view
@@ -1,5 +1,31 @@ # Changelog +## 0.9 (2021-05-30)+- 'override' --duration and run waitrepo after all overrides+- new 'waitrepo' command+- 'create-review','rename-master': take no branches+- branchPrompt now correctly defaults to two branches+- prompts now reset stdin (#20)+- 'build': add --no-merge and rename --no-prompt to --merge+- 'copr': native watch-build+- 'install-deps': use --skip-unavailable for dnf buildeps+- 'install': switches to specified branch; allow --recurse & --rebuild+- 'branches': add --current and support --missing+- 'request-repo': show review comments and prompt to continue+- merge handling improvements+- 'scratch': display nvr before building+- 'parallel': native koji waitTask+- 'sidetags': default to all user's sidetags+- 'create-review','update-review': --scratch-build TASKID option+- Koji: timeouts to handle for network connection failures+- 'parallel': error if no branch given+- gitFetchSilent: show git reponame instead of dirname+- new 'graph' command renders dependency graph using graphviz+ (using rpmbuild-order-0.4.5)+- fix handling of optional branch args+- merge: improve output when not mergeable+- srpm: regenerate if any sources newer than existing srpm file+ ## 0.8.0 (2021-04-08) - 'request-repos' can now take branch args and --mock option (#18) - 'parallel': only override and waitrepo if more layers
README.md view
@@ -7,8 +7,9 @@ A tool to help Fedora Packagers build package branches and add new packages. Fedora developers use a lot of time building packages across releases-and workflow for adding new packages, etc. The motivation for fbrnch is-to help to (semi-)automate common workflows to save time and effort.+and workflow for adding new packages, etc.+fbrnch was made to help (semi-)automate common workflows to save time+and effort. fbrnch is distributed under the GPL license version 2 or later. @@ -42,17 +43,18 @@ ``` $ fbrnch update-review [my-new-package] ```-Similar to create-review: uploads to fedorapeople and posts-updated package links to the open package review.+Similar to create-review: it uploads the updated files to fedorapeople+and posts the updated package urls to the open package review. #### List open package reviews+To list one's open package reviews: ``` $ fbrnch reviews ```-This lists one's open package reviews.-Various options like `--approved` or `--created` allow filtering by status.+They can be filtered by status with various options like+`--approved` or `--created`. -One can also search for reviews with:+One can also search for the review(s) of a specific package with: ``` $ fbrnch find-review package-name ```@@ -62,89 +64,118 @@ ``` $ fbrnch request-repos ```-will request repos for approved package(s).+will request repos for approved package(s) and offer to request branches. #### Import a new package-With fbrnch this can be done in one step - no need to clone first.+After the repo has been created ```-$ fbrnch import [my-new-package]+$ fbrnch import ```-will offer to import the srpm from the approved review-(similar to `fedpkg import`).-Without any arguments it will offer to import any approved package reviews-one by one.-The imported package is then built in Koji Rawhide,-and the package review updated.+will clone the repo and offer to import the srpm+directly from the latest url in the approved package review,+which can then be built directly into Koji Rawhide+and the package review is updated. #### Request branches-Finally you can request branches with+If you prefer you can request branches after the repo is created+or package imported with ``` $ fbrnch request-branches ```-which will confirm which branches you want, unless given.+which will be prompt for which branches you want, unless already given. -Optionally a mock build can be done first.+Optionally a mock build per branch can be done first. -### Building-#### Cloning and switching branch+### Cloning and switching branch+Clone one or more packages: ```-$ fbrnch clone [package] ...+$ fbrnch clone package ... ```-(one can also clone all one's packages or another user's packages).+There are also options to clone all one's packages or another user's packages. +One can change the branch of one or more packages: ```-$ fbrnch switch f33 [package] ...+$ fbrnch switch f34 [package] ... ``` -You can also git pull:+You can also git pull over packages: ``` $ fbrnch pull [package] ... ```-#### Package status++### List packages and branches+You can list packages in dist-git pagure with ```+$ fbrnch list PATTERN+```+with globbing.++Branches of a package can be listed:+```+$ fbrnch branches -B [package] ...+```+You can use the `--remote` option if you don't have the package checked out.++### Package status+``` $ fbrnch status -B [package] ``` outputs information about the status of each branch. The status command can also be used with `--reviews` to check the build status of new packages. -List package bugs:+You can output package's nvr's from local git: ```+$ fbrnch nvr -B [package]+```++and list package bugs:+``` $ fbrnch bugs [package] ``` -#### Commit, Merging and Building in Koji+### Commit, Merging and Building in Koji You can commit to the current branch: ``` $ fbrnch commit ```-uses any rpm changelog, or you can pass `-m "..."` or amend with `-a`.+It uses any rpm changelog, or you can pass `-m "..."` or amend with `-a`. You can merge branches with: ```-$ fbrnch merge f32 package+$ fbrnch merge f33 package ```-which will offer to merge f33 (or some of it) into f32.+which will offer to merge f34 (or some of it) into f33. Merging can also be done together with building: ```-$ fbrnch build f33 package+$ fbrnch build f34 package ```-will offer to merge newer commits from the newer branch.-If the branch NVR is also ready pushed and built it will be skipped.+will ask if you want to merge newer commits from a newer branch,+then push and build it.++If the branch is also already pushed and NVR built it will be skipped. Branch builds are pushed to Bodhi. You can also build all branches: ``` $ fbrnch build -B package ```+or all fedora branches:+```+$ fbrnch build -F package+```+or all epel branches:+```+$ fbrnch build -E package+``` Scratch builds can also be done: ``` $ fbrnch scratch rawhide ```-optionally a different koji target can be given.+optionally a different koji `--target` can be given. You can sort packages by build dependency order: ```@@ -160,40 +191,56 @@ ``` $ fbrnch local ```-this works in the current package dir like other commands-and one can also specify package.+this works in the current package dir like other commands,+installing any missing dependencies with `sudo dnf builddep`. +Or one can specify the path to the package.+ Locally build and install: ``` $ fbrnch install package1 package2 package3 ... ``` +You can use:+```+$ fbrnch install-deps [package]+```+to only install the dependencies of a package.++Use+```+$ fbrnch rename-master [package]+```+to rename an old master branch locally to rawhide.+ ### Parallel building fbrnch can sort packages automatically and build them in parallel in Koji in dependency layers (using low-priority background builds to avoid grabbing too many Koji resources). ```-$ fbrnch parallel --sidetag rawhide pkg-x pkg-y pkg-z pkg-xy pkg-xyz+$ fbrnch parallel --sidetag rawhide pkg-x pkg-y pkg-z pkg-xy pkg-xy-z ```-builds a list of packages in parallel ordered by build dependencies.+generates a sidetag and builds a list of packages there+in parallel ordered by build dependencies. -Note it requires a sidetag in general, so you need to manage and select them+Except for rawhide using a sidetag is required,+so you need to manage and select them if using more than one per branch with `--target`. ### Other commands-There are more commands like `nvr`, `install-deps`, `copr`.+There are more commands like `copr` and `graph`. See `fbrnch --help` for details and the full list. ## Known issues - parallel builds will push local package commits without asking-- currently only checks if already built by NVR not githash+- 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 RPC for speed and control.+ 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@@ -206,21 +253,6 @@ - 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) -## Required runtime tools-fbrnch currently uses these fedora cli tools:-- fedpkg-- bodhi-- koji-- copr-cli-for pushing packages.--It also makes use of:-- curl-- rpmbuild & rpmspec-- klist-- git-- ssh & scp (for uploading package reviews)- ## Installation fbrnch is packaged in Fedora: `sudo dnf install fbrnch`. @@ -244,14 +276,29 @@ $ cabal new-install --installdir=~/bin ``` +## Required runtime tools+fbrnch currently uses these fedora cli tools:+- fedpkg+- bodhi+- koji+- copr-cli+for pushing packages.++It also makes use of:+- curl+- rpmbuild & rpmspec+- klist+- git+- ssh & scp (for uploading package reviews)+ ## Contributing Bug reports, feedback, and fixes are welcome. -See the TODO list and also the many FIXME comments scattered across the source.-It is better to ask before embarking on large changes.+See the TODO list and also the FIXME comments scattered across the source.+Please ask before embarking on large changes. ## Usual disclaimer-This is still in active development.-While it is generally works well for me,-if it should breaks things for you, you get to keep the pieces. :)-But please do report unsupported or unintuitive workflows.+fbrnch comes without an warranty.+It is still actively being developed.++Please report any unsupported or unintuitive parts of workflows.
fbrnch.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: fbrnch-version: 0.8.0+version: 0.9 synopsis: Build and create Fedora package repos and branches description: fbrnch is a convenient packaging tool for Fedora Packagers,@@ -25,8 +25,8 @@ bug-reports: https://github.com/juhp/fbrnch/issues license: GPL-2 license-file: LICENSE-author: Jens Petersen-maintainer: petersen@fedoraproject.org+author: Jens Petersen <petersen@redhat.com>+maintainer: Jens Petersen <petersen@fedoraproject.org> copyright: 2019-2021 Jens Petersen category: Distribution build-type: Simple@@ -35,7 +35,6 @@ libs/bodhi-hs/LICENSE libs/copr-hs/LICENSE libs/fedora-dists/LICENSE- libs/koji-hs/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,@@ -75,9 +74,11 @@ Cmd.Reviews Cmd.Scratch Cmd.SideTags+ Cmd.Sort Cmd.Status Cmd.Switch Cmd.Update+ Cmd.WaitRepo Common Common.System Common.Text@@ -98,16 +99,12 @@ Distribution.Fedora.Branch Distribution.Fedora.Products Distribution.Fedora.ReadProducts- -- koji- Fedora.Koji- Fedora.Koji.Internal -- pdc Fedora.PDC hs-source-dirs: src libs/copr-hs/src libs/fedora-dists/src- libs/koji-hs/src libs/pdc-hs/src default-language: Haskell2010 @@ -128,13 +125,13 @@ http-conduit, http-directory >= 0.1.5, http-query,- -- koji,+ koji, network-uri, optparse-applicative, pagure-internal, pretty-terminal, process,- rpmbuild-order >= 0.4.2,+ rpmbuild-order >= 0.4.5, simple-cmd >= 0.2.0, simple-cmd-args >= 0.1.6, text,@@ -143,10 +140,7 @@ utf8-string, xdg-basedir, -- for copr:- unordered-containers,- -- for koji:- haxr >= 3000.11.4,- mtl+ unordered-containers if impl(ghc<8.0) build-depends: semigroups
libs/copr-hs/src/Web/Fedora/Copr/API.hs view
@@ -71,7 +71,7 @@ -- | get build -- -- https://pagure.io/copr/copr/blob/master/f/python/copr/v3/proxies/build.py#_10-coprGetBuild :: String -> Int -> IO Value+coprGetBuild :: String -> Int -> IO Object coprGetBuild server bid = do let path = "build" +/+ show bid queryCopr server path []@@ -79,7 +79,7 @@ -- | get srpm build -- -- https://pagure.io/copr/copr/blob/master/f/python/copr/v3/proxies/build.py#_22-coprGetBuildSourceChroot :: String -> Int -> IO Value+coprGetBuildSourceChroot :: String -> Int -> IO Object coprGetBuildSourceChroot server bid = do let path = "build/source-chroot" +/+ show bid queryCopr server path []@@ -87,7 +87,7 @@ -- | get build source config -- -- https://pagure.io/copr/copr/blob/master/f/python/copr/v3/proxies/build.py#_34-coprGetBuildSourceConfig :: String -> Int -> IO Value+coprGetBuildSourceConfig :: String -> Int -> IO Object coprGetBuildSourceConfig server bid = do let path = "build/source-build-config" +/+ show bid queryCopr server path []
libs/fedora-dists/src/Distribution/Fedora/Branch.hs view
@@ -54,6 +54,7 @@ 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
− libs/koji-hs/LICENSE
@@ -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.-- <one line to give the program's name and a brief idea of what it does.>- Copyright (C) <year> <name of author>-- 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.-- <signature of Ty Coon>, 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.
− libs/koji-hs/src/Fedora/Koji.hs
@@ -1,308 +0,0 @@-module Fedora.Koji- ( BuildID(..)- , BuildInfo(..)- , buildIDInfo- , fedoraKojiHub- , centosKojiHub- , kojiBuildTags- , kojiBuildTarget- , kojiGetBuildID- , kojiGetBuildState- , kojiGetBuildTaskID- , kojiGetCurrentRepo- , kojiGetRepo- , kojiGetTaskInfo- , kojiGetTaskChildren- , kojiGetTaskState- , kojiGetUserID- , kojiLatestBuild- , kojiLatestBuildRepo- , kojiListSideTags- , kojiListTaskIDs- , kojiUserBuildTasks- , KojiBuild(..)- , kojiListTaggedBuilds- , PackageID(..)- , TagID(..)- , TaskID(..)- , UserID(..)- , displayID- , getID- , readID- , readID'- , TaskState(..)- , getTaskState- , openTaskStates- , openTaskValues- , readTaskState- , BuildState(..)- , readBuildState- , Struct- , lookupStruct- , Value (..)- , getInt- , getString- , maybeVal- , RepoState(..)- , readRepoState- )-where--import qualified Data.List as L-import Data.Maybe-import Network.XmlRpc.Internals--import Fedora.Koji.Internal--class ID a where- getID :: a -> Int- mkID :: Int -> a--displayID :: ID a => a -> String-displayID = show . getID---- FIXME rename to structID ?-readID :: ID a => Struct -> Maybe a-readID st = lookup "id" st >>= fmap mkID . getInt--readID' :: Struct -> Maybe Int-readID' st = lookup "id" st >>= getInt---- FIXME rename to valueInt ?-getInt :: Value -> Maybe Int-getInt (ValueInt i) = Just i-getInt _ = Nothing--getString :: Value -> Maybe String-getString (ValueString i) = Just i-getString _ = Nothing--newtype TaskID = TaskId Int- deriving Show--instance ID TaskID where- getID (TaskId i) = i- mkID = TaskId--newtype TagID = TagId Int- deriving Show--instance ID TagID where- getID (TagId i) = i- mkID = TagId--newtype UserID = UserId Int- deriving Show--instance ID UserID where- getID (UserId i) = i- mkID = UserId--newtype BuildID = BuildId Int--instance ID BuildID where- getID (BuildId i) = i- mkID = BuildId--newtype PackageID = PackageId Int--instance ID PackageID where- getID (PackageId i) = i- mkID = PackageId--newtype BuildrootID = BuildrootId Int--instance ID BuildrootID where- getID (BuildrootId i) = i- mkID = BuildrootId--data BuildInfo = BuildInfoID Int | BuildInfoNVR String--buildInfo :: BuildInfo -> Info-buildInfo (BuildInfoID bid) = InfoID bid-buildInfo (BuildInfoNVR nvr) = InfoString nvr--buildIDInfo :: BuildID -> BuildInfo-buildIDInfo (BuildId bid) = BuildInfoID bid--fedoraKojiHub :: String-fedoraKojiHub = "https://koji.fedoraproject.org/kojihub"--centosKojiHub :: String-centosKojiHub = "https://koji.mbox.centos.org/kojihub"--kojiGetBuildID :: String -- ^ hub url- -> String -- ^ NVR- -> IO (Maybe BuildID)-kojiGetBuildID hubUrl nvr =- ((fmap BuildId . lookupStruct "id") =<<) <$> getBuild hubUrl (InfoString nvr)--kojiGetBuildTaskID :: String -- ^ hub url- -> String -- ^ NVR- -> IO (Maybe TaskID)-kojiGetBuildTaskID hubUrl nvr =- ((fmap TaskId . lookupStruct "task_id") =<<) <$> getBuild hubUrl (InfoString nvr)--kojiListTaskIDs :: String- -> Struct -- ^ opts- -> Struct -- ^ qopts- -> IO [TaskID]-kojiListTaskIDs hubUrl opts qopts =- mapMaybe readID <$> listTasks hubUrl opts qopts--kojiUserBuildTasks :: String -> UserID -> Maybe String -> Maybe String -> IO [TaskID]-kojiUserBuildTasks hubUrl userid msource mtarget = do- tasks <- listTasks hubUrl [("owner",ValueInt (getID userid)),("method",ValueString "build"),("state",openTaskValues)] []- return $ map TaskId . mapMaybe (lookupStruct "id") $ filter isTheBuild tasks- where- isTheBuild :: Struct -> Bool- isTheBuild st =- let mreq = lookupStruct "request" st in- case mreq of- Nothing -> False- Just req ->- maybe True (`L.isInfixOf` req) msource &&- maybe True (\ target -> ("<value><string>" ++ target ++ "</string></value>") `L.isInfixOf` req) mtarget---- getTagID :: String -- ^ tag--- -> IO TagID--- getTagID tag =--- TagId <$> koji "getTagID" tag--kojiGetUserID :: String -> String -> IO (Maybe UserID)-kojiGetUserID hubUrl name = do- res <- getUser hubUrl (InfoString name) False- return $ readID =<< res--kojiBuildTags :: String -> BuildInfo -> IO [String]-kojiBuildTags hubUrl buildinfo = do- lst <- listTags hubUrl (Just (buildInfo buildinfo)) Nothing False- return $ mapMaybe (lookupStruct "name") lst--data BuildState = BuildBuilding | BuildComplete | BuildDeleted | BuildFailed | BuildCanceled- deriving (Eq, Enum, Show)--readBuildState :: Value -> BuildState-readBuildState (ValueInt i) | i `elem` map fromEnum (enumFrom BuildBuilding) = toEnum i-readBuildState _ = error "invalid build state"--kojiGetBuildState :: String -> BuildInfo -> IO (Maybe BuildState)-kojiGetBuildState hubUrl buildinfo =- ((fmap readBuildState . lookupStruct "state") =<<) <$>- getBuild hubUrl (buildInfo buildinfo)--data TaskState = TaskFree | TaskOpen | TaskClosed | TaskCanceled | TaskAssigned | TaskFailed- deriving (Eq, Enum, Show)--openTaskStates :: [TaskState]-openTaskStates = [TaskFree, TaskOpen, TaskAssigned]--openTaskValues :: Value-openTaskValues = ValueArray $ map taskStateToValue openTaskStates- where- taskStateToValue :: TaskState -> Value- taskStateToValue = ValueInt . fromEnum--readTaskState :: Value -> TaskState-readTaskState (ValueInt i) | i `elem` map fromEnum (enumFrom TaskFree) = toEnum i-readTaskState _ = error "invalid task state"--getTaskState :: Struct -> Maybe TaskState-getTaskState st = readTaskState <$> lookup "state" st--kojiGetTaskState :: String -> TaskID -> IO (Maybe TaskState)-kojiGetTaskState hubUrl tid = do- mti <- getTaskInfo hubUrl (getID tid) False- return $ case mti of- Nothing -> Nothing- Just ti -> readTaskState <$> lookupStruct "state" ti--kojiGetTaskInfo :: String- -> TaskID- -> IO (Maybe Struct)-kojiGetTaskInfo hubUrl tid = getTaskInfo hubUrl (getID tid) True- -- res <- kojiCall "getTaskInfo" [show taskid]- -- let state = res ^? key "state" % _Integer <&> (toEnum . fromInteger)- -- arch = res ^? key "arch" % _String- -- return $ TaskInfo arch state--kojiGetTaskChildren :: String -> TaskID -> Bool -> IO [Struct]-kojiGetTaskChildren hubUrl tid =- getTaskChildren hubUrl (getID tid)--kojiLatestBuild :: String -- ^ hub- -> String -- ^ tag- -> String -- ^ pkg- -> IO (Maybe Struct)-kojiLatestBuild hubUrl tag pkg =- listToMaybe <$> getLatestBuilds hubUrl (InfoString tag) Nothing (Just pkg) Nothing--kojiLatestBuildRepo :: String -- ^ hub- -> String -- ^ tag- -> Int -- ^ event- -> String -- ^ pkg- -> IO (Maybe Struct)-kojiLatestBuildRepo hubUrl tag event pkg =- listToMaybe <$> getLatestBuilds hubUrl (InfoString tag) (Just event) (Just pkg) Nothing--data KojiBuild- = KojiBuild- { kbBuildId :: Int- , kbPackageId :: Int- , kbOwnerName :: String- , kbNvr :: String- }- deriving (Show)--kojiListTaggedBuilds :: String -> Bool -> String -> IO [KojiBuild]-kojiListTaggedBuilds hubUrl latest tag =- mapMaybe readKojiBuild <$> listTagged hubUrl tag Nothing False Nothing latest Nothing Nothing Nothing- where- readKojiBuild :: Struct -> Maybe KojiBuild- readKojiBuild values = do- buildId <- lookupStruct "build_id" values- packageId <- lookupStruct "package_id" values- owner <- lookupStruct "owner_name" values- nvr <- lookupStruct "nvr" values- return $ KojiBuild buildId packageId owner nvr--kojiBuildTarget :: String -- ^ hubUrl- -> String -- ^ target- -> IO (Maybe (String, String)) -- ^ (build-tag,dest-tag)-kojiBuildTarget hub target = do- mres <- maybeStruct <$> getBuildTarget hub target- case mres of- Nothing -> return Nothing- Just res -> return $ readTarget res- where- readTarget res = do- buildtag <- lookupStruct "build_tag_name" res- desttag <- lookupStruct "dest_tag_name" res- return (buildtag, desttag)---- | List sidetags (preferably for user and/or basetag)-kojiListSideTags :: String -- ^ hubUrl- -> Maybe String -- ^ basetag- -> Maybe String -- ^ user- -> IO [String] -- ^ list of sidetags-kojiListSideTags hub mbasetag muser =- mapMaybe (lookupStruct "name") . structArray <$> listSideTags hub (InfoString <$> mbasetag) (InfoString <$> muser)--data RepoState = RepoInit | RepoReady | RepoExpired | RepoDeleted | RepoProblem- deriving (Eq, Enum, Show)--readRepoState :: Value -> RepoState-readRepoState (ValueInt i) | i `elem` map fromEnum (enumFrom RepoInit) = toEnum i-readRepoState _ = error "invalid repo state"---- getRepoState :: Struct -> Maybe RepoState--- getRepoState st = readRepoState <$> lookup "state" st--kojiGetRepo :: String -> String -> Maybe RepoState -> Maybe Int- -> IO (Maybe Struct)-kojiGetRepo hub tag mstate mevent =- maybeStruct <$> getRepo hub tag (fromEnum <$> mstate) mevent False--kojiGetCurrentRepo :: String -> String -> IO (Maybe Struct)-kojiGetCurrentRepo hub tag =- maybeStruct <$> getRepo hub tag Nothing Nothing False
− libs/koji-hs/src/Fedora/Koji/Internal.hs
@@ -1,824 +0,0 @@--- Note: much of this module is untested and experimental:--- particularly the functions just returning a Value--module Fedora.Koji.Internal- ( Info(..)- , koji- , hello- , checkTagAccess- , checkTagPackage- , getAPIVersion- , getActiveRepos- , getAllArches- , getAllPerms- , getArchive- , getArchiveFile- , getArchiveType- , getArchiveTypes- , getAverageBuildDuration- , getBuild- , getBuildConfig- , getBuildLogs- , getBuildTarget- , getBuildTargets- , getBuildType- , getBuildroot- , getBuildrootListing- , getChangelogEntries- , getChannel- , getEvent- , getExternalRepo- , getExternalRepoList- , getFullInheritance- , getGlobalInheritance- , getGroupMembers- , getHost- , getImageArchive- , getImageBuild- , getInheritanceData- , getLastEvent- , getLastHostUpdate- , getLatestBuilds- , getLatestMavenArchives- , getLatestRPMS- , getMavenArchive- , getMavenBuild- , getNextRelease- , getPackage- , getPackageConfig- , getPackageID- , getRPM- , getRPMDeps- , getRPMFile- , getRPMHeaders- , getRepo- , getTag- , getTagExternalRepos- , getTagGroups- , getTagID- , getTaskChildren- , getTaskDescendents- , getTaskInfo- , getTaskRequest- , getTaskResult- , getUser- , getUserPerms- , getVolume- , getWinArchive- , getWinBuild-- , listArchiveFiles- , listArchives- , listBTypes- , listBuildRPMs- , listBuildroots- , listBuilds- , listCGs- , listChannels- , listExternalRepos- , listHosts- , listPackages- , listPackagesSimple- , listRPMFiles- , listRPMs- , listSideTags- , listTagged- , listTaggedArchives- , listTaggedRPMS- , listTags- , listTaskOutput- , listTasks- , listUsers- , listVolumes-- , repoInfo- , resubmitTask- , tagChangedSinceEvent- , tagHistory- , taskFinished- , taskReport-- , Value(..)- , Struct- , lookupStruct--- , readStructString--- , readStructArray--- , readMethodParams- , maybeVal- , maybeStruct- , structArray- , getValue- )-where--import Data.Maybe---import Control.Monad.Fail (MonadFail)---import qualified Data.ByteString.Lazy.Char8 as B-import Network.XmlRpc.Client-import Network.XmlRpc.Internals---import Network.HTTP.Simple---import Network.HTTP.Client.Conduit-import Control.Monad.Except (runExceptT)--koji :: Remote a- => String -- ^ kojihub url- -> String -- ^ command- -> a-koji = remote---- xmlrpc :: String -> String -> [Value] -> IO Value--- xmlrpc url m args = do--- initreq <- parseRequest url--- let reqbody = renderCall (MethodCall m args)--- request = setRequestBody (RequestBodyLBS reqbody) $ setRequestMethod "POST" initreq--- resp <- httpLBS request--- let respbody = getResponseBody resp--- handleError fail $ (parseResponse (B.unpack respbody) >>= handleResponse)--- where--- -- | Gets the return value from a method response.--- -- Throws an exception if the response was a fault.--- handleResponse :: MonadFail m => MethodResponse -> m Value--- handleResponse (Return v) = return v--- handleResponse (Fault code str) = error ("Error " ++ show code ++ ": " ++ str)---- FIXME rename to newtype KojiStruct-type Struct = [(String,Value)]--maybeString :: Maybe String -> Value-maybeString = maybe ValueNil ValueString--maybeInt :: Maybe Int -> Value-maybeInt = maybe ValueNil ValueInt--maybeValue :: Maybe Value -> Value-maybeValue = fromMaybe ValueNil--data Info = InfoID Int | InfoString String--infoValue :: Info -> Value-infoValue (InfoID i) = ValueInt i-infoValue (InfoString s) = ValueString s--maybeInfo :: Maybe Info -> Value-maybeInfo = maybe ValueNil infoValue--maybeStruct :: Value -> Maybe Struct-maybeStruct (ValueStruct st) = Just st-maybeStruct _ = Nothing--structArray :: Value -> [Struct]-structArray (ValueArray v) = mapMaybe maybeStruct v-structArray _ = []---- https://koji.fedoraproject.org/koji/api---- CG*---- _listapi()---- add*---- applyVolumePolicy(build, strict=False)---- assignTask(task_id, host, force=False)---- build(src, target, opts=None, priority=None, channel=None)---- buildContainer(src, target, opts=None, priority=None, channel='container')---- buildImage(name, version, arch, target, ksfile, img_type, opts=None, priority=None)---- buildImageIndirection(opts=None, priority=None)---- buildImageOz(name, version, arches, target, inst_tree, opts=None, priority=None)---- buildReferences(build, limit=None, lazy=False)---- cancelBuild(buildID)---- cancelTask(task_id, recurse=True)---- cancelTaskChildren(task_id)---- cancelTaskFull(task_id, strict=True)---- chainBuild(srcs, target, opts=None, priority=None, channel=None)---- chainMaven(builds, target, opts=None, priority=None, channel='maven')---- changeBuildVolume(build, volume, strict=True)---- | checkTagAccess(tag_id, user_id=None)-checkTagAccess :: String -> Int -> Int -> IO Value-checkTagAccess hubUrl = koji hubUrl "checkTagAccess"---- | checkTagPackage(tag, pkg)-checkTagPackage :: String -> Info -> Info -> IO Bool-checkTagPackage hubUrl taginfo pkginfo = koji hubUrl "checkTagPackage" (infoValue taginfo) (infoValue pkginfo)---- count*---- create*---- debugFunction(name, *args, **kwargs)---- delete*---- disable*---- distRepo(tag, keys, **task_opts)---- downloadTaskOutput(taskID, fileName, offset=0, size=-1, volume=None)---- dropGroupMember(group, user)---- echo(*args)---- edit*---- enable*---- error---- filterResults(methodName, *args, **kw)---- findBuildID(X, strict=False)---- freeTask(task_id)---- | getAPIVersion()-getAPIVersion :: String -> IO String-getAPIVersion hubUrl = koji hubUrl "getAPIVersion"---- | getActiveRepos()-getActiveRepos :: String -> IO Value-getActiveRepos hubUrl = koji hubUrl "getActiveRepos"---- | getAllArches-getAllArches :: String -> IO Value-getAllArches hubUrl = koji hubUrl "getAllArches"---- | getAllPerms-getAllPerms :: String -> IO [Struct]-getAllPerms hubUrl = koji hubUrl "getAllPerms"---- | getArchive(archive_id, strict=False)-getArchive :: String -> Int -> IO (Maybe Struct)-getArchive hubUrl = fmap maybeStruct . koji hubUrl "getArchive"---- | getArchiveFile(archive_id, filename, strict=False)-getArchiveFile :: String -> Int -> FilePath -> IO (Maybe Struct)-getArchiveFile hubUrl archiveID file = maybeStruct <$> koji hubUrl "getArchiveFile" archiveID file---- | getArchiveType(filename=None, type_name=None, type_id=None, strict=False)-getArchiveType :: String -> Maybe FilePath -> Maybe String -> Maybe Int -> IO Value-getArchiveType hubUrl filename type_name type_id =- koji hubUrl "getArchiveType" (maybeString filename) (maybeString type_name) (maybeInt type_id)---- | getArchiveTypes()-getArchiveTypes :: String -> IO Value-getArchiveTypes hubUrl = koji hubUrl "getArchiveTypes"---- | getAverageBuildDuration pkginfo-getAverageBuildDuration :: String -> Info -> IO Value-getAverageBuildDuration hubUrl = koji hubUrl "getAverageBuildDuration" . infoValue---- | getBuild(buildInfo, strict=False)-getBuild :: String- -> Info -- ^ buildID- -> IO (Maybe Struct)-getBuild hubUrl = fmap maybeStruct . koji hubUrl "getBuild" . infoValue---- | getBuildConfig tag-getBuildConfig :: String -> String -> IO Value-getBuildConfig hubUrl = koji hubUrl "getBuildConfig"---- | getBuildLogs build-getBuildLogs :: String -> Info -- ^ buildinfo- -> IO Value-getBuildLogs hubUrl = koji hubUrl "getBuildLogs" . infoValue---- | getBuildTarget info-getBuildTarget :: String -> String -> IO Value-getBuildTarget hubUrl = koji hubUrl "getBuildTarget"---- | getBuildTargets info event buildTagID destTagID-getBuildTargets :: String -> Maybe Info -> Maybe Int -> Maybe Int -> Maybe Int -> IO Value-getBuildTargets hubUrl info event buildTagId destTagId =- koji hubUrl "getBuildTargets" (maybeInfo info) (maybeInt event) (maybeInt buildTagId) (maybeInt destTagId)---- | getBuildType buildinfo-getBuildType :: String -> Info -- ^ buildinfo- -> IO Value-getBuildType hubUrl = koji hubUrl "getBuildType" . infoValue---- | getBuildroot buildrootId-getBuildroot :: String -> Int -> IO Value-getBuildroot hubUrl = koji hubUrl "getBuildroot"---- | getBuildrootListing buildrootId-getBuildrootListing :: String -> Int -> IO Value-getBuildrootListing hubUrl = koji hubUrl "getBuildrootListing"---- | getChangelogEntries(buildID=None, taskID=None, filepath=None, author=None, before=None, after=None, queryOpts=None)-getChangelogEntries :: String- -> Maybe Int -- ^ buildID- -> Maybe Int -- ^ taskID- -> Maybe FilePath- -> Maybe String -- ^ author- -> Maybe String -- ^ before- -> Maybe String -- ^ after- -> IO [Struct]-getChangelogEntries hubUrl buildID taskID filepath author before after =- koji hubUrl "getChangelogEntries" (maybeInt buildID) (maybeInt taskID) (maybeString filepath) (maybeString author) (maybeString before) (maybeString after)---- | getChannel channelinfo-getChannel :: String -> Info -> IO Value-getChannel hubUrl = koji hubUrl "getChannel" . infoValue---- | getEvent eventid-getEvent :: String -> Int -> IO Struct-getEvent hubUrl = koji hubUrl "getEvent"---- | getExternalRepo info-getExternalRepo :: String -> Info -> Maybe Int -> IO Struct-getExternalRepo hubUrl info event =- koji hubUrl "getExternalRepo" (infoValue info) () (maybeInt event)---- | getExternalRepoList(tag_info, event=None)-getExternalRepoList :: String -> Info -> Maybe Int -> IO [Struct]-getExternalRepoList hubUrl info event =- koji hubUrl "getExternalRepoList" (infoValue info) (maybeInt event)---- | getFullInheritance(tag, event=None, reverse=False, stops=None, jumps=None)-getFullInheritance :: String -> String -> Maybe Int -> Bool -> IO Value-getFullInheritance hubUrl tag event =- koji hubUrl "getFullInheritance" tag (maybeInt event)---- | getGlobalInheritance(event=None)-getGlobalInheritance :: String -> Maybe Int -> IO Value-getGlobalInheritance hubUrl = koji hubUrl "getGlobalInheritance" . maybeInt---- | getGroupMembers(group)-getGroupMembers :: String -> String -> IO Value-getGroupMembers hubUrl = koji hubUrl "getGroupMembers"---- | getHost(hostInfo, strict=False, event=None)-getHost :: String -> Info -> Maybe Int -> IO Struct-getHost hubUrl info = koji hubUrl "getHost" (infoValue info) () . maybeInt---- | getImageArchive(archive_id, strict=False)-getImageArchive :: String -> Int -> IO Struct-getImageArchive hubUrl = koji hubUrl "getImageArchive"---- | getImageBuild(buildInfo, strict=False)-getImageBuild :: String -> Info -> IO Struct-getImageBuild hubUrl info = koji hubUrl "getImageBuild" (infoValue info)---- | getInheritanceData(tag, event=None)-getInheritanceData :: String -> String -> Maybe Int -> IO Value-getInheritanceData hubUrl tag event =- koji hubUrl "getInheritanceData" tag (maybeInt event)----- | getLastEvent(before=None)-getLastEvent :: String -> Maybe Int -> IO Value-getLastEvent hubUrl = koji hubUrl "getLastEvent" . maybeInt---- | getLastHostUpdate(hostID)-getLastHostUpdate :: String -> Int -> IO Value-getLastHostUpdate hubUrl = koji hubUrl "getLastHostUpdate"---- | getLatestBuilds(tag, event=None, package=None, type=None)------ List latest builds for tag (inheritance enabled)-getLatestBuilds :: String- -> Info -- ^ tag- -> Maybe Int -- ^ event- -> Maybe String -- ^ pkg- -> Maybe String -- ^ type- -> IO [Struct]-getLatestBuilds hubUrl tag event pkg type_ =- koji hubUrl "getLatestBuilds" (infoValue tag) (maybeInt event) (maybeString pkg) (maybeString type_)---- | getLatestMavenArchives(tag, event=None, inherit=True)-getLatestMavenArchives :: String -> String -> Maybe Int -> Bool -> IO Value-getLatestMavenArchives hubUrl tag event =- koji hubUrl "getLatestMavenArchives" tag (maybeInt event)---- | getLatestRPMS(tag, package=None, arch=None, event=None, rpmsigs=False, type=None)-getLatestRPMS :: String -> String -> Maybe String -> Maybe String -> Maybe Int -> Bool -> Maybe String -> IO Value-getLatestRPMS hubUrl tag pkg arch event rpmsigs type_ =- koji hubUrl "getLatestRPMS" tag (maybeString pkg) (maybeString arch) (maybeInt event) rpmsigs (maybeString type_)---- getLoggedInUser()---- | getMavenArchive(archive_id, strict=False)-getMavenArchive :: String -> Int -> IO Struct-getMavenArchive hubUrl = koji hubUrl "getMavenArchive"---- | getMavenBuild(buildInfo, strict=False)-getMavenBuild :: String -> Info -> IO Struct-getMavenBuild hubUrl info = koji hubUrl "getMavenBuild" (infoValue info)---- | getNextRelease(build_info)------ find the last successful or deleted build of this N-V.--- If building is specified, skip also builds in progress-getNextRelease :: String -> Info -> IO Value-getNextRelease hubUrl info = koji hubUrl "getNextRelease" (infoValue info)---- | getPackage(info, strict=False, create=False)------ Get the id,name for package-getPackage :: String -> Info -> IO Value-getPackage hubUrl info = koji hubUrl "getPackage" (infoValue info)---- | getPackageConfig(tag, pkg, event=None)------ Get config for package in tag-getPackageConfig :: String -> String -> String -> Maybe Int -> IO Value-getPackageConfig hubUrl tag pkg event =- koji hubUrl "getPackageConfig" tag pkg (maybeInt event)---- | getPackageID(name, strict=False)------ Get package ID by name.-getPackageID :: String -> String -> IO (Maybe Int)-getPackageID hubUrl pkg = do- res <- koji hubUrl "getPackageID" pkg- case res of- ValueInt i -> return $ Just i- _ -> return Nothing---- | getRPM(rpminfo, strict=False, multi=False)-getRPM :: String -> Info -> IO Struct-getRPM hubUrl = koji hubUrl "getRPM" . infoValue---- | getRPMDeps(rpmID, depType=None, queryOpts=None, strict=False)-getRPMDeps :: String -> Int -> Maybe String -> IO [Struct]-getRPMDeps hubUrl rpmid deptype =- koji hubUrl "getRPMDeps" rpmid (maybeString deptype)---- | getRPMFile(rpmID, filename, strict=False)-getRPMFile :: String -> Int -> FilePath -> IO Struct-getRPMFile hubUrl = koji hubUrl "getRPMFile"---- | getRPMHeaders(rpmID=None, taskID=None, filepath=None, headers=None)-getRPMHeaders :: String -> Maybe Int -> Maybe Int -> Maybe FilePath -> Maybe Value -> IO Struct-getRPMHeaders hubUrl rpmid taskid file headers =- koji hubUrl "getRPMHeaders" (maybeInt rpmid) (maybeInt taskid) (maybeString file) (fromMaybe ValueNil headers)---- | getRepo(tag, state=None, event=None, dist=False)-getRepo :: String -> String -> Maybe Int -> Maybe Int -> Bool -> IO Value-getRepo hubUrl tag state event =- koji hubUrl "getRepo" tag (maybeInt state) (maybeInt event)---- getSessionInfo()---- | getTag(tagInfo, strict=False, event=None)-getTag :: String -> Info -> Maybe Int -> IO Struct-getTag hubUrl info = koji hubUrl "getTag" (infoValue info) () . maybeInt---- | getTagExternalRepos(tag_info=None, repo_info=None, event=None)-getTagExternalRepos :: String -> Maybe Info -> Maybe Info -> Maybe Int -> IO Struct-getTagExternalRepos hubUrl taginfo repoinfo event =- koji hubUrl "getTagExternalRepos" (maybeInfo taginfo) (maybeInfo repoinfo) (maybeInt event)---- | getTagGroups(tag, event=None, inherit=True, incl_pkgs=True, incl_reqs=True, incl_blocked=False)-getTagGroups :: String -> String -> Maybe Int -> Bool -> Bool -> Bool -> Bool -> IO Value-getTagGroups hubUrl tag event =- koji hubUrl "getTagGroups" tag (maybeInt event)---- | getTagID(info, strict=False, create=False)-getTagID :: String -> Info -> IO Value-getTagID hubUrl = koji hubUrl "getTagID" . infoValue---- | getTaskChildren(task_id, request=False, strict=False)-getTaskChildren :: String -> Int -> Bool -> IO [Struct]-getTaskChildren hubUrl = koji hubUrl "getTaskChildren"---- | getTaskDescendents(task_id, request=False)-getTaskDescendents :: String -> Int -> Bool -> IO Struct-getTaskDescendents hubUrl = koji hubUrl "getTaskDescendents"---- | getTaskInfo(task_id, request=False, strict=False)-getTaskInfo :: String- -> Int- -> Bool -- ^ include request details- -> IO (Maybe Struct)-getTaskInfo hubUrl tid request = maybeStruct <$> koji hubUrl "getTaskInfo" tid request- -- res <- kojiCall "getTaskInfo" [show taskid]- -- let state = res ^? key "state" % _Integer <&> (toEnum . fromInteger)- -- arch = res ^? key "arch" % _String- -- return $ TaskInfo arch state---- | getTaskRequest(taskId)-getTaskRequest :: String -> Int -> IO Value-getTaskRequest hubUrl = koji hubUrl "getTaskRequest"---- | getTaskResult(taskId, raise_fault=True)-getTaskResult :: String -> Int -> IO Value-getTaskResult hubUrl = koji hubUrl "getTaskResult"---- | getUser(userInfo=None, strict=False, krb_princs=True)-getUser :: String -> Info -> Bool -> IO (Maybe Struct)-getUser hubUrl info krbprncpl =- maybeStruct <$> koji hubUrl "getUser" (infoValue info) () krbprncpl---- | getUserPerms(userID=None)-getUserPerms :: String -> Maybe Info -> IO Value-getUserPerms hubUrl = koji hubUrl "getUserPerms" . maybeInfo---- | getVolume(volume, strict=False)-getVolume :: String -> Info -> IO Value-getVolume hubUrl = koji hubUrl "getVolume" . infoValue---- | getWinArchive(archive_id, strict=False)-getWinArchive :: String -> Int -> IO Struct-getWinArchive hubUrl = koji hubUrl "getWinArchive"---- | getWinBuild(buildInfo, strict=False)-getWinBuild :: String -> Info -> IO (Maybe Struct)-getWinBuild hubUrl = fmap maybeStruct . koji hubUrl "getWinBuild" . infoValue---- grantCGAccess(user, cg, create=False)---- grantPermission(userinfo, permission, create=False)---- groupListAdd(taginfo, grpinfo, block=False, force=False, **opts)---- groupListBlock(taginfo, grpinfo)---- groupListRemove(taginfo, grpinfo, force=False)---- groupListUnblock(taginfo, grpinfo)---- groupPackageListAdd(taginfo, grpinfo, pkg_name, block=False, force=False, **opts)---- groupPackageListBlock(taginfo, grpinfo, pkg_name)---- groupPackageListRemove(taginfo, grpinfo, pkg_name, force=False)---- groupReqListUnblock(taginfo, grpinfo, reqinfo)---- hasPerm(perm, strict=False)--hello :: String -> IO String-hello hubUrl = koji hubUrl "hello"---- host.* [skipped]---- importArchive(filepath, buildinfo, type, typeInfo)---- importRPM(path, basename)---- krbLogin(*args, **opts)---- | listArchiveFiles(archive_id, queryOpts=None, strict=False)-listArchiveFiles :: String -> Int -> IO [Struct]-listArchiveFiles hubUrl = koji hubUrl "listArchiveFiles"---- | listArchives(buildID=None, buildrootID=None, componentBuildrootID=None, hostID=None, type=None, filename=None, size=None, checksum=None, typeInfo=None, queryOpts=None, imageID=None, archiveID=None, strict=False)-listArchives :: String -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe String -> Maybe FilePath -> Maybe Int -> Maybe String -> Maybe Info -> Maybe Int -> Maybe Int -> IO [Struct]-listArchives hubUrl buildID buildrootID componentBuildrootID hostID type_ file size checksum typeInfo imageID archiveID =- koji hubUrl "listArchives" (maybeInt buildID) (maybeInt buildrootID) (maybeInt componentBuildrootID) (maybeInt hostID) (maybeString type_) (maybeString file) (maybeInt size) (maybeString checksum) (maybeInfo typeInfo) () (maybeInt imageID) (maybeInt archiveID)---- | listBTypes(query=None, queryOpts=None)-listBTypes :: String -> Value -> IO Value-listBTypes hubUrl = koji hubUrl "listBTypes"---- | listBuildRPMs(build)-listBuildRPMs :: String -> Int -> IO [Struct]-listBuildRPMs hubUrl = koji hubUrl "listBuildRPMs"---- | listBuildroots(hostID=None, tagID=None, state=None, rpmID=None, archiveID=None, taskID=None, buildrootID=None, queryOpts=None)-listBuildroots :: String -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> IO Value-listBuildroots hubUrl hostID tagID state rpmID archiveID taskID buildrootID =- koji hubUrl "listBuildroots" (maybeInt hostID) (maybeInt tagID) (maybeInt state) (maybeInt rpmID) (maybeInt archiveID) (maybeInt taskID) (maybeInt buildrootID)---- | listBuilds (packageID=None, userID=None, taskID=None, prefix=None, state=None, volumeID=None, source=None, createdBefore=None, createdAfter=None, completeBefore=None, completeAfter=None, type=None, typeInfo=None, queryOpts=None)-listBuilds :: String -> Struct -> IO [Struct]-listBuilds hubUrl args =- let maybeArg fld = maybeValue (lookupStruct fld args) in- koji hubUrl "listBuilds" (maybeArg "packageID") (maybeArg "userID") (maybeArg "taskID") (maybeArg "prefix") (maybeArg "state") (maybeArg "volumeID") (maybeArg "source") (maybeArg "createdBefore") (maybeArg "createdAfter") (maybeArg "completeBefore") (maybeArg "completeAfter") (maybeArg "type") (maybeArg "typeInfo") (maybeArg "queryOpts")---- | listCGs()-listCGs :: String -> IO Struct-listCGs hubUrl = koji hubUrl "listCGs"---- | listChannels(hostID=None, event=None)-listChannels :: String -> Maybe Int -> Maybe Int -> IO Value-listChannels hubUrl hostID event =- koji hubUrl "listChannels" (maybeInt hostID) (maybeInt event)---- | listExternalRepos(info=None, url=None, event=None, queryOpts=None)-listExternalRepos :: String -> Maybe Info -> Maybe String -> Maybe Int -> IO Value-listExternalRepos hubUrl info url event =- koji hubUrl "listExternalRepos" (maybeInfo info) (maybeString url) (maybeInt event)---- | listHosts(arches=None, channelID=None, ready=None, enabled=None, userID=None, queryOpts=None)-listHosts :: String -> Maybe Value -> Maybe Int -> Bool -> Bool -> Maybe Int -> IO Value-listHosts hubUrl arches channelID ready enabled userID =- koji hubUrl "listHosts" (maybeValue arches) (maybeInt channelID) ready enabled (maybeInt userID)---- | listPackages(tagID=None, userID=None, pkgID=None, prefix=None, inherited=False, with_dups=False, event=None, queryOpts=None)-listPackages :: String -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe String -> Bool -> Bool -> Maybe Int -> IO [Struct]-listPackages hubUrl tagID userID pkgID prefix inherited with_dups event =- koji hubUrl "listPackages" (maybeInt tagID) (maybeInt userID) (maybeInt pkgID) (maybeString prefix) inherited with_dups (maybeInt event)---- | listPackagesSimple prefix-listPackagesSimple :: String -> String -- ^ package name search prefix- -> IO [Struct]-listPackagesSimple hubUrl = koji hubUrl "listPackagesSimple"---- | listRPMFiles(rpmID, queryOpts=None)-listRPMFiles :: String -> Int -> IO [Struct]-listRPMFiles hubUrl = koji hubUrl "listRPMFiles"---- | listRPMs(buildID=None, buildrootID=None, imageID=None, componentBuildrootID=None, hostID=None, arches=None, queryOpts=None)-listRPMs :: String -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Value -> IO [Struct]-listRPMs hubUrl buildID buildrootID imageID componentBuildrootID hostID arches =- koji hubUrl "listRPMs" (maybeInt buildID) (maybeInt buildrootID) (maybeInt imageID) (maybeInt componentBuildrootID) (maybeInt hostID) (maybeValue arches)---- | listSideTags(basetag=None, user=None, queryOpts=None)-listSideTags :: String -> Maybe Info -> Maybe Info -> IO Value-listSideTags hubUrl basetag user = do- koji hubUrl "listSideTags" (maybeInfo basetag) (maybeInfo user)---- | listTagged(tag, event=None, inherit=False, prefix=None, latest=False, package=None, owner=None, type=None)-listTagged :: String -> String -> Maybe Int -> Bool -> Maybe String -> Bool -> Maybe String -> Maybe String -> Maybe String -> IO [Struct]-listTagged hubUrl tag event inherit prefix latest package owner type_ =- koji hubUrl "listTagged" tag (maybeInt event) inherit (maybeString prefix) latest (maybeString package) (maybeString owner) (maybeString type_)---- | listTaggedArchives(tag, event=None, inherit=False, latest=False, package=None, type=None)-listTaggedArchives :: String -> String -> Maybe Int -> Bool -> Bool -> Maybe String -> Maybe String -> IO Value-listTaggedArchives hubUrl tag event inherit latest package type_ =- koji hubUrl "listTaggedArchives" tag (maybeInt event) inherit latest (maybeString package) (maybeString type_)---- | listTaggedRPMS(tag, event=None, inherit=False, latest=False, package=None, arch=None, rpmsigs=False, owner=None, type=None)-listTaggedRPMS :: String -> String -> Maybe Int -> Bool -> Bool -> Maybe String -> Maybe String -> Bool -> Maybe String -> Maybe String -> IO Value-listTaggedRPMS hubUrl tag event inherit latest package arch rpmsigs owner type_ =- koji hubUrl "listTaggedRPMS" tag (maybeInt event) inherit latest (maybeString package) (maybeString arch) rpmsigs (maybeString owner) (maybeString type_)---- | listTags(build=None, package=None, perms=True, queryOpts=None)-listTags :: String -> Maybe Info -> Maybe Info -> Bool -> IO [Struct]-listTags hubUrl build package =- koji hubUrl "listTags" (maybeInfo build) (maybeInfo package)---- | listTaskOutput(taskID, stat=False, all_volumes=False, strict=False)-listTaskOutput :: String -> Int -> Bool -> Bool -> Bool -> IO Struct-listTaskOutput hubUrl = koji hubUrl "listTaskOutput"---- | listTasks(opts=None, queryOpts=None)-listTasks :: String -> Struct -- ^ opts- -> Struct -- ^ qopts- -> IO [Struct]-listTasks hubUrl = koji hubUrl "listTasks"---- | listUsers(userType=0, prefix=None, queryOpts=None)-listUsers :: String -> Maybe Int -> Maybe String -> IO [Struct]-listUsers hubUrl userType prefix =- koji hubUrl "listUsers" (maybeInt userType) (maybeString prefix)---- | listVolumes()-listVolumes :: String -> IO Value-listVolumes hubUrl = koji hubUrl "listVolumes"---- login(*args, **opts)---- logout()---- logoutChild(session_id)---- makeTask(*args, **opts)---- mavenBuild(url, target, opts=None, priority=None, channel='maven')---- mavenEnabled()---- mergeScratch(task_id)---- moveAllBuilds(tag1, tag2, package, force=False)---- moveBuild(tag1, tag2, build, force=False)---- newGroup(name)---- newRepo(tag, event=None, src=False, debuginfo=False, separate_src=False)---- packageListAdd(taginfo, pkginfo, owner=None, block=None, extra_arches=None, force=False, update=False)---- packageListBlock(taginfo, pkginfo, force=False)---- packageListRemove(taginfo, pkginfo, force=False)---- packageListSetArches(taginfo, pkginfo, arches, force=False)---- packageListSetOwner(taginfo, pkginfo, owner, force=False)---- packageListUnblock(taginfo, pkginfo, force=False)---- queryHistory(tables=None, **kwargs)---- queryRPMSigs(rpm_id=None, sigkey=None, queryOpts=None)---- remove*---- repo*---- | repoInfo(repo_id, strict=False)-repoInfo :: String -> Int -> IO Value-repoInfo hubUrl = koji hubUrl "repoInfo"---- resetBuild(build)---- restartHosts(priority=5, options=None)---- | resubmitTask(taskID)-resubmitTask :: String -> Int -> IO Value-resubmitTask hubUrl = koji hubUrl "resubmitTask"---- revoke*---- runroot(tagInfo, arch, command, channel=None, **opts)---- search(terms, type, matchType, queryOpts=None)---- set*---- sharedSession()---- showOpts()---- showSession()---- sslLogin(*args, **opts)---- subsession()---- system.*---- tagBuild(tag, build, force=False, fromtag=None)---- tagBuildBypass(tag, build, force=False, notify=True)---- | tagChangedSinceEvent(event, taglist)-tagChangedSinceEvent :: String -> Int -> Value -> IO Bool-tagChangedSinceEvent hubUrl = koji hubUrl "tagChangedSinceEvent"---- | tagHistory(build=None, tag=None, package=None, active=None, queryOpts=None)-tagHistory :: String -> Maybe Info -> Maybe Info -> Maybe Info -> Bool -> IO Value-tagHistory hubUrl build tag package =- koji hubUrl "tagHistory" (maybeInfo build) (maybeInfo tag) (maybeInfo package)---- | taskFinished(taskId)-taskFinished :: String -> Int -> IO Bool-taskFinished hubUrl = koji hubUrl "taskFinished"---- | taskReport(owner=None)-taskReport :: String -> Maybe String -> IO Value-taskReport hubUrl = koji hubUrl "taskReport" . maybeString---- untag*---- updateNotification(id, package_id, tag_id, success_only)---- uploadFile(path, name, size, md5sum, offset, data, volume=None)---- winBuild(vm, url, target, opts=None, priority=None, channel='vm')---- winEnabled()---- wrapperRPM(build, url, target, priority=None, channel='maven', opts=None)---- writeSignedRPM(an_rpm, sigkey, force=False)----- readStructString :: String -> Struct -> String--- readStructString key str =--- case lookup key str of--- Just (ValueString s) -> s--- _ -> error $ "No String for " ++ key---- readStructArray :: String -> Struct -> Maybe [Value]--- readStructArray key struct =--- either error id <$> runExceptT (getField key struct)--- -- Just (ValueArray s) -> s--- -- _ -> error $ "No Array for " ++ key---- readMethodParams :: String -> Maybe [Value]--- readMethodParams s =--- either error params <$> runExceptT (parseCall s)--- where--- params (MethodCall _m str) = str--lookupStruct :: XmlRpcType a => String -> Struct -> Maybe a-lookupStruct key struct =- either error id <$> runExceptT (getField key struct)--maybeVal :: String -> Maybe a -> a-maybeVal err = fromMaybe (error err)--getValue :: XmlRpcType a => Value -> Maybe a-getValue = fmap (either error id) . runExceptT . fromValue
src/Bodhi.hs view
@@ -38,11 +38,11 @@ -- FIXME should determine 3 days for branched devel release -- FIXME handle expired override?-bodhiCreateOverride :: Bool -> String -> IO ()-bodhiCreateOverride dryrun nvr = do+bodhiCreateOverride :: Bool -> Maybe Int -> String -> IO ()+bodhiCreateOverride dryrun mduration nvr = do putStrLn $ "Creating Bodhi Override for " ++ nvr ++ ":" unless dryrun $ do- ok <- cmdBool "bodhi" ["overrides", "save", "--notes", "chain building with fbrnch", "--duration", "4", nvr]+ ok <- cmdBool "bodhi" ["overrides", "save", "--notes", "chain building with fbrnch", "--duration", show (fromMaybe 4 mduration), "--no-wait", nvr] if ok then putStrLn $ "https://bodhi.fedoraproject.org/overrides/" ++ nvr else do@@ -51,7 +51,7 @@ Nothing -> do putStrLn "bodhi override failed" prompt_ "Press Enter to retry"- bodhiCreateOverride dryrun nvr+ bodhiCreateOverride dryrun mduration nvr -- FIXME prettyprint Just obj -> error' $ show obj
src/Branches.hs view
@@ -81,11 +81,15 @@ isEPELBranch (EPEL _) = True isEPELBranch _ = False --- FIXME misnamed-localBranches :: IO [String]-localBranches = do- origins <- filter ("origin/" `isPrefixOf`) <$> cmdLines "git" ["branch", "--remote", "--list", "--format=%(refname:lstrip=-2)"]- return $ map (removePrefix "origin/") origins \\ ["HEAD", "master"]+localBranches :: Bool -> IO [String]+localBranches local =+ if local+ then do+ locals <- cmdLines "git" ["branch", "--list", "--format=%(refname:lstrip=-1)"]+ return $ locals \\ ["HEAD", "master"]+ else do+ origins <- filter ("origin/" `isPrefixOf`) <$> cmdLines "git" ["branch", "--remote", "--list", "--format=%(refname:lstrip=-2)"]+ return $ map (removePrefix "origin/") origins \\ ["HEAD", "master"] pagurePkgBranches :: String -> IO [String] pagurePkgBranches pkg = do@@ -116,19 +120,19 @@ listOfBranches :: Bool -> Bool -> BranchesReq -> IO [Branch] listOfBranches distgit _active (BranchOpt AllBranches) = if distgit- then fedoraBranches localBranches+ then fedoraBranches (localBranches False) else error' "--all-branches only allowed for dist-git packages" listOfBranches distgit _active (BranchOpt AllFedora) = if distgit- then filter isFedoraBranch <$> fedoraBranches localBranches+ then filter isFedoraBranch <$> fedoraBranches (localBranches False) else error' "--all-fedora only allowed for dist-git packages" listOfBranches distgit _active (BranchOpt AllEPEL) = if distgit- then filter isEPELBranch <$> fedoraBranches localBranches+ then filter isEPELBranch <$> fedoraBranches (localBranches False) else error' "--all-epel only allowed for dist-git packages" listOfBranches distgit _ (BranchOpt (ExcludeBranches brs)) = do branches <- if distgit- then fedoraBranches localBranches+ then fedoraBranches (localBranches False) else getFedoraBranches return $ branches \\ brs listOfBranches distgit active (Branches brs) =@@ -182,7 +186,7 @@ active <- getFedoraBranched case breq of Branches brs -> if null brs- then branchingPrompt+ then branchingPrompt active else return brs BranchOpt request -> do let requested = case request of@@ -195,17 +199,19 @@ then requested else map (readActiveBranch' active) $ words inp where- branchingPrompt :: IO [Branch]- branchingPrompt = do- -- FIXME default may be wrong now- inp <- prompt "Enter required branches [default: latest 2]"+ branchingPrompt :: [Branch] -> IO [Branch]+ branchingPrompt active = do+ inp <- prompt "Enter required branches [default: latest 2], or no/none" if null inp+ then return $ take 2 active+ else+ if lower (trim inp) `elem` ["no", "none"] then return [] else- let abrs = map anyBranch $ words inp- in if all isRelBranch abrs- then return $ map onlyRelBranch abrs- else branchingPrompt+ let abrs = map anyBranch $ words inp+ in if all isRelBranch abrs+ then return $ map onlyRelBranch abrs+ else branchingPrompt active data BranchesReq = BranchOpt BranchOpts | Branches [Branch]
src/Cmd/Build.hs view
@@ -23,7 +23,7 @@ import Prompt data BuildOpts = BuildOpts- { buildoptNoPrompt :: Bool+ { buildoptMerge :: Maybe Bool , buildoptNoFailFast :: Bool , buildoptTarget :: Maybe String , buildoptOverride :: Bool@@ -33,11 +33,11 @@ -- FIXME --add-to-update nvr -- FIXME vertical vs horizontal builds (ie by package or branch)--- FIXME --rpmlint (only run for master?)+-- FIXME --rpmlint (only run for rawhide?) -- FIXME support --wait-build=NVR -- FIXME provide direct link to failed task/build.log--- FIXME default behaviour for build in pkg dir: all branches or current? -- FIXME --auto-override for deps in testing+-- FIXME -B fails to find new branches buildCmd :: BuildOpts -> (BranchesReq, [String]) -> IO () buildCmd opts (breq, pkgs) = do let singleBrnch = if isJust (buildoptTarget opts)@@ -54,15 +54,19 @@ error' "build only defined for release branches" buildBranch mlastpkg opts pkg rbr@(RelBranch br) = do gitSwitchBranch rbr- gitMergeOrigin rbr+ gitMergeOrigin br newrepo <- initialPkgRepo tty <- isTty (ancestor,unmerged) <- mergeable br -- FIXME if already built or failed, also offer merge merged <-- if buildoptNoPrompt opts || newrepo || tty- then mergeBranch True (buildoptNoPrompt opts) (ancestor,unmerged) br >> return True- else return False+ case buildoptMerge opts of+ Just False -> return False+ Just True -> mergeBranch True True (ancestor,unmerged) br >> return True+ Nothing ->+ if newrepo || tty+ then mergeBranch True False (ancestor,unmerged) br >> return True+ else return False let spec = packageSpec pkg checkForSpecFile spec checkSourcesMatch spec@@ -82,7 +86,7 @@ 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 let dryrun = buildoptDryrun opts- buildstatus <- kojiBuildStatus nvr+ buildstatus <- maybeTimeout 30 $ kojiBuildStatus nvr let mtarget = buildoptTarget opts target = fromMaybe (branchTarget br) mtarget case buildstatus of@@ -91,7 +95,7 @@ when (isJust mpush) $ error' "Please bump the spec file" when (br /= Rawhide && isNothing mtarget) $ do- tags <- kojiNVRTags nvr+ tags <- maybeTimeout 30 $ kojiNVRTags nvr 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@@ -99,7 +103,7 @@ bodhiUpdate dryrun mbug spec nvr unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $ when (buildoptOverride opts) $- bodhiCreateOverride dryrun nvr+ bodhiCreateOverride dryrun Nothing nvr when (isJust mlastpkg && mlastpkg /= Just pkg) $ when (buildoptOverride opts || autoupdate) $ kojiWaitRepo dryrun target nvr@@ -111,7 +115,7 @@ -- FIXME do override _ -> do mbuildref <- case mpush of- Nothing -> Just <$> git "show-ref" ["--hash", "origin" </> show br]+ Nothing -> Just <$> git "show-ref" ["--hash", "origin/" ++ show br] _ -> return $ join mpush opentasks <- kojiOpenTasks pkg mbuildref target case opentasks of@@ -145,7 +149,7 @@ whenJust mpush $ \ mref -> unless dryrun $ gitPushSilent $ fmap (++ ":" ++ show br) mref- unlessM (null <$> gitShortLog ("origin" </> show br ++ "..HEAD")) $+ unlessM (null <$> gitShortLog ("origin/" ++ show br ++ "..HEAD")) $ when (mpush == Just Nothing && not dryrun) $ error' "Unpushed changes remain" unlessM isGitDirClean $@@ -171,7 +175,7 @@ bodhiUpdate dryrun (fmap fst mBugSess) spec nvr -- FIXME prompt for override note when (buildoptOverride opts) $- bodhiCreateOverride dryrun nvr+ bodhiCreateOverride dryrun Nothing nvr when (isJust mlastpkg && mlastpkg /= Just pkg) $ when (buildoptOverride opts || autoupdate) $ kojiWaitRepo dryrun target nvr
src/Cmd/Copr.hs view
@@ -14,8 +14,11 @@ import Package import Data.Ini.Config+import Network.HTTP.Query (lookupKey, lookupKey') import System.Environment.XDG.BaseDir (getUserConfigDir)-import Web.Fedora.Copr (coprChroots)+import System.Time.Extra (sleep)+import Web.Fedora.Copr (coprChroots, fedoraCopr)+import Web.Fedora.Copr.API (coprGetBuild) data BuildBy = SingleBuild | ValidateByRelease | ValidateByArch | BuildByRelease deriving (Eq)@@ -141,16 +144,37 @@ unless dryrun $ do output <- cmd "copr" buildargs putStrLn output- let bid = last $ words $ last $ lines output- ok <- cmdBool "copr" ["watch-build", bid]+ let bid = read $ last $ words $ last $ lines output+ ok <- coprWatchBuild bid Nothing unless ok $ error' $ "Failed: copr " ++ unwords buildargs -#if !MIN_VERSION_simple_cmd(0,1,4)-error' :: String -> a-#if MIN_VERSION_base(4,9,0)-error' = errorWithoutStackTrace-#else-error' = error-#endif-#endif+-- FIXME idea: Maybe Seconds to increment sleep+coprWatchBuild :: Int -> Maybe String -> IO Bool+coprWatchBuild bid mstate = do+ res <- coprGetBuild fedoraCopr bid+ case lookupKey "state" res of+ Just state ->+ if mstate == Just state+ then sleep 20 >> coprWatchBuild bid mstate+ else do+ logMsg $ "Build " ++ show bid ++ " " ++ state+ case state of+ "succeeded" -> return True+ "skipped" -> return True+ "canceled" -> return False+ "failed" -> return False+ _ -> sleep 1 >> coprWatchBuild bid (Just state)+ Nothing -> do+ let err = lookupKey' "error" res+ logMsg $ "Error: " ++ err+ return False++-- #if !MIN_VERSION_simple_cmd(0,1,4)+-- error' :: String -> a+-- #if MIN_VERSION_base(4,9,0)+-- error' = errorWithoutStackTrace+-- #else+-- error' = error+-- #endif+-- #endif
src/Cmd/Diff.hs view
@@ -20,8 +20,8 @@ -- FIXME diff other branches without switching -- FIXME --older/--newer branch-diffCmd :: Bool -> DiffWork -> DiffFormat -> Maybe AnyBranch -> Maybe Branch- -> [String] -> IO ()+diffCmd :: Bool -> DiffWork -> DiffFormat -> Maybe AnyBranch+ -> (Maybe Branch,[String]) -> IO () diffCmd speconly work fmt mwbr = withPackagesMaybeBranch Nothing dirtyGit ZeroOrOne diffPkg where
src/Cmd/Import.hs view
@@ -37,7 +37,7 @@ clonePkg True Nothing pkg putStrLn "" setCurrentDirectory pkg- -- FIXME: check branch is master+ -- FIXME: check branch is rawhide unlessM isGitRepo $ error' "Not a git repo" newrepo <- initialPkgRepo if not newrepo@@ -46,9 +46,9 @@ checkWorkingDirClean -- FIXME get session from importPkgs (bid,session) <- approvedReviewBugIdSession pkg- comments <- getComments session bid putBugId bid putStrLn ""+ comments <- getComments session bid mapM_ showComment comments putStrLn "" putStr "Review bug: "@@ -74,7 +74,7 @@ -- FIXME build more branches kojiBuildBranch "rawhide" (Package pkg) Nothing ["--fail-fast"] putBugBuild False session bid nvr- existing <- fedoraBranchesNoRawhide localBranches+ existing <- fedoraBranchesNoRawhide (localBranches False) when (null existing) $ do brs <- getRequestedBranches breq requestPkgBranches mock (Branches brs) (Package pkg)
src/Cmd/Install.hs view
@@ -6,19 +6,23 @@ import Branches import Common import Common.System+import Git import Package -- FIXME package countdown -- FIXME --ignore-uninstalled subpackages+-- FIXME --skip-unavailable -- FIXME --check any/all of package installed-installCmd :: Bool -> Maybe ForceShort -> [BCond] -> Bool -> Maybe Branch -> [String] -> IO ()-installCmd recurse mforceshort bconds reinstall mbr pkgs = do- when (recurse && isJust mforceshort) $+installCmd :: Bool -> Maybe ForceShort -> [BCond] -> Bool+ -> (Maybe Branch,[String]) -> IO ()+installCmd recurse mforceshort bconds reinstall (mbr, pkgs) = do+ when (recurse && mforceshort == Just ShortCircuit) $ error' "cannot use --recurse and --shortcircuit"- withPackagesMaybeBranch Nothing Nothing ZeroOrOne installPkg mbr pkgs+ withPackagesMaybeBranch Nothing Nothing ZeroOrOne installPkg (mbr, pkgs) where installPkg :: Package -> AnyBranch -> IO () installPkg pkg br = do+ whenJust mbr $ gitSwitchBranch . RelBranch spec <- localBranchSpecFile pkg br rpms <- builtRpms br spec -- removing arch@@ -41,7 +45,8 @@ mpkgdir <- lookForPkgDir rbr ".." dep case mpkgdir of Nothing -> putStrLn $ dep ++ " not known"- Just pkgdir -> installCmd recurse mforceshort bconds reinstall mbr [pkgdir] >> putStrLn ""+ Just pkgdir -> installCmd recurse mforceshort bconds reinstall (mbr, [pkgdir]) >> putStrLn ""+ -- FIXME option to install missing deps else error' $ "missing deps:\n" ++ unlines missingdeps buildRPMs True mforceshort bconds rpms br spec putStrLn ""@@ -83,7 +88,7 @@ filterDebug = filter (\p -> not (any (`isInfixOf` p) ["-debuginfo-", "-debugsource-"])) -notInstalledCmd :: Maybe Branch -> [String] -> IO ()+notInstalledCmd :: (Maybe Branch,[String]) -> IO () notInstalledCmd = withPackagesMaybeBranch Nothing Nothing ZeroOrOne notInstalledPkg where
src/Cmd/ListBranches.hs view
@@ -1,5 +1,6 @@ module Cmd.ListBranches (- branchesCmd+ branchesCmd,+ BranchesMode(..) ) where @@ -10,22 +11,33 @@ import Git import Package +data BranchesMode = Local | Remote | Current+ deriving Eq+ -- FIXME remote/pagures branch and --remote or --no-remote -- FIXME --local for existing local branches-branchesCmd :: Bool -> Bool -> Bool -> Bool -> (BranchesReq,[String]) -> IO ()-branchesCmd skipdead allbrs missing remote (breq, pkgs) = do+branchesCmd :: Bool -> Bool -> Bool -> BranchesMode -> (BranchesReq,[String])+ -> IO ()+branchesCmd skipdead allbrs missing mode (breq, pkgs) = do -- when (allbrs $ do -- unless (null brs) $ -- error' "cannot combine --all and branches" -- when missing $ -- error' "cannot combine --all and --missing"+ when (mode == Current) $+ case breq of+ Branches [_] -> return ()+ Branches [] | not missing -> return ()+ _ -> error' $ (if missing then "--current --missing needs one branch"+ else "use --current with zero or one branches") +++ " specified" if null pkgs then branchesPkg "." else mapM_ branchesPkg pkgs where branchesPkg :: FilePath -> IO () branchesPkg path = do- if remote+ if mode == Remote then doBranchesPkg else withExistingDirectory path $@@ -37,27 +49,41 @@ where doBranchesPkg :: IO () doBranchesPkg = do- unless remote $+ unless (mode == Remote) $ unlessM isPkgGitRepo $ error' "not Fedora dist-git" pkg <- getPackageName path- brs <- delete "main" <$>- if remote- then pagurePkgBranches (unPackage pkg)- else localBranches- if allbrs then do- putStrLn $ unPackage pkg ++ ": " ++ unwords brs+ if mode == Current+ then do+ br <- gitCurrentBranch+ let onbranch =+ case br of+ RelBranch rbr -> Branches [rbr] == breq+ OtherBranch _abr -> False+ if missing+ then unless onbranch $ putStrLn $ unPackage pkg ++ ": " ++ show br+ else case breq of+ Branches [req] -> when (RelBranch req == br) $+ putStrLn $ unPackage pkg ++ ": " ++ show br+ _ -> putStrLn $ unPackage pkg ++ ": " ++ show br else do- if breq == Branches [] then do- -- FIXME better to filter inactive instead- active <- getFedoraBranches- let result = if missing then active \\ mapMaybe readBranch brs else activeBranches active brs- putStr $ unPackage pkg ++ ": "- putStrLn $ (unwords . map show) result+ brs <- delete "main" <$>+ if mode == Remote+ then pagurePkgBranches (unPackage pkg)+ else localBranches False+ if allbrs then do+ putStrLn $ unPackage pkg ++ ": " ++ unwords brs else do- branches <- listOfBranches True False breq- let havebrs = filter (`elem` branches) $ map readBranch' brs- result = if missing then branches \\ havebrs else havebrs- unless (null result) $ do+ if breq == Branches [] then do+ -- FIXME better to filter inactive instead+ active <- getFedoraBranches+ let result = if missing then active \\ mapMaybe readBranch brs else activeBranches active brs putStr $ unPackage pkg ++ ": " putStrLn $ (unwords . map show) result+ else do+ branches <- listOfBranches True False breq+ let havebrs = filter (`elem` branches) $ map readBranch' brs+ result = if missing then branches \\ havebrs else havebrs+ unless (null result) $ do+ putStr $ unPackage pkg ++ ": "+ putStrLn $ (unwords . map show) result
src/Cmd/Local.hs view
@@ -4,14 +4,11 @@ localCmd, nvrCmd, prepCmd,- sortCmd,- RpmWith(..), srpmCmd, renameMasterCmd ) where import qualified Data.ByteString.Lazy.Char8 as B-import Distribution.RPM.Build.Order (dependencySortRpmOpts) import System.Environment import qualified System.Process as P import qualified System.Process.Typed as TP@@ -34,15 +31,15 @@ else builtRpms br spec buildRPMs False mforceshort bconds rpms br spec -installDepsCmd :: Maybe Branch -> [String] -> IO ()+installDepsCmd :: (Maybe Branch,[String]) -> IO () installDepsCmd = withPackagesMaybeBranch Nothing Nothing ZeroOrOne installDepsPkg where installDepsPkg :: Package -> AnyBranch -> IO () installDepsPkg pkg br =- localBranchSpecFile pkg br >>= installDeps+ localBranchSpecFile pkg br >>= installDeps False -srpmCmd :: Bool -> Maybe Branch -> [String] -> IO ()+srpmCmd :: Bool -> (Maybe Branch,[String]) -> IO () srpmCmd force = withPackagesMaybeBranch Nothing Nothing ZeroOrOne srpmBuildPkg where@@ -51,24 +48,8 @@ spec <- localBranchSpecFile pkg br void $ generateSrpm' force (Just br) spec -data RpmWith = RpmWith String | RpmWithout String--sortCmd :: Maybe RpmWith -> Maybe Branch -> [String] -> IO ()-sortCmd _ _ [] = return ()-sortCmd mrpmwith mbr pkgs = do- withPackagesMaybeBranch Nothing Nothing ExactlyOne dummy mbr pkgs- let rpmopts = maybe [] toRpmOption mrpmwith- packages <- dependencySortRpmOpts rpmopts $ reverse pkgs- putStrLn $ unwords packages- where- dummy _pkg br =- whenM isPkgGitRepo $ gitSwitchBranch br-- toRpmOption :: RpmWith -> [String]- toRpmOption (RpmWith opt) = ["--with=" ++ opt]- toRpmOption (RpmWithout opt) = ["--without=" ++ opt]--prepCmd :: Maybe Branch -> [String] -> IO ()+-- FIXME option to clone package+prepCmd :: (Maybe Branch,[String]) -> IO () prepCmd = withPackagesMaybeBranch Nothing Nothing ZeroOrOne prepPackage @@ -111,7 +92,7 @@ renameMasterCmd :: [String] -> IO () renameMasterCmd pkgs =- withPackageByBranches (Just False) dirtyGit ZeroOrOne renameMasterBranch (Branches [], pkgs)+ withPackageByBranches (Just False) dirtyGit Zero renameMasterBranch (Branches [], pkgs) where renameMasterBranch :: Package -> AnyBranch -> IO () renameMasterBranch _pkg _br = do
src/Cmd/Merge.hs view
@@ -1,4 +1,8 @@-module Cmd.Merge (mergeCmd, mergeable, mergeBranch) where+module Cmd.Merge (+ mergeCmd,+ mergeable,+ mergeBranch)+where import Common import Common.System@@ -18,14 +22,14 @@ error' "merge only defined for release branches" runMergeBranch _pkg rbr@(RelBranch br) = do gitSwitchBranch rbr- gitMergeOrigin rbr+ gitMergeOrigin br unmerged <- mergeable br mergeBranch False noprompt unmerged br getNewerBranch :: Branch -> IO Branch getNewerBranch Rawhide = return Rawhide getNewerBranch br = do- branches <- fedoraBranches localBranches+ branches <- fedoraBranches (localBranches False) let newer = newerBranch br branches return $ if newer > br then newer -- FIXME this can be dropped with next fedora-dists@@ -37,13 +41,15 @@ -- restrict to local branches mergeable :: Branch -> IO (Bool,[String]) mergeable br = do- newerBr <- getNewerBranch br- gitMergeable $ show newerBr+ newer <- getNewerBranch br+ locals <- localBranches True+ gitMergeable (show newer `notElem` locals) newer -- FIXME return merged ref-mergeBranch :: Bool -> Bool -> (Bool,[String]) -> Branch -> IO ()+mergeBranch :: Bool -> Bool -> (Bool,[String]) -- (ancestor,unmerged)+ -> Branch -> IO () mergeBranch _ _ _ Rawhide = return ()-mergeBranch _ _ (True,[]) _ = return ()+mergeBranch _ _ (_,[]) _ = return () mergeBranch build noprompt (True, unmerged) br = do newerBr <- getNewerBranch br isnewrepo <- initialPkgRepo@@ -66,8 +72,10 @@ Just hash -> hash git_ "merge" ["--quiet", ref] mergeBranch build noprompt (False,unmerged) br = do- putStrLn "Branch is not directly mergeable:"+ newer <- getNewerBranch br+ putStrLn $ show newer ++ " branch is not directly mergeable:" mapM_ putStrLn unmerged+ putStrLn "" unpushed <- gitShortLog $ "origin/" ++ show br ++ "..HEAD" unless (null unpushed) $ do putStrLn "Local commits:"
src/Cmd/Override.hs view
@@ -6,20 +6,25 @@ import Bodhi import Branches+import Cmd.WaitRepo (waitrepoCmd) import Git import Koji import Package -- FIXME option to expire (all) overrides-overrideCmd :: Bool -> [Branch] -> [String] -> IO ()-overrideCmd dryrun brs pkgs =- withPackageByBranches (Just False) cleanGitFetchActive AnyNumber overrideBranch (Branches brs, pkgs)+overrideCmd :: Bool -> Maybe Int -> Bool -> (BranchesReq, [String]) -> IO ()+overrideCmd dryrun mduration nowait breqpkgs = do+ unless nowait $+ putStrLn "Overriding"+ withPackageByBranches (Just False) cleanGitFetchActive AnyNumber overrideBranch breqpkgs+ unless nowait $ do+ putStrLn "Waiting"+ waitrepoCmd dryrun breqpkgs where overrideBranch :: Package -> AnyBranch -> IO () overrideBranch _ (OtherBranch _) = error' "override only defined for release branches" overrideBranch pkg rbr@(RelBranch br) = do- putPkgBrnchHdr pkg br gitSwitchBranch rbr let spec = packageSpec pkg nvr <- pkgNameVerRel' br spec@@ -27,5 +32,4 @@ tags <- kojiNVRTags nvr unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $ unlessM (checkAutoBodhiUpdate br) $ do- bodhiCreateOverride dryrun nvr- kojiWaitRepo dryrun (branchTarget br) nvr+ bodhiCreateOverride dryrun mduration nvr
src/Cmd/Parallel.hs view
@@ -41,6 +41,7 @@ [] -> listOfBranches True True breq [p] -> withExistingDirectory p $ listOfBranches True True breq _ -> case breq of+ Branches [] -> error' "please specify a branch" Branches _ -> listOfBranches True True breq _ -> error' "parallel does not support branch options for multiple packages: please give an explicit list of branches instead" when (null branches) $@@ -50,7 +51,7 @@ error' "You can only specify target with one branch" case pkgs of [] -> do- unlessM isPkgGitRepo $+ unlessM isPkgGitSshRepo $ error' "Please specify at least one package" parallelBranches branches [p] -> withExistingDirectory p $@@ -91,10 +92,14 @@ parallelBuild :: Branch -> (Int,[String]) -> IO String parallelBuild br (layersleft,layer) = do krbTicket- when (nopkgs > 1) $ do- putStrLn $ "\nBuilding parallel layer of " ++ show nopkgs ++ " packages:"- putStrLn $ unwords layer- putStrLn $ "(" ++ show layersleft ++ " more layers left)"+ putStrLn $ "\nBuilding parallel layer of" +++ if nopkgs > 1+ then " " ++ show nopkgs ++ " packages:"+ else ":"+ putStrLn $ unwords layer+ putStrLn $ "(" ++ show layersleft ++ " more layer" +++ if layersleft > 1 then "s" else ""+ ++ " left)" jobs <- mapM setupBuild layer (failures,mtarget) <- watchJobs Nothing [] jobs unless (null failures) $@@ -119,9 +124,11 @@ case status of Nothing -> watchJobs mtarget fails (jobs ++ [job]) Just (Right (target,nvr)) -> do+ putStrLn "" putStrLn $ nvr ++ " job " ++ color Yellow "completed" ++ " (" ++ show (length jobs) ++ " jobs left)" 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)"@@ -148,7 +155,7 @@ Nothing -> return $ branchTarget br Just (Target t) -> return t Just SideTag -> do- tags <- map (head . words) <$> kojiUserSideTags br+ tags <- map (head . words) <$> kojiUserSideTags (Just br) case tags of [] -> do out <- head . lines <$> fedpkg "request-side-tag" []@@ -170,7 +177,7 @@ tags <- kojiNVRTags nvr unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $ unlessM (checkAutoBodhiUpdate br) $- bodhiCreateOverride dryrun nvr+ bodhiCreateOverride dryrun Nothing nvr return $ do when morelayers $ kojiWaitRepo dryrun target nvr@@ -182,7 +189,7 @@ maybe (error' $ "Task for " ++ nvr ++ " not found") (kojiWaitTaskAndRepo (isNothing mlatest) nvr target) _ -> do- buildref <- git "show-ref" ["--hash", "origin" </> show br]+ buildref <- git "show-ref" ["--hash", "origin/" ++ show br] opentasks <- kojiOpenTasks pkg (Just buildref) target case opentasks of [task] -> do@@ -202,7 +209,8 @@ where kojiWaitTaskAndRepo :: Bool -> String -> String -> TaskID -> IO (String,String) kojiWaitTaskAndRepo newpkg nvr target task = do- finish <- kojiWatchTaskQuiet task+ finish <- kojiWaitTask task+ putStrLn "" if finish then putStrLn $ color Green $ nvr ++ " build success" else error' $ color Red $ nvr ++ " build failed"@@ -221,7 +229,7 @@ -- -- FIXME: avoid prompt in -- changelog <- getChangeLog Nothing spec -- bodhiUpdate (fmap fst mBugSess) changelog nvr- bodhiCreateOverride dryrun nvr+ bodhiCreateOverride dryrun Nothing nvr when morelayers $ kojiWaitRepo dryrun target nvr return (target,nvr)
src/Cmd/PkgReview.hs view
@@ -3,6 +3,7 @@ module Cmd.PkgReview ( createReview, updateReview,+ ScratchOption(..), reviewPackage ) where @@ -20,11 +21,13 @@ import Package import Prompt +data ScratchOption = ScratchBuild | ScratchTask Int | SkipScratch+ deriving Eq+ -- FIXME add --dependent pkgreview--- FIXME reference existing/previous scratch build-createReview :: Bool -> Bool -> [FilePath] -> IO ()-createReview noscratch mock pkgs =- withPackageByBranches (Just True) Nothing ZeroOrOne createPkgReview (Branches [], pkgs)+createReview :: ScratchOption -> Bool -> [FilePath] -> IO ()+createReview scratchOpt mock pkgs =+ withPackageByBranches (Just True) Nothing Zero createPkgReview (Branches [], pkgs) where createPkgReview :: Package -> AnyBranch -> IO () createPkgReview package _br = do@@ -40,8 +43,8 @@ -- FIXME abort if open review (unless --force?) prompt_ "Press Enter to continue" srpm <- generateSrpm Nothing spec- mockRpmLint mock noscratch pkg spec srpm- (mkojiurl,specSrpmUrls) <- buildAndUpload noscratch srpm pkg spec+ mockRpmLint mock (scratchOpt == ScratchBuild) pkg spec srpm+ (mkojiurl,specSrpmUrls) <- buildAndUpload scratchOpt srpm pkg spec bugid <- postReviewReq session spec specSrpmUrls mkojiurl pkg putStrLn "Review request posted:" putBugId bugid@@ -57,16 +60,18 @@ , ("summary", "Review Request: " <> pkg <> " - " <> summary) , ("description", specSrpmUrls <> "\n\nDescription:\n" <> description <> maybe "" ("\n\n\nKoji scratch build: " <>) mkojiurl)] -buildAndUpload :: Bool -> String -> String -> FilePath+buildAndUpload :: ScratchOption -> String -> String -> FilePath -> IO (Maybe String, String)-buildAndUpload noscratch srpm pkg spec = do- mkojiurl <- if noscratch then return Nothing- else Just <$> kojiScratchBuild "rawhide" [] srpm+buildAndUpload scratchOpt srpm pkg spec = do+ mkojiurl <- case scratchOpt of+ ScratchBuild -> Just <$> kojiScratchBuild "rawhide" [] srpm+ ScratchTask tid -> return $ Just ("https://koji.fedoraproject.org/koji/taskinfo?taskID=" ++ show tid)+ SkipScratch -> return Nothing specSrpmUrls <- uploadPkgFiles pkg spec srpm return (mkojiurl, specSrpmUrls) -updateReview :: Bool -> Bool -> Maybe FilePath -> IO ()-updateReview noscratch mock mspec = do+updateReview :: ScratchOption -> Bool -> Maybe FilePath -> IO ()+updateReview scratchOpt mock mspec = do spec <- maybe findSpecfile checkLocalFile mspec pkg <- cmd "rpmspec" ["-q", "--srpm", "--qf", "%{name}", spec] (bid,session) <- reviewBugIdSession pkg@@ -75,8 +80,8 @@ submitted <- checkForComment session bid (T.pack srpm) when submitted $ error' "This NVR was already posted on the review bug: please bump"- mockRpmLint mock noscratch pkg spec srpm- (mkojiurl,specSrpmUrls) <- buildAndUpload noscratch srpm pkg spec+ mockRpmLint mock (scratchOpt == ScratchBuild) pkg spec srpm+ (mkojiurl,specSrpmUrls) <- buildAndUpload scratchOpt srpm pkg spec changelog <- getChangeLog Nothing spec commentBug session bid (specSrpmUrls <> (if null changelog then "" else "\n\n" <> changelog) <> maybe "" ("\n\nKoji scratch build: " <>) mkojiurl) -- putStrLn "Review bug updated"@@ -94,12 +99,12 @@ sshpath = "public_html/reviews/" ++ pkg cmd_ "ssh" [fasid ++ "@" ++ sshhost, "mkdir", "-p", sshpath] cmd_ "scp" [spec, srpm, sshhost ++ ":" ++ sshpath]- getCheckedFileUrls $ "https://" <> fasid <> ".fedorapeople.org" </> removePrefix "public_html/" sshpath+ getCheckedFileUrls $ "https://" <> fasid <> ".fedorapeople.org" +/+ removePrefix "public_html/" sshpath where getCheckedFileUrls :: String -> IO String getCheckedFileUrls uploadurl = do- let specUrl = uploadurl </> takeFileName spec- srpmUrl = uploadurl </> takeFileName srpm+ let specUrl = uploadurl +/+ takeFileName spec+ srpmUrl = uploadurl +/+ takeFileName srpm mgr <- httpManager checkUrlOk mgr specUrl checkUrlOk mgr srpmUrl@@ -110,7 +115,7 @@ unless okay $ error' $ "Could not access: " ++ url mockRpmLint :: Bool -> Bool -> String -> FilePath -> FilePath -> IO ()-mockRpmLint mock noscratch pkg spec srpm = do+mockRpmLint mock scratch pkg spec srpm = do rpms <- if mock then do -- FIXME check that mock is installed@@ -121,8 +126,10 @@ builtRpms (RelBranch Rawhide) spec >>= filterM doesFileExist -- FIXME parse # of errors/warnings void $ cmdBool "rpmlint" $ spec:srpm:rpms- prompt_ $ "Press Enter to " ++ if noscratch then "upload" else "submit"+ prompt_ $ "Press Enter to " ++ if scratch then "submit" else "upload" +-- FIXME does not work with pkg dir/spec:+-- 'fbrnch: No spec file found' reviewPackage :: Maybe String -> IO () reviewPackage mpkg = do -- FIXME if spec file exists use it directly
src/Cmd/Pull.hs view
@@ -12,4 +12,4 @@ where pullPkg :: Package -> AnyBranch -> IO () pullPkg _pkg _br =- gitCurrentBranch >>= gitMergeOrigin+ getReleaseBranch >>= gitMergeOrigin
src/Cmd/RequestBranch.hs view
@@ -14,20 +14,21 @@ import Package import Pagure +-- FIXME option to do koji scratch build instead of mock requestBranches :: Bool -> (BranchesReq,[String]) -> IO () requestBranches mock (breq, ps) = do if null ps then- ifM isPkgGitRepo+ ifM isPkgGitSshRepo (getDirectoryName >>= requestPkgBranches mock breq . Package) $ do pkgs <- map reviewBugToPackage <$> listReviews ReviewUnbranched mapM_ (\ p -> withExistingDirectory p $ requestPkgBranches mock breq (Package p)) pkgs else mapM_ (\ p -> withExistingDirectory p $ requestPkgBranches mock breq (Package p)) ps --- FIXME add --yes, or skip prompt when args given requestPkgBranches :: Bool -> BranchesReq -> Package -> IO () requestPkgBranches mock breq pkg = do- putPkgHdr pkg+ when (breq == Branches []) $+ putPkgHdr pkg git_ "fetch" [] branches <- getRequestedBranches breq newbranches <- filterExistingBranchRequests branches@@ -43,7 +44,7 @@ where filterExistingBranchRequests :: [Branch] -> IO [Branch] filterExistingBranchRequests branches = do- existing <- fedoraBranchesNoRawhide localBranches+ existing <- fedoraBranchesNoRawhide (localBranches True) forM_ branches $ \ br -> when (br `elem` existing) $ putStrLn $ show br ++ " branch already exists"
src/Cmd/RequestRepo.hs view
@@ -6,7 +6,6 @@ import qualified Common.Text as T import Network.HTTP.Directory (httpExists, httpManager)-import Network.HTTP.Query ((+/+)) import SimpleCmd import Branches@@ -41,7 +40,6 @@ if created then putStrLn "scm repo was already created" else do- -- show comments? requests <- existingRepoRequests unless (null requests) $ do putStrLn "Request exists:"@@ -51,13 +49,19 @@ error' "The last repo request was already successfully Processed" when (null requests || retry) $ do checkNoPagureRepo+ putStrLn ""+ comments <- getComments session bid+ mapM_ showComment comments+ putStrLn ""+ prompt_ "Press Enter to continue"+ -- FIXME check api key is still valid or open pagure ticket directly url <- fedpkg "request-repo" [pkg, show bid]- putStrLn $ url ++ "\n" let assignee = userRealName (bugAssignedToDetail bug) let draft = "Thank you for the review" ++ maybe "" ((", " ++) . T.unpack) (getFirstname assignee) putStrLn "```" putStrLn draft putStrLn "```"+ putStrLn $ url ++ "\n" input <- prompt "Press Enter to post above comment, or input now" let comment = (if null input then draft else input) ++ "\n\n" <> url commentBug session bid comment
src/Cmd/Scratch.hs view
@@ -43,12 +43,14 @@ if clean then null <$> gitShortLog ("origin/" ++ show br ++ "..HEAD") else return False- putStrLn $ "koji scratch " ++ (if pushed then "" else "srpm ") ++ "build for " ++ target+ rbr <- anyBranchToRelease br+ nvr <- pkgNameVerRel' rbr spec+ putStrLn $ "koji scratch build of " ++ nvr ++ (if pushed then "" else ".src.rpm") ++ " for " ++ target unless dryrun $ do if pushed then kojiBuildBranch target pkg Nothing $ "--scratch" : kojiargs else srpmBuild target kojiargs spec- else srpmBuild target kojiargs spec+ else srpmBuild target kojiargs spec where srpmBuild :: FilePath -> [String] -> String -> IO () srpmBuild target kojiargs spec =
src/Cmd/SideTags.hs view
@@ -5,12 +5,10 @@ sideTagsCmd :: [Branch] -> IO () sideTagsCmd brs = do- branches <-- if null brs- then getFedoraBranches- else return brs- mapM_ sideTagsBranch branches+ if null brs+ then kojiUserSideTags Nothing >>= mapM_ putStrLn+ else mapM_ sideTagsBranch brs where sideTagsBranch :: Branch -> IO () sideTagsBranch br =- kojiUserSideTags br >>= mapM_ putStrLn+ kojiUserSideTags (Just br) >>= mapM_ putStrLn
+ src/Cmd/Sort.hs view
@@ -0,0 +1,39 @@+module Cmd.Sort (+ sortCmd,+ RpmWith(..),+ graphCmd+ )+where++import Control.Monad.Extra+import Distribution.RPM.Build.Graph -- (dependencySortRpmOpts)+import Distribution.RPM.Build.Order (dependencySortRpmOpts)++import Branches+import Git+import Package++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)+ let rpmopts = maybe [] toRpmOption mrpmwith+ packages <- dependencySortRpmOpts rpmopts $ reverse pkgs+ putStrLn $ unwords packages++noop :: Package -> AnyBranch -> IO ()+noop _pkg br =+ whenM isPkgGitRepo $ gitSwitchBranch br++toRpmOption :: RpmWith -> [String]+toRpmOption (RpmWith opt) = ["--with=" ++ opt]+toRpmOption (RpmWithout opt) = ["--without=" ++ opt]++graphCmd :: Bool -> Maybe RpmWith -> (Maybe Branch,[FilePath]) -> IO ()+graphCmd dot mrpmwith (mbr, pkgs) = do+ withPackagesMaybeBranch Nothing Nothing ZeroOrOne noop (mbr, pkgs)+ let rpmopts = maybe [] toRpmOption mrpmwith+ createGraph'''' False [] rpmopts False False True Nothing pkgs >>=+ if dot then printGraph else renderGraph
src/Cmd/Status.hs view
@@ -53,7 +53,7 @@ -- newerBr <- newerBranch br <$> getFedoraBranches -- ancestor <- gitBool "merge-base" ["--is-ancestor", "HEAD", show newerBr] -- when ancestor $ do- -- unmerged <- gitShortLog $ "HEAD.." ++ show newerBr+ -- unmerged <- gitShortLog $ "HEAD..origin/" ++ show newerBr -- unless (null unmerged) $ do -- putStrLn $ "Newer commits in " ++ show newerBr ++ ":" -- mapM_ putStrLn unmerged
src/Cmd/Update.hs view
@@ -13,14 +13,13 @@ import Krb import Package --- FIXME branch arg?-updateCmd :: Maybe Branch -> [String] -> IO ()-updateCmd mbr args = do- pkgGit <- isPkgGitRepo+updateCmd :: (Maybe Branch,[String]) -> IO ()+updateCmd (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+ withPackagesMaybeBranch (Just False) dirtyGitFetch ZeroOrOne (updatePkg mver) (mbr, pkgs) where updatePkg :: Maybe String -> Package -> AnyBranch -> IO () updatePkg mver pkg br = do@@ -39,7 +38,7 @@ -- if newver < oldver -- then putStrLn $ "current" +-+ display oldver +-+ "is newer!" -- else do- pkgGit <- isPkgGitRepo+ pkgGit <- isPkgGitSshRepo let (oldver,newver) = case mver of Just nver -> (curver,nver)
+ src/Cmd/WaitRepo.hs view
@@ -0,0 +1,22 @@+module Cmd.WaitRepo (waitrepoCmd)+where++import Common.System++import Branches+import Git+import Koji+import Package++waitrepoCmd :: Bool -> (BranchesReq, [String]) -> IO ()+waitrepoCmd dryrun = do+ withPackageByBranches (Just False) cleanGitFetchActive AnyNumber (waitrepoBranch dryrun)++waitrepoBranch :: Bool -> Package -> AnyBranch -> IO ()+waitrepoBranch _ _ (OtherBranch _) =+ error' "waitrepo only defined for release branches"+waitrepoBranch dryrun pkg rbr@(RelBranch br) = do+ gitSwitchBranch rbr+ let spec = packageSpec pkg+ nvr <- pkgNameVerRel' br spec+ kojiWaitRepo dryrun (branchTarget br) nvr
src/Common.hs view
@@ -5,8 +5,9 @@ module Data.List.Extra, module Data.Maybe, #if !MIN_VERSION_base(4,11,0)- (<>)+ (<>), #endif+ (+/+) ) where import Control.Monad.Extra@@ -16,3 +17,5 @@ #if !MIN_VERSION_base(4,11,0) import Data.Semigroup ((<>)) #endif++import Network.HTTP.Query ((+/+))
src/Git.hs view
@@ -9,6 +9,7 @@ gitMergeOrigin, gitFetchSilent, gitPushSilent,+ gitRepoName, gitShortLog, gitShortLogN, gitShortLog1,@@ -16,6 +17,7 @@ -- checkIsPkgGitDir, isGitRepo, isPkgGitRepo,+ isPkgGitSshRepo, checkWorkingDirClean, isGitDirClean, CommitOpt (..),@@ -38,15 +40,16 @@ cmdBool "git" (c:args) #endif -gitMergeable :: String -> IO (Bool,[String])-gitMergeable ref = do+gitMergeable :: Bool -> Branch -> IO (Bool,[String])+gitMergeable origin br = do+ let ref = (if origin then "origin/" else "") ++ show br ancestor <- gitBool "merge-base" ["--is-ancestor", "HEAD", ref] commits <- gitShortLog ("HEAD.." ++ ref) return (ancestor, commits) -gitMergeOrigin :: AnyBranch -> IO ()+gitMergeOrigin :: Branch -> IO () gitMergeOrigin br = do- (ancestor,commits) <- gitMergeable $ "origin" </> show br+ (ancestor,commits) <- gitMergeable True br if ancestor then unless (null commits) $ do rebase <- git "rebase" []@@ -90,10 +93,15 @@ out <- cmdQuiet "git" $ ["push", "--quiet", "origin"] ++ maybeToList mref putStrLn $ if null out then "done\n" else "\n" ++ out +-- FIXME use this in more places+gitRepoName :: IO String+gitRepoName =+ dropSuffix ".git" . takeFileName <$> git "remote" ["get-url", "origin"]+ -- FIXME flag for really silent? gitFetchSilent :: IO () gitFetchSilent = do- name <- getDirectoryName+ name <- gitRepoName putStr $ "git fetching " ++ name ++ "... " (ok, out, err) <- cmdFull "git" ["fetch"] "" unless (null out) $ putStrLn out@@ -124,25 +132,28 @@ isGitRepo = isGitDir "." ||^ doesFileExist ".git" isPkgGitRepo :: IO Bool-isPkgGitRepo = grepGitConfig' "@\\(pkgs\\|src\\)\\."- where- -- adapted from SimpleCmd.Git- grepGitConfig' :: String -> IO Bool- grepGitConfig' key =- ifM (isGitDir ".")- (egrep_ key ".git/config") $- -- could be a worktree or absorbed submodule (#8)- ifM (not <$> doesFileExist ".git")- (return False) $ do- gitdir <- last . words <$> readFile ".git"- if "/worktrees/" `isInfixOf` gitdir- then egrep_ key (takeDirectory (takeDirectory gitdir) </> "config")- else- -- absorbed submodule: "gitdir: ../.git/modules/R-bit"- if "/modules/" `isInfixOf` gitdir then- egrep_ key $ gitdir </> "config"- else return False+isPkgGitRepo = grepGitConfig' "\\(https://\\|@\\)\\(pkgs\\|src\\)\\." +isPkgGitSshRepo :: IO Bool+isPkgGitSshRepo = grepGitConfig' "@\\(pkgs\\|src\\)\\."++-- adapted from SimpleCmd.Git+grepGitConfig' :: String -> IO Bool+grepGitConfig' key =+ ifM (isGitDir ".")+ (egrep_ key ".git/config") $+ -- could be a worktree or absorbed submodule (#8)+ ifM (not <$> doesFileExist ".git")+ (return False) $ do+ gitdir <- last . words <$> readFile ".git"+ if "/worktrees/" `isInfixOf` gitdir+ then egrep_ key (takeDirectory (takeDirectory gitdir) </> "config")+ else+ -- absorbed submodule: "gitdir: ../.git/modules/R-bit"+ if "/modules/" `isInfixOf` gitdir then+ egrep_ key $ gitdir </> "config"+ else return False+ gitLines :: String -> [String] -> IO [String] gitLines c args = lines <$> git c args @@ -165,7 +176,7 @@ name <- getDirectoryName error' $ name ++ " " ++ show br ++ " branch does not exist!" else- git_ "checkout" ["-q", "-b", show br, "--track", "origin" </> show br]+ git_ "checkout" ["-q", "-b", show br, "--track", "origin/" ++ show br] where checkIfRemoteBranchExists = gitBool "show-ref" ["--verify", "--quiet", "refs/remotes/origin/" ++ show br]
src/Koji.hs view
@@ -17,20 +17,22 @@ kojiTagArchs, kojiWaitRepo, kojiWatchTask,- kojiWatchTaskQuiet,+ kojiWaitTask, TaskID, displayID,- fedoraHub+ fedoraHub,+ maybeTimeout ) where import Data.Char (isDigit) import Control.Concurrent (threadDelay) import qualified Data.ByteString.Lazy.Char8 as B-import Fedora.Koji-import qualified Fedora.Koji.Internal as Koji+import Distribution.Koji+import qualified Distribution.Koji.API as Koji import System.Exit import System.Process.Typed+import System.Time.Extra (sleep, timeout) import Branches import Common@@ -123,6 +125,7 @@ -- return url -- FIXME filter/simplify output+-- FIXME implement native watchTask kojiWatchTask :: TaskID -> IO () kojiWatchTask task = do -- FIXME can error:@@ -138,23 +141,26 @@ Just TaskCanceled -> return () _ -> kojiWatchTask task -kojiWatchTaskQuiet :: TaskID -> IO Bool-kojiWatchTaskQuiet task =- ifM (cmdBool "koji" ["watch-task", "--quiet", displayID task])- (return True) $- do- -- FIXME can error:- -- eg1 [ERROR] koji: HTTPError: 503 Server Error: Service Unavailable for url: https://koji.fedoraproject.org/kojihub- -- eg2 [ERROR] koji: ServerOffline: database outage: - user error (Error 1014: database outage)- mst <- kojiGetTaskState fedoraHub task- case mst of- Just TaskClosed -> return True- Just TaskFailed -> return False- _ -> kojiWatchTaskQuiet task+kojiWaitTask :: TaskID -> IO Bool+kojiWaitTask task = do+ -- FIXME can error:+ -- eg1 [ERROR] koji: HTTPError: 503 Server Error: Service Unavailable for url: https://koji.fedoraproject.org/kojihub+ -- eg2 [ERROR] koji: ServerOffline: database outage: - user error (Error 1014: database outage)+ mst <- maybeTimeout 45 $ kojiGetTaskState fedoraHub task+ case mst of+ Just ts ->+ if ts `elem` openTaskStates+ then do+ putChar '.'+ sleep 20+ kojiWaitTask task+ else return $ ts == TaskClosed+ Nothing -> do+ error $ "failed to get info for koji task " ++ displayID task kojiSource :: Package -> String -> String kojiSource pkg ref =- "git+https://" ++ srcfpo ++ "/rpms" </> unPackage pkg ++ ".git#" ++ ref+ "git+https://" ++ srcfpo ++ "/rpms" +/+ unPackage pkg ++ ".git#" ++ ref kojiBuildBranch' :: Bool -> String -> Package -> Maybe String -> [String] -> IO KojiBuildTask@@ -211,11 +217,24 @@ st <- Koji.getTag fedoraHub (Koji.InfoString tag) Nothing return $ maybe [] words $ lookupStruct "arches" st -kojiUserSideTags :: Branch -> IO [String]-kojiUserSideTags br = do- mtags <- kojiBuildTarget fedoraHub (branchTarget br)- case mtags of- Nothing -> return []- Just (buildtag,_desttag) -> do- user <- fasIdFromKrb- kojiListSideTags fedoraKojiHub (Just buildtag) (Just user)+kojiUserSideTags :: Maybe Branch -> IO [String]+kojiUserSideTags mbr = do+ user <- fasIdFromKrb+ case mbr of+ Nothing -> do+ maybeTimeout 55 $ kojiListSideTags fedoraKojiHub Nothing (Just user)+ Just br -> do+ mtags <- kojiBuildTarget fedoraHub (branchTarget br)+ case mtags of+ Nothing -> return []+ Just (buildtag,_desttag) -> do+ kojiListSideTags fedoraKojiHub (Just buildtag) (Just user)++maybeTimeout :: Double -> IO a -> IO a+maybeTimeout secs act = do+ mres <- timeout secs act+ case mres of+ Nothing -> do+ warning "Connection timed out: retrying"+ maybeTimeout (secs + 5) act+ Just res -> return res
src/Main.hs view
@@ -29,9 +29,11 @@ import Cmd.Reviews import Cmd.Scratch import Cmd.SideTags+import Cmd.Sort import Cmd.Status import Cmd.Switch import Cmd.Update+import Cmd.WaitRepo import Branches import Common.System@@ -61,38 +63,40 @@ , Subcommand "list" "List packages in pagure" $ listCmd <$> switchWith 'c' "count" "Print number of packages" <*> optional packagerOpt <*> many (pkgArg "PKGPAT...") , Subcommand "branches" "List package branches" $- branchesCmd <$> switchWith 'd' "skip-dead" "Skip if dead.package exists" <*> switchWith 'a' "all" "List all branches" <*> switchWith 'm' "missing" "Show missing branches" <*> switchWith 'r' "remote" "List remote branches" <*> branchesPackages+ branchesCmd <$> switchWith 'd' "skip-dead" "Skip if dead.package exists" <*> switchWith 'a' "all" "List all branches" <*> switchWith 'm' "missing" "Show missing branches" <*> branchesModeOpt <*> branchesPackages , Subcommand "parallel" "Parallel build packages in Koji" $ parallelBuildCmd <$> dryrunOpt <*> optional sidetagTargetOpt <*> updatetypeOpt <*> branchesPackages , Subcommand "sidetags" "List user's side-tags" $ sideTagsCmd <$> many branchArg , Subcommand "override" "Tag builds into buildroot override in Koji" $- overrideCmd <$> dryrunOpt <*> many branchArg <*> manyPackages+ overrideCmd <$> dryrunOpt <*> optional (optionWith auto 'd' "duration" "DAYS" "Number of days until expiry [default 4]") <*> switchWith 'w' "no-wait" "Skip waitrepo step" <*> branchesPackages+ , Subcommand "waitrepo" "Wait for build to appear in Koji buildroot" $+ waitrepoCmd <$> dryrunOpt <*> branchesPackages , Subcommand "scratch" "Scratch build package in Koji" $ scratchCmd <$> dryrunOpt <*> rebuildSrpmOpt <*> noFailFastOpt <*> optional archesOpt <*> mtargetOpt <*> branchesPackages- , Subcommand "update" "Update package to newer version" $- updateCmd <$> optional branchArg <*> manyPackages+ , Subcommand "update" "Update package in dist-git to newer version" $+ updateCmd <$> maybeBranchPackages False , Subcommand "sort" "Sort packages in build dependency order" $- sortCmd <$> optional rpmWithOpt <*> optional branchArg <*> somePackages+ sortCmd <$> optional rpmWithOpt <*> maybeBranchPackages True , Subcommand "prep" "Prep sources" $- prepCmd <$> optional branchArg <*> manyPackages+ prepCmd <$> maybeBranchPackages False , Subcommand "local" "Build locally" $ localCmd <$> optional forceshortOpt <*> many bcondOpt <*> branchesPackages , Subcommand "srpm" "Build srpm" $- srpmCmd <$> switchWith 'f' "force" "regenerate even if spec older than existing srpm" <*> optional branchArg <*> manyPackages+ srpmCmd <$> switchWith 'f' "force" "regenerate even if spec older than existing srpm" <*> maybeBranchPackages False , Subcommand "diff" "Diff local changes" $- diffCmd <$> diffSpecOnly <*> diffWorkOpt <*> diffFormatOpt <*> diffBranchOpt <*> optional branchArg <*> manyPackages+ diffCmd <$> diffSpecOnly <*> diffWorkOpt <*> diffFormatOpt <*> diffBranchOpt <*> maybeBranchPackages False , Subcommand "log" "Show commits between branches" $ logCmd <$> switchWith 'l' "long" "show full commit log" <*> anyBranchArg <*> anyBranchArg <*> 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 'w' "network" "Use network during build" <*> switchWith 'N' "no-clean-after" "Don't clean chroot after building a package" <*> optional (optionWith branchM 'r' "root" "BRANCH" "Mock config to use") <*> branchesPackages , Subcommand "install-deps" "Install package build dependencies" $- installDepsCmd <$> optional branchArg <*> manyPackages+ installDepsCmd <$> maybeBranchPackages False , Subcommand "install" "Build locally and install package(s)" $ -- FIXME drop --shortcircuit from install?- installCmd <$> switchWith 'R' "recurse" "build and install missing deps packages" <*> optional forceshortOpt <*> many bcondOpt <*> switchWith 'r' "reinstall" "reinstall rpms" <*> optional branchArg <*> manyPackages+ installCmd <$> switchWith 'R' "recurse" "build and install missing deps packages" <*> optional forceshortOpt <*> many bcondOpt <*> switchWith 'r' "reinstall" "reinstall rpms" <*> maybeBranchPackages False , Subcommand "not-installed" "Packages not installed locally" $- notInstalledCmd <$> optional branchArg <*> manyPackages+ notInstalledCmd <$> maybeBranchPackages False , Subcommand "bugs" "List package bugs" $ bugsCmd <$> optional (strOptionWith 's' "summary" "KEY" "Search for bugs containing keyword") <*> manyPackages , Subcommand "bump" "Bump release for package" $@@ -102,9 +106,9 @@ , Subcommand "pull" "Git pull packages" $ pullPkgs <$> branchesPackages , Subcommand "create-review" "Create a Package Review request" $- createReview <$> noScratchBuild <*> mockOpt False <*> manyPackages+ createReview <$> scratchOpt <*> mockOpt False <*> manyPackages , Subcommand "update-review" "Update a Package Review" $- updateReview <$> noScratchBuild <*> mockOpt False <*> optional (strArg "SPECFILE")+ updateReview <$> scratchOpt <*> mockOpt False <*> optional (strArg "SPECFILE") , Subcommand "reviews" "List package reviews" $ reviewsCmd <$> reviewShortOpt <*> reviewAllStatusOpt <*> switchWith 'T' "assigned-to" "List reviews assigned to user" <*> optional (strOptionWith 'U' "user" "USER" "Bugzilla user email") <*> reviewStatusOpt , Subcommand "request-repos" "Request dist git repo for new approved packages" $@@ -125,13 +129,13 @@ coprCmd <$> dryrunOpt <*> switchWith 'l' "list-chroots" "Show project chroots" <*> buildByOpt <*> many archOpt <*> pkgArg "PROJECT" <*> branchesPackages , Subcommand "rename-master" "Rename local master branch to rawhide" $ renameMasterCmd <$> manyPackages+ , Subcommand "graph" "Output dependency graph" $+ graphCmd <$> switchWith 'o' "output" "Output graph in gv/dot format" <*> optional rpmWithOpt <*> maybeBranchPackages True ] where cloneRequest :: Parser CloneRequest cloneRequest = flagWith' (CloneUser Nothing) 'M' "mine" "Your packages" <|> CloneUser . Just <$> strOptionWith 'u' "user" "USER" "Packages of FAS user" <|> ClonePkgs <$> somePackages - noScratchBuild = switchWith 'S' "no-scratch-build" "Skip Koji scratch build"- reviewShortOpt :: Parser Bool reviewShortOpt = switchWith 's' "short" "Only output the package name" @@ -190,6 +194,21 @@ -- flagWith' AllBranches 'B' "all-branches" "Request branches for all current releases [default latest 2]" <|> -- ExcludeBranches <$> some excludeBranchOpt + maybeBranchPackages :: Bool -> Parser (Maybe Branch,[String])+ maybeBranchPackages oneplus =+ maybeBranchesPkgs <$>+ if oneplus+ then some (pkgArg "[BRANCH] PACKAGE...")+ else many (pkgArg "[BRANCH] [PACKAGE]...")+ where+ maybeBranchesPkgs :: [String] -> (Maybe Branch,[String])+ maybeBranchesPkgs args =+ let (brs,pkgs) = partitionBranches args+ in case brs of+ [] -> (Nothing, pkgs)+ [br] -> (Just br,pkgs)+ _ -> error' $ "cannot have more than one branch: " ++ unwords (map show brs)+ branchesPackages :: Parser (BranchesReq, [String]) branchesPackages = branchesReqPkgs <$> branchesOpt <*> many (pkgArg "BRANCH... PACKAGE...")@@ -214,12 +233,15 @@ rebuildSrpmOpt = switchWith 's' "rebuild-srpm" "rebuild srpm in Koji" - buildOpts = BuildOpts <$> nopromptOpt <*> noFailFastOpt <*> mtargetOpt <*> overrideOpt <*> dryrunOpt <*> updatetypeOpt+ buildOpts = BuildOpts <$> mergeOpt <*> noFailFastOpt <*> mtargetOpt <*> overrideOpt <*> dryrunOpt <*> updatetypeOpt -- yesOpt = switchWith 'y' "yes" "Assume yes for questions" nopromptOpt = switchWith 'm' "no-prompt" "Merge without prompt" + mergeOpt = optional (flagWith' True 'm' "merge" "Merge without prompt" <|>+ flagWith' False 'M' "no-merge" "No merging")+ noFailFastOpt = switchWith 'f' "no-fast-fail" "Do not --fast-fail" excludeArch :: Parser String@@ -286,3 +308,13 @@ bcondOpt = BuildWith <$> strOptionWith 'w' "with" "FEATURE" "Turn on package FEATURE for build" <|> BuildWithout <$> strOptionWith 'W' "without" "FEATURE" "Turn off package FEATURE for build"++ branchesModeOpt :: Parser BranchesMode+ branchesModeOpt =+ flagWith' Remote 'r' "remote" "List remote branches" <|>+ flagWith Local Current 'c' "current" "Show current branch"++ scratchOpt :: Parser ScratchOption+ scratchOpt =+ ScratchTask <$> optionWith auto 's' "scratch-build" "TASKID" "Existing scratch build taskid" <|>+ flagWith ScratchBuild SkipScratch 'S' "no-scratch" "Skip scratch build"
src/Package.hs view
@@ -111,7 +111,7 @@ usernote <- prompt "Press Enter to use above or input notes" return $ if null usernote then notes else usernote --- FIXME maybe check spec filename/%name more carefully+-- FIXME check spec filename/%name more carefully getPackageName :: FilePath -> IO Package getPackageName pkgdir = if pkgdir == "."@@ -165,7 +165,7 @@ generateSrpm' :: Bool -> Maybe AnyBranch -> FilePath -> IO FilePath generateSrpm' force mbr spec = do- getSources spec+ srcs <- getSources spec distopt <- case mbr of Nothing -> return [] Just br -> do@@ -192,15 +192,14 @@ if not exists then buildSrpm (distopt ++ srpmdiropt ++ sourcediropt) else do- -- FIXME also compare source tarball timestamps- specTime <- getModificationTime spec srpmTime <- getModificationTime srpm- if srpmTime > specTime- then do+ 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- else buildSrpm (distopt ++ srpmdiropt ++ sourcediropt) where buildSrpm opts = do srpm <- last . words <$> cmd "rpmbuild" (opts ++ ["-bs", spec])@@ -234,7 +233,7 @@ if not needBuild then putStrLn "Existing rpms are newer than spec file (use --force to rebuild)" else do- installDeps spec+ installDeps True spec void $ getSources spec dist <- getBranchDist br cwd <- getCurrentDirectory@@ -256,13 +255,15 @@ unless ok $ error' $ "build failed for: " ++ takeBaseName spec -installDeps :: FilePath -> IO ()-installDeps spec = do+-- FIXME print unavailable deps+installDeps :: Bool -> FilePath -> IO ()+installDeps strict spec = do missingdeps <- nub <$> (buildRequires spec >>= filterM notInstalled) unless (null missingdeps) $ do putStrLn $ "Need: " ++ unwords missingdeps putStr "Running dnf builddep... "- cmdSilent "/usr/bin/sudo" $ "/usr/bin/dnf":["builddep", "--assumeyes", spec]+ -- FIXME less silent+ cmdSilent "/usr/bin/sudo" $ "/usr/bin/dnf":"builddep": ["--skip-unavailable" | not strict] ++ ["--assumeyes", spec] putStrLn "done" prepPackage :: Package -> AnyBranch -> IO ()@@ -274,7 +275,7 @@ unlessM (doesFileExist spec) $ error' $ spec ++ " not found" cwd <- getCurrentDirectory- getSources spec+ void $ getSources spec gitDir <- isGitRepo let rpmdirs = [ "--define="++ mcr +-+ cwd | gitDir,@@ -299,7 +300,7 @@ prompt_ $ color Red $ src ++ " not in sources, please fix" checkSourcesMatch spec -getSources :: FilePath -> IO ()+getSources :: FilePath -> IO [FilePath] getSources spec = do gitDir <- isGitRepo srcdir <- getSourceDir gitDir@@ -322,6 +323,7 @@ cmd_ "spectool" ["-g", "-S", "-C", srcdir, spec] unlessM (doesFileExist (srcdir </> src)) $ error' $ "download failed: " ++ src+ return srcs where sourceFieldFile :: String -> Maybe FilePath sourceFieldFile field =@@ -445,7 +447,7 @@ dirtyGit = Just $ GitOpts False False False dirtyGitFetch = Just $ GitOpts False True False -data LimitBranches = AnyNumber | ZeroOrOne | ExactlyOne+data LimitBranches = AnyNumber | Zero | ZeroOrOne | ExactlyOne deriving Eq -- do package over branches@@ -482,7 +484,10 @@ withPackageDir "." else do when (length pkgs > 1 && breq == Branches []) $- error' "At least one branch must be specified when there are multiple packages"+ case limitBranches of+ Zero -> return ()+ ZeroOrOne -> warning "Better to specify an explicit branch for multiple packages"+ _ -> error' "At least one branch must be specified when there are multiple packages" mapM_ withPackageDir pkgs where -- FIXME support arbitrary (module) branches@@ -546,10 +551,9 @@ -> Maybe GitOpts -> LimitBranches -> (Package -> AnyBranch -> IO ())- -> Maybe Branch- -> [String]+ -> (Maybe Branch,[String]) -> IO ()-withPackagesMaybeBranch mheader mgitopts limitBranches action mbr pkgs =+withPackagesMaybeBranch mheader mgitopts limitBranches action (mbr, pkgs) = withPackageByBranches mheader mgitopts limitBranches action (Branches (maybeToList mbr),pkgs) -- -- do branch over packages@@ -625,7 +629,7 @@ repoquery br args = cmd "dnf" (["repoquery", "--quiet", "--releasever=" ++ branchVersion br] ++ args) --- FIXME could be more strict about dist tag (eg .fcNN only)+-- FIXME should be more strict about dist tag (eg .fcNN only) equivNVR :: String -> String -> Bool equivNVR nvr1 nvr2 | nvr1 == nvr2 = True
src/Pagure.hs view
@@ -10,10 +10,10 @@ printScmIssue ) where +import Common ((+/+)) import qualified Common.Text as T import Fedora.Pagure-import System.FilePath srcfpo :: String srcfpo = "src.fedoraproject.org"@@ -23,6 +23,6 @@ printScmIssue :: IssueTitleStatus -> IO () printScmIssue issue =- putStrLn $ "https://" ++ pagureio </> "releng/fedora-scm-requests" </> "issue" </> show (pagureIssueId issue) ++ " (" ++ T.unpack (pagureIssueStatus issue) ++ mclosed ++ "): " ++ pagureIssueTitle issue+ putStrLn $ "https://" ++ pagureio +/+ "releng/fedora-scm-requests" +/+ "issue" +/+ show (pagureIssueId issue) ++ " (" ++ T.unpack (pagureIssueStatus issue) ++ mclosed ++ "): " ++ pagureIssueTitle issue where mclosed = maybe "" (\s-> ":" ++ T.unpack s) $ pagureIssueCloseStatus issue
src/Prompt.hs view
@@ -8,12 +8,14 @@ import Common import Data.Char+import System.IO -- FIXME promptNonEmpty prompt :: String -> IO String prompt s = do putStr $ s ++ ": "- inp <- getLine+ tty <- openFile "/dev/tty" ReadMode+ inp <- hGetLine tty putStrLn "" return inp