oglyad (empty) → 0.1.1.0

raw patch · 27 files changed

+3878/−0 lines, 27 filesdep +QuickCheckdep +aesondep +async

Dependencies added: QuickCheck, aeson, async, base, base16-bytestring, bytestring, conduit, containers, cryptohash-sha256, deepseq, directory, filepath, hspec, http-client, http-client-tls, http-types, megaparsec, mtl, optparse-applicative, temporary, text, time, typed-process, vector, xml-conduit, xml-types

Files

• CHANGELOG.md +16/−0
• LICENSE +674/−0
• README.md +191/−0
• app/Main.hs +174/−0
• oglyad.cabal +117/−0
• src/Oglyad/App.hs +185/−0
• src/Oglyad/Check.hs +56/−0
• src/Oglyad/Check/BuildLag.hs +25/−0
• src/Oglyad/Check/Drift.hs +29/−0
• src/Oglyad/Check/DuplicateName.hs +28/−0
• src/Oglyad/Check/FedoraOverlap.hs +14/−0
• src/Oglyad/Check/NoAutoupdate.hs +9/−0
• src/Oglyad/Check/Stale.hs +31/−0
• src/Oglyad/Check/UnparsedRhai.hs +15/−0
• src/Oglyad/Check/UpstreamError.hs +10/−0
• src/Oglyad/Collect.hs +241/−0
• src/Oglyad/Ignore.hs +132/−0
• src/Oglyad/Process.hs +48/−0
• src/Oglyad/Report.hs +175/−0
• src/Oglyad/Source/Cache.hs +68/−0
• src/Oglyad/Source/Monorepo.hs +248/−0
• src/Oglyad/Source/Repodata.hs +287/−0
• src/Oglyad/Source/Rhai.hs +218/−0
• src/Oglyad/Source/Upstream.hs +102/−0
• src/Oglyad/Types.hs +173/−0
• src/Oglyad/Version.hs +161/−0
• test/Spec.hs +451/−0

@@ -0,0 +1,16 @@+# changelog++## 0.1.0.0++first release.++- checks: `build-lag`, `drift`, `duplicate-name`, `fedora-overlap`,+  `no-autoupdate`, `stale`, `unparsed-rhai`, `upstream-error`+- text, markdown and json output, with a versioned json envelope+- `--fail-on` and distinct exit codes for automation+- ignore files and `oglyad_ignore` labels in anda.hcl+- caching of spec evaluations, repodata, commit times and upstream answers++## 0.1.1.0++prepare for release on Hackage

@@ -0,0 +1,674 @@+                    GNU GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++                            Preamble++  The GNU General Public License is a free, copyleft license for+software and other kinds of works.++  The licenses for most software and other practical works are designed+to take away your freedom to share and change the works.  By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users.  We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors.  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, not+price.  Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++  To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights.  Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received.  You must make sure that they, too, receive+or can get the source code.  And you must show them these terms so they+know their rights.++  Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++  For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software.  For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++  Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so.  This is fundamentally incompatible with the aim of+protecting users' freedom to change the software.  The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable.  Therefore, we+have designed this version of the GPL to prohibit the practice for those+products.  If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++  Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary.  To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++  The precise terms and conditions for copying, distribution and+modification follow.++                       TERMS AND CONDITIONS++  0. Definitions.++  "This License" refers to version 3 of the GNU General Public License.++  "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++  "The Program" refers to any copyrightable work licensed under this+License.  Each licensee is addressed as "you".  "Licensees" and+"recipients" may be individuals or organizations.++  To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy.  The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++  A "covered work" means either the unmodified Program or a work based+on the Program.++  To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy.  Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++  To "convey" a work means any kind of propagation that enables other+parties to make or receive copies.  Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++  An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License.  If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++  1. Source Code.++  The "source code" for a work means the preferred form of the work+for making modifications to it.  "Object code" means any non-source+form of a work.++  A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++  The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form.  A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++  The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities.  However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work.  For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++  The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++  The Corresponding Source for a work in source code form is that+same work.++  2. Basic Permissions.++  All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met.  This License explicitly affirms your unlimited+permission to run the unmodified Program.  The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work.  This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++  You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force.  You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright.  Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++  Conveying under any other circumstances is permitted solely under+the conditions stated below.  Sublicensing is not allowed; section 10+makes it unnecessary.++  3. Protecting Users' Legal Rights From Anti-Circumvention Law.++  No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++  When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++  4. Conveying Verbatim Copies.++  You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++  You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++  5. Conveying Modified Source Versions.++  You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++    a) The work must carry prominent notices stating that you modified+    it, and giving a relevant date.++    b) The work must carry prominent notices stating that it is+    released under this License and any conditions added under section+    7.  This requirement modifies the requirement in section 4 to+    "keep intact all notices".++    c) You must license the entire work, as a whole, under this+    License to anyone who comes into possession of a copy.  This+    License will therefore apply, along with any applicable section 7+    additional terms, to the whole of the work, and all its parts,+    regardless of how they are packaged.  This License gives no+    permission to license the work in any other way, but it does not+    invalidate such permission if you have separately received it.++    d) If the work has interactive user interfaces, each must display+    Appropriate Legal Notices; however, if the Program has interactive+    interfaces that do not display Appropriate Legal Notices, your+    work need not make them do so.++  A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit.  Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++  6. Conveying Non-Source Forms.++  You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++    a) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by the+    Corresponding Source fixed on a durable physical medium+    customarily used for software interchange.++    b) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by a+    written offer, valid for at least three years and valid for as+    long as you offer spare parts or customer support for that product+    model, to give anyone who possesses the object code either (1) a+    copy of the Corresponding Source for all the software in the+    product that is covered by this License, on a durable physical+    medium customarily used for software interchange, for a price no+    more than your reasonable cost of physically performing this+    conveying of source, or (2) access to copy the+    Corresponding Source from a network server at no charge.++    c) Convey individual copies of the object code with a copy of the+    written offer to provide the Corresponding Source.  This+    alternative is allowed only occasionally and noncommercially, and+    only if you received the object code with such an offer, in accord+    with subsection 6b.++    d) Convey the object code by offering access from a designated+    place (gratis or for a charge), and offer equivalent access to the+    Corresponding Source in the same way through the same place at no+    further charge.  You need not require recipients to copy the+    Corresponding Source along with the object code.  If the place to+    copy the object code is a network server, the Corresponding Source+    may be on a different server (operated by you or a third party)+    that supports equivalent copying facilities, provided you maintain+    clear directions next to the object code saying where to find the+    Corresponding Source.  Regardless of what server hosts the+    Corresponding Source, you remain obligated to ensure that it is+    available for as long as needed to satisfy these requirements.++    e) Convey the object code using peer-to-peer transmission, provided+    you inform other peers where the object code and Corresponding+    Source of the work are being offered to the general public at no+    charge under subsection 6d.++  A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++  A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling.  In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage.  For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product.  A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++  "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source.  The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++  If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information.  But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++  The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed.  Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++  Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++  7. Additional Terms.++  "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law.  If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++  When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it.  (Additional permissions may be written to require their own+removal in certain cases when you modify the work.)  You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++  Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++    a) Disclaiming warranty or limiting liability differently from the+    terms of sections 15 and 16 of this License; or++    b) Requiring preservation of specified reasonable legal notices or+    author attributions in that material or in the Appropriate Legal+    Notices displayed by works containing it; or++    c) Prohibiting misrepresentation of the origin of that material, or+    requiring that modified versions of such material be marked in+    reasonable ways as different from the original version; or++    d) Limiting the use for publicity purposes of names of licensors or+    authors of the material; or++    e) Declining to grant rights under trademark law for use of some+    trade names, trademarks, or service marks; or++    f) Requiring indemnification of licensors and authors of that+    material by anyone who conveys the material (or modified versions of+    it) with contractual assumptions of liability to the recipient, for+    any liability that these contractual assumptions directly impose on+    those licensors and authors.++  All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10.  If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term.  If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++  If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++  Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++  8. Termination.++  You may not propagate or modify a covered work except as expressly+provided under this License.  Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++  However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++  Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++  Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License.  If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++  9. Acceptance Not Required for Having Copies.++  You are not required to accept this License in order to receive or+run a copy of the Program.  Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance.  However,+nothing other than this License grants you permission to propagate or+modify any covered work.  These actions infringe copyright if you do+not accept this License.  Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++  10. Automatic Licensing of Downstream Recipients.++  Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License.  You are not responsible+for enforcing compliance by third parties with this License.++  An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations.  If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++  You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License.  For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++  11. Patents.++  A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based.  The+work thus licensed is called the contributor's "contributor version".++  A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version.  For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++  Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++  In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement).  To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++  If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients.  "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++  If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++  A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License.  You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++  Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++  12. No Surrender of Others' Freedom.++  If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all.  For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++  13. Use with the GNU Affero General Public License.++  Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work.  The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++  14. Revised Versions of this License.++  The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time.  Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++  Each version is given a distinguishing version number.  If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation.  If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++  If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++  Later license versions may give you additional or different+permissions.  However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++  15. Disclaimer of Warranty.++  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++  16. Limitation of Liability.++  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++  17. Interpretation of Sections 15 and 16.++  If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++                     END OF TERMS AND CONDITIONS++            How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++    <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 3 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program.  If not, see <https://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++  If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++    <program>  Copyright (C) <year>  <name of author>+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+    This is free software, and you are welcome to redistribute it+    under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License.  Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++  You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<https://www.gnu.org/licenses/>.++  The GNU General Public License does not permit incorporating your program+into proprietary programs.  If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library.  If this is what you want to do, use the GNU Lesser General+Public License instead of this License.  But first, please read+<https://www.gnu.org/licenses/why-not-lgpl.html>.

@@ -0,0 +1,191 @@+# oglyad++repository metadata and health checker for [Terra](https://terra.fyralabs.com).+"огляд" is Ukrainian for "review" or "inspection".++```sh+git clone https://github.com/terrapkg/packages ../packages+oglyad -m ../packages            # warnings and errors+oglyad -m ../packages -v         # plus info findings+oglyad -m ../packages -u         # plus upstream version drift+oglyad -m ../packages --fedora   # plus overlap with Fedora+oglyad -m ../packages --only drift --format json+```++from a checkout, `cabal run oglyad -- <args>` and `cabal test`. it needs+`rpmspec` (rpm-build), `git`, and the `zstd`, `gzip` and `xz` commands.+upstream lookups use `GITHUB_TOKEN`, or `gh auth token` when that's unset.++## output and exit codes++`--format` picks `text` (default), `markdown` (made for GitHub job+summaries) or `json`. the json is a versioned envelope:++```json+{"schema": 1, "oglyad": "0.1.0.0", "generated": "...", "monorepo_head": "...",+ "summary": {"error": 0, "warn": 0, "info": 0, "ignored": 0},+ "findings": [{"check": "...", "package": "...", "path": "...", "severity": "...", "message": "..."}],+ "ignored": [...]}+```++`schema` changes on any breaking change to the json.++| exit | meaning |+|---|---|+| 0 | ran, nothing at or above `--fail-on` (default `error`, or `warn`, `info`, `never`) |+| 1 | ran, and found something at or above `--fail-on` |+| 2 | couldn't run: bad flags, unreadable ignore file, not a monorepo |++## ignoring known findings++some findings are intentional, like a bootstrap package sharing its real+package's name. there are two ways to silence one, and ignored findings+don't count toward the exit code.++an ignore file, passed with `--ignore-file`. every entry needs a reason, and+names one check plus a monorepo `path` or a `package` name:++```json+{+  "ignore": [+    {"check": "duplicate-name", "path": "anda/langs/zig/master-bootstrap",+     "reason": "bootstrap build of zig-master"}+  ]+}+```++or a label in the package's own `anda.hcl`:++```hcl+labels {+  oglyad_ignore = "duplicate-name, stale"+}+```++file entries that no longer match anything are reported as `unused-ignore`,+so exceptions don't outlive their reason. `--no-ignores` shows everything.+[`ignores.json`](ignores.json) is the file the nightly report uses.++## checks++| check | severity | what it means |+|---|---|---|+| `build-lag` | error / warn / info | never published, merged but not built, or the repo is newer than your checkout |+| `drift` | warn | upstream released something newer than the spec (`-u`) |+| `duplicate-name` | warn | two directories build the same package name into the same repo, so they overwrite each other |+| `stale` | info, warn with `-u` | last build is older than `--stale-days`, warn if upstream also moved on |+| `upstream-error` | warn | the upstream from update.rhai 404s or fails, so `anda update` is failing too |+| `fedora-overlap` | warn | Fedora ships the same source package (`--fedora`). subrepos are exempt |+| `no-autoupdate` | info | no update.rhai |+| `unparsed-rhai` | info | update.rhai does something oglyad can't follow, like custom scraping |+| `collect` | error | rpmspec failed, a repo couldn't be fetched, or an upstream rate-limited us (warn) |+| `unused-ignore` | info / warn | an ignore entry matches nothing, or an `oglyad_ignore` label names an unknown check |++## how it works++```+ ┌──────────── IO shell (Collect) ──┐      ┌──── pure core ────┐     ┌─ IO ─┐+ monorepo: rpmspec, git ──┐+ Terra repodata + subrepos├─► Snapshot ───► [Check] ─► [Finding] ─► Report+ Fedora repodata ─────────┤+ upstream APIs ───────────┘+```++checks are `Snapshot -> Package -> [Finding]` and never do IO, so each one is+tested with a fake `Snapshot` in `test/Spec.hs`.++- **specs** are evaluated with `rpmspec`+- **update.rhai** is lexed and pattern-matched, not run. it follows `let`+  bindings into `rpm.version(...)` / `rpm.global("ver", ...)` and recognizes+  the andax helpers (`gh`, `pypi`, `crates`, `gitlab`, ...)+- **upstream lookups** hit the same endpoints anda does, so oglyad sees what+  `anda update` would+- **versions** compare with a port of rpm's `rpmvercmp`, plus some forgiveness+  for respelled tags (`v1.2`, `1.2-rc1` vs `1.2~rc1`, `2026-07-27` vs `20260727`)++## caching++everything lives in `~/.cache/oglyad`.++| file | reused while |+|---|---|+| `specs.fcNN.json` | the package dir's files, the dist tag, and rpm's whole macro state (`rpm --showrc`) are unchanged |+| `commits.json` | HEAD hasn't moved |+| `repodata-*.json` | the repo's primary.xml checksum is unchanged |+| `upstream.json` | younger than `--cache-hours` (default 6), successes only. entries unused for 30 days are dropped |++a run with warm caches takes about 0.4s. a cold run takes about 5s, almost+all of it in rpmspec. `--fedora` adds about 8s and peaks around 200MB of+memory the first time, since Fedora's repodata is 260MB decompressed. after+that it's cached until Fedora publishes again.++## security++`rpmspec` runs the shell code in specs (`%(...)`, `%{lua:...}`), so running+oglyad on a checkout means running that checkout's code as you. child+processes get an allowlisted environment, so `GITHUB_TOKEN` and other+secrets in oglyad's environment never reach them, but code running as your+user can still read your files.++**don't run oglyad on untrusted code, like an unmerged pull request, with+credentials around.** the nightly report only checks out terrapkg/packages'+default branch, and its token is read-only and expires with the job.++the GitHub token is only ever sent to `api.github.com`, and is dropped if a+request gets redirected anywhere else.++## nightly report++[`report.yml`](.github/workflows/report.yml) runs every night in Terra's+builder image (`ghcr.io/terrapkg/builder:f45`), so specs evaluate with the+same macros Terra builds with. it builds `oglyad-git` with anda, checks+terrapkg/packages' default branch with `-u --fedora`, writes the markdown+report to the run's summary, and keeps the markdown and json for 30 days.+caches carry over between nights.++## packaging++built the same way as anda itself. [`anda.hcl`](anda.hcl) has two projects:++| project | spec | builds |+|---|---|---|+| `oglyad` | [`oglyad.spec`](oglyad.spec) | the `v<version>` release tag |+| `oglyad-git` | [`oglyad-git.spec`](oglyad-git.spec) | the checked-out commit, versioned `<version>^<date>.<commit>` |++```sh+anda build oglyad-git --package rpm -c terra-45-x86_64+```++both build in mock, offline, against Fedora's Haskell libraries with+`%ghc_bin_build`, run the test suite in `%check`, and ship one self-contained+binary. [`package-git.yml`](.github/workflows/package-git.yml) builds+`oglyad-git` on x86_64 and aarch64 for every push to main and every pull+request that touches the code.++## releasing++1. bump `version` in `oglyad.cabal` and `oglyad.spec`, and add a+   `CHANGELOG.md` entry+2. push a `v<version>` tag, e.g. `v0.1.0.0`++[`hackage.yml`](.github/workflows/hackage.yml) checks the tag matches the+cabal version, builds and tests the sdist, and publishes it to Hackage. the+same tag is what `oglyad.spec` downloads. to preview a release first, run the+workflow by hand, which uploads a Hackage package candidate instead.++it needs a `HACKAGE_TOKEN` secret (an API token from your Hackage account) in+a GitHub environment named `hackage`.++## formatting++code is formatted with [ormolu](https://github.com/tweag/ormolu) 0.9.0.0, and+CI fails on unformatted files. install the matching version from its+[release page](https://github.com/tweag/ormolu/releases/tag/0.9.0.0), then:++```sh+ormolu --mode inplace $(git ls-files '*.hs')+```++## license++GPL-3.0-or-later. see [LICENSE](LICENSE).

@@ -0,0 +1,174 @@+{-# LANGUAGE ApplicativeDo #-}++-- ApplicativeDo lets configP use do-notation even though optparse's Parser+-- is only an Applicative, not a Monad+module Main (main) where++import Control.Exception (SomeException, try)+import Control.Monad (unless, when)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as LBS+import Data.Text (Text)+import Data.Text qualified as T+import Data.Time (getCurrentTime)+import GHC.Conc (getNumProcessors)+import GHC.IO.Encoding (setFileSystemEncoding, setForeignEncoding, setLocaleEncoding, utf8)+import Oglyad.App (oglyadVersion, runApp)+import Oglyad.Check (checkNames, parseCheckName, runChecks)+import Oglyad.Collect (buildSnapshot)+import Oglyad.Ignore (Applied (..), IgnoreFile (..), applyIgnores, parseIgnoreFile)+import Oglyad.Process (run)+import Oglyad.Report (Format (..), Report (..), render)+import Oglyad.Types+import Options.Applicative+import System.Directory (doesDirectoryExist)+import System.Environment (getArgs, getProgName, lookupEnv)+import System.Exit (ExitCode (..), exitWith)+import System.FilePath ((</>))+import System.IO (hPutStrLn, hSetEncoding, stderr, stdout)++-- | exit codes, so cron jobs and CI can tell "found problems" apart from+-- "couldn't run"+exitFindings, exitUsage :: ExitCode+exitFindings = ExitFailure 1+exitUsage = ExitFailure 2++data Opts = Opts+  { optConfig :: Maybe Text -> Int -> Config,+    optOnly :: [Text],+    optFormat :: Format,+    optMinSev :: Severity,+    -- | Nothing means never fail on findings+    optFailOn :: Maybe Severity,+    optIgnoreFile :: Maybe FilePath,+    optNoIgnores :: Bool+  }++optsP :: Parser Opts+optsP = do+  optConfig <- configP+  optOnly <- many (option (eitherReader parseCheckName) (long "only" <> metavar "CHECK" <> help ("run only this check, repeatable. one of: " <> names)))+  optFormat <-+    option (eitherReader format) (long "format" <> short 'f' <> metavar "FORMAT" <> help "text (default), json, or markdown")+      <|> flag' Json (long "json" <> help "same as --format json")+      <|> pure Text+  optMinSev <-+    flag' Info (long "verbose" <> short 'v' <> help "show info findings too")+      <|> pure Warn+  optFailOn <- option (eitherReader failOn) (long "fail-on" <> metavar "LEVEL" <> value (Just Error) <> help "exit 1 if any finding is at least this severe: error (default), warn, info, or never")+  optIgnoreFile <- optional (strOption (long "ignore-file" <> metavar "FILE" <> help "json file of known findings to ignore, see README"))+  optNoIgnores <- switch (long "no-ignores" <> help "report everything, ignoring the ignore file and anda.hcl oglyad_ignore labels")+  pure Opts {..}+  where+    names = T.unpack (T.intercalate ", " checkNames)+    format = \case+      "text" -> Right Text+      "json" -> Right Json+      "markdown" -> Right Markdown+      other -> Left ("unknown format " <> show other <> ", expected text, json or markdown")+    failOn = \case+      "error" -> Right (Just Error)+      "warn" -> Right (Just Warn)+      "info" -> Right (Just Info)+      "never" -> Right Nothing+      other -> Left ("unknown level " <> show other <> ", expected error, warn, info or never")++configP :: Parser (Maybe Text -> Int -> Config)+configP = do+  cfgMonorepo <- strOption (long "monorepo" <> short 'm' <> metavar "DIR" <> value "." <> showDefault <> help "checkout of terrapkg/packages")+  release <- option auto (long "release" <> short 'r' <> metavar "N" <> value (44 :: Int) <> showDefault <> help "Fedora/Terra release to check")+  terraRepo <- optional (strOption (long "repo" <> metavar "URL" <> help "Terra repo base url (default: https://repos.fyralabs.com/terraN)"))+  fedora <- switch (long "fedora" <> help "also check for overlap with Fedora's release and updates repos (downloads ~60MB)")+  extraFedora <- many (strOption (long "fedora-repo" <> metavar "URL" <> help "extra repo base url to check for overlap, repeatable"))+  staleDays <- option auto (long "stale-days" <> metavar "N" <> value (180 :: Int) <> showDefault <> help "builds older than this count as stale")+  cfgUpstream <- switch (long "upstream" <> short 'u' <> help "query upstream APIs for version drift")+  cacheHours <- option auto (long "cache-hours" <> metavar "N" <> value (6 :: Int) <> showDefault <> help "reuse upstream answers younger than this, 0 to always refetch")+  jobs <- optional (option auto (long "jobs" <> short 'j' <> metavar "N" <> help "parallel jobs (default: number of cores)"))+  pure $ \cfgGitHubToken cores ->+    let r = T.pack (show release)+        fedoraRepos =+          [ "https://dl.fedoraproject.org/pub/fedora/linux/releases/" <> r <> "/Everything/x86_64/os",+            "https://dl.fedoraproject.org/pub/fedora/linux/updates/" <> r <> "/Everything/x86_64"+          ]+     in Config+          { cfgTerraRepo = maybe ("https://repos.fyralabs.com/terra" <> r) id terraRepo,+            cfgFedoraRepos = (if fedora then fedoraRepos else []) <> extraFedora,+            cfgRelease = release,+            cfgDist = ".fc" <> r,+            cfgStaleAfter = fromIntegral (staleDays * 86400),+            cfgCacheFor = fromIntegral (cacheHours * 3600),+            cfgConcurrency = maybe cores id jobs,+            ..+          }++-- | GITHUB_TOKEN, or whatever the gh cli is logged in with. the token is only+-- ever sent to api.github.com, and never passed to child processes+githubToken :: IO (Maybe Text)+githubToken =+  lookupEnv "GITHUB_TOKEN" >>= \case+    Just t | not (null t) -> pure (Just (T.pack t))+    _ -> either (const Nothing) (nonEmpty . T.strip) <$> run "gh" ["auth", "token"]+  where+    nonEmpty t = if T.null t then Nothing else Just t++-- | like execParser, but bad arguments exit with 'exitUsage' instead of 1+parseOpts :: IO Opts+parseOpts = do+  args <- getArgs+  prog <- getProgName+  let pinfo =+        info+          (optsP <**> helper <**> simpleVersioner ("oglyad " <> T.unpack oglyadVersion))+          (fullDesc <> progDesc "repository metadata and health checker for Terra")+  case execParserPure defaultPrefs pinfo args of+    Failure f -> do+      let (msg, code) = renderFailure f prog+      hPutStrLn stderr msg+      exitWith (if code == ExitSuccess then ExitSuccess else exitUsage)+    other -> handleParseResult other++usageError :: String -> IO a+usageError msg = hPutStrLn stderr ("oglyad: " <> msg) >> exitWith exitUsage++main :: IO ()+main = do+  -- cron and CI often run under LANG=C. specs, anda.hcl and rpmspec errors+  -- contain non-ascii text, which would crash text IO in a C locale+  mapM_ ($ utf8) [setLocaleEncoding, setFileSystemEncoding, setForeignEncoding]+  mapM_ (`hSetEncoding` utf8) [stdout, stderr]++  Opts {..} <- parseOpts+  ignores <- case optIgnoreFile of+    Nothing -> pure (IgnoreFile [])+    Just path -> do+      raw <- try (BS.readFile path)+      case raw of+        Left (e :: SomeException) -> usageError ("can't read ignore file " <> path <> ": " <> show e)+        Right bytes -> either (\e -> usageError (path <> ": " <> e)) pure (parseIgnoreFile checkNames bytes)+  token <- githubToken+  cores <- getNumProcessors+  let cfg = optConfig token cores+  hasAnda <- doesDirectoryExist (cfgMonorepo cfg </> "anda")+  unless hasAnda $+    usageError (cfgMonorepo cfg <> " doesn't look like a terrapkg/packages checkout (no anda/ directory). point -m at one")++  (snap, collectFindings) <- runApp cfg buildSnapshot+  now <- getCurrentTime+  let ran = if null optOnly then checkNames else optOnly+      findings = collectFindings <> runChecks optOnly snap+      Applied {..}+        | optNoIgnores = Applied findings [] []+        | otherwise = applyIgnores checkNames ran ignores (snapIgnoreLabels snap) findings+      report =+        Report+          { rVersion = oglyadVersion,+            rGenerated = now,+            rMonorepoHead = snapHead snap,+            rTerraRepo = cfgTerraRepo cfg,+            rUpstream = cfgUpstream cfg,+            rFindings = apKept <> apProblems,+            rIgnored = apIgnored+          }+  LBS.putStr (render optFormat optMinSev report)+  when (maybe False (\level -> any ((>= level) . fSeverity) (rFindings report)) optFailOn) $+    exitWith exitFindings

@@ -0,0 +1,117 @@+cabal-version:   3.0+name:            oglyad+version:         0.1.1.0+synopsis:        repository metadata and health checker for Terra+description:+  oglyad checks a terrapkg/packages checkout against Terra's published+  repodata and upstream releases. it reports packages that never got built,+  stale builds, upstream version drift, broken update.rhai scripts, and+  overlap with Fedora.++category:        Distribution+homepage:        https://github.com/terrapkg/oglyad+bug-reports:     https://github.com/terrapkg/oglyad/issues+license:         GPL-3.0-or-later+license-file:    LICENSE+author:          Cypress Reed+maintainer:      cypress@fyralabs.com+build-type:      Simple+extra-doc-files:+  CHANGELOG.md+  README.md++-- the lower bounds are what Fedora ships, which CI builds against. the upper+-- bounds follow the PVP from the newest versions that have been built+tested-with:     GHC ==9.10.3++source-repository head+  type:     git+  location: https://github.com/terrapkg/oglyad.git++common shared+  default-language:   GHC2021+  default-extensions:+    DerivingStrategies+    DeriveAnyClass+    LambdaCase+    MultiWayIf+    OverloadedStrings+    RecordWildCards++  ghc-options:+    -Wall -Wcompat -Widentities -Wincomplete-uni-patterns+    -Wincomplete-record-updates -Wredundant-constraints++  build-depends:+    , base                 >=4.20 && <4.21+    , containers           >=0.7 && <0.8+    , deepseq              >=1.5 && <1.6+    , text                 >=2.1.3 && <2.2+    , time                 >=1.12.2 && <1.13++-- the modules shared by the binary and the test suite. there's deliberately+-- no library: packaged with Fedora's ghc-rpm-macros, an internal library+-- turns into a private .so that also links the test suite's dependencies+common modules+  hs-source-dirs:  src+  other-modules:+    Oglyad.App+    Oglyad.Check+    Oglyad.Check.BuildLag+    Oglyad.Check.Drift+    Oglyad.Check.DuplicateName+    Oglyad.Check.FedoraOverlap+    Oglyad.Check.NoAutoupdate+    Oglyad.Check.Stale+    Oglyad.Check.UnparsedRhai+    Oglyad.Check.UpstreamError+    Oglyad.Collect+    Oglyad.Ignore+    Oglyad.Process+    Oglyad.Report+    Oglyad.Source.Cache+    Oglyad.Source.Monorepo+    Oglyad.Source.Repodata+    Oglyad.Source.Rhai+    Oglyad.Source.Upstream+    Oglyad.Types+    Oglyad.Version+    Paths_oglyad++  autogen-modules: Paths_oglyad+  build-depends:+    , aeson                >=2.2.3 && <2.4+    , async                >=2.2.6 && <2.3+    , base16-bytestring    >=1.0.2 && <1.1+    , bytestring           >=0.12.2 && <0.13+    , conduit              >=1.3.6 && <1.4+    , cryptohash-sha256    >=0.11.102 && <0.12+    , directory            >=1.3.8 && <1.4+    , filepath             >=1.5.4 && <1.6+    , http-client          >=0.7.19 && <0.8+    , http-client-tls      >=0.3.6 && <0.5+    , http-types           >=0.12.4 && <0.13+    , megaparsec           >=9.7 && <9.9+    , mtl                  >=2.3.1 && <2.4+    , typed-process        >=0.2.13 && <0.3+    , vector               >=0.13.2 && <0.14+    , xml-conduit          >=1.10.1 && <1.11+    , xml-types            >=0.3.8 && <0.4++executable oglyad+  import:         shared, modules+  hs-source-dirs: app+  main-is:        Main.hs+  ghc-options:    -threaded -rtsopts "-with-rtsopts=-N4"+  build-depends:  optparse-applicative >=0.18.1 && <0.20++test-suite oglyad-test+  import:         shared, modules+  type:           exitcode-stdio-1.0+  hs-source-dirs: test+  main-is:        Spec.hs+  ghc-options:    -threaded+  build-depends:+    , hspec                >=2.11.16 && <2.12+    , QuickCheck           >=2.15 && <2.20+    , temporary            >=1.3 && <1.4

@@ -0,0 +1,185 @@+-- | the app monad. plain ReaderT over IO is the boring, correct starting point.+-- reach for mtl classes or an effect library only once this actually hurts+module Oglyad.App+  ( Env (..),+    App,+    HttpError (..),+    runApp,+    httpGetE,+    forConcurrentlyN,+    note,+    oglyadVersion,+  )+where++import Control.Concurrent (threadDelay)+import Control.Concurrent.Async (forConcurrently)+import Control.Concurrent.MVar (MVar, newMVar, withMVar)+import Control.Concurrent.QSem (QSem, newQSem, signalQSem, waitQSem)+import Control.Exception (bracket_, throwIO, try)+import Control.Monad.Reader (ReaderT, ask, asks, liftIO, runReaderT)+import Data.ByteString (ByteString)+import Data.ByteString.Char8 qualified as BS8+import Data.ByteString.Lazy qualified as LBS+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Data.Time.Clock.POSIX (getPOSIXTime)+import Data.Version (showVersion)+import Network.HTTP.Client+  ( HttpException (..),+    HttpExceptionContent (..),+    Manager,+    Request (requestHeaders, shouldStripHeaderOnRedirect),+    Response,+    brReadSome,+    parseUrlThrow,+    responseBody,+    responseHeaders,+    responseStatus,+    withResponse,+  )+import Network.HTTP.Client.TLS (newTlsManager)+import Network.HTTP.Types (hAuthorization, statusCode)+import Oglyad.Types (Config (..))+import Paths_oglyad (version)+import System.IO (hPutStrLn, stderr)++data Env = Env+  { envConfig :: Config,+    envHttp :: Manager,+    -- | crates.io allows one request per second+    envCratesLock :: MVar (),+    -- | GitHub's secondary rate limits punish lots of concurrent requests+    envGitHubSem :: QSem,+    -- | set once GitHub rate-limits us, so the remaining lookups are skipped+    -- instead of each failing (and being reported) separately+    envGitHubLimited :: IORef (Maybe Text),+    -- | serializes progress messages so concurrent jobs can't interleave lines+    envLogLock :: MVar ()+  }++type App = ReaderT Env IO++data HttpError+  = -- | the server said slow down. not the upstream's fault, so not cached+    -- and not reported per package+    RateLimited Text+  | HttpFailed Text+  deriving stock (Eq, Show)++oglyadVersion :: Text+oglyadVersion = T.pack (showVersion version)++-- | identifies us to upstream APIs (crates.io's policy asks for this)+userAgent :: ByteString+userAgent = TE.encodeUtf8 ("oglyad/" <> oglyadVersion <> " (+https://github.com/terrapkg/oglyad)")++-- | no single response may be larger than this. Fedora's compressed+-- primary.xml is the biggest thing we fetch, at around 30MB+maxBody :: Int+maxBody = 256 * 1024 * 1024++runApp :: Config -> App a -> IO a+runApp cfg act = do+  mgr <- newTlsManager+  lock <- newMVar ()+  ghSem <- newQSem 6+  limited <- newIORef Nothing+  logLock <- newMVar ()+  runReaderT act (Env cfg mgr lock ghSem limited logLock)++-- | progress messages go to stderr so stdout stays clean for --json+note :: String -> App ()+note msg = do+  lock <- asks envLogLock+  liftIO (withMVar lock (\_ -> hPutStrLn stderr ("oglyad: " <> msg)))++isGitHubApi :: Text -> Bool+isGitHubApi = T.isPrefixOf "https://api.github.com/"++-- | GET a url, throwing on non-2xx+httpGet :: Text -> App LBS.ByteString+httpGet url = do+  Env {..} <- ask+  req <- liftIO (parseUrlThrow (T.unpack url))+  let auth = case cfgGitHubToken envConfig of+        Just t | isGitHubApi url -> [(hAuthorization, "Bearer " <> TE.encodeUtf8 t)]+        _ -> []+      req' =+        req+          { requestHeaders = ("User-Agent", userAgent) : auth <> requestHeaders req,+            -- never forward the token if a redirect goes somewhere else+            shouldStripHeaderOnRedirect = (== hAuthorization)+          }+      fetch = withResponse req' envHttp $ \resp -> do+        body <- brReadSome (responseBody resp) (maxBody + 1)+        if LBS.length body > fromIntegral maxBody+          then throwIO (userError ("response from " <> T.unpack url <> " is over 256MiB"))+          else pure body+  liftIO $+    if+      | "https://crates.io/" `T.isPrefixOf` url -> withMVar envCratesLock (\_ -> fetch <* threadDelay 1_000_000)+      | isGitHubApi url -> bracket_ (waitQSem envGitHubSem) (signalQSem envGitHubSem) fetch+      | otherwise -> fetch++-- | GET a url, with failures as a short readable Left instead of an+-- exception. a rate limit with a short Retry-After gets one retry. a GitHub+-- rate limit beyond that stops all further GitHub requests for this run+httpGetE :: Text -> App (Either HttpError LBS.ByteString)+httpGetE url = do+  env@Env {..} <- ask+  limited <- liftIO (readIORef envGitHubLimited)+  case limited of+    Just why | isGitHubApi url -> pure (Left (RateLimited why))+    _ -> liftIO (attempt env (1 :: Int))+  where+    attempt env@Env {..} n = do+      r <- try (runReaderT (httpGet url) env)+      case r of+        Right body -> pure (Right body)+        Left (HttpExceptionRequest _ (StatusCodeException resp _)) -> do+          wait <- rateLimitWait resp+          case wait of+            Just secs | n == 1 && secs <= 60 -> do+              threadDelay ((secs + 1) * 1_000_000)+              attempt env (n + 1)+            Just _ -> do+              let why = "rate limited by " <> host+              if isGitHubApi url then writeIORef envGitHubLimited (Just why) else pure ()+              pure (Left (RateLimited why))+            Nothing -> pure (Left (HttpFailed ("HTTP " <> T.pack (show (statusCode (responseStatus resp))) <> " from " <> url)))+        Left (HttpExceptionRequest _ content) -> pure (Left (HttpFailed (T.pack (show content) <> " from " <> url)))+        Left (InvalidUrlException u why) -> pure (Left (HttpFailed ("invalid url " <> T.pack u <> ": " <> T.pack why)))+    host = T.takeWhile (/= '/') (T.drop 8 url)++-- | if this response is a rate limit, how many seconds until it lifts.+-- GitHub signals its primary limit with a 403 and x-ratelimit-remaining: 0,+-- and its secondary limit (too many concurrent requests) with a 403 or 429+-- plus retry-after+rateLimitWait :: Response () -> IO (Maybe Int)+rateLimitWait resp = do+  now <- floor <$> getPOSIXTime+  let header k = lookup k (responseHeaders resp)+      num = fmap fst . (BS8.readInt =<<)+      status = statusCode (responseStatus resp)+      retryAfter = num (header "retry-after")+      untilReset = (\t -> max 0 (t - now)) <$> num (header "x-ratelimit-reset")+      exhausted = header "x-ratelimit-remaining" == Just "0"+  pure $+    if+      | status == 429 || (status == 403 && (exhausted || retryAfter /= Nothing)) ->+          Just (maybe (maybe 3600 id untilReset) id retryAfter)+      | otherwise -> Nothing++-- | run an action over a list with at most n in flight at once.+-- 'forConcurrently' lives in IO, so we grab the env and re-run App inside each+-- thread. that dance is exactly what MonadUnliftIO (from unliftio) automates+forConcurrentlyN :: Int -> [a] -> (a -> App b) -> App [b]+forConcurrentlyN n xs f = do+  env <- ask+  liftIO $ do+    sem <- newQSem (max 1 n)+    forConcurrently xs $ \x ->+      bracket_ (waitQSem sem) (signalQSem sem) (runReaderT (f x) env)

@@ -0,0 +1,56 @@+-- | the check registry. adding a check = write a module, add a line here+module Oglyad.Check+  ( allChecks,+    checkNames,+    parseCheckName,+    runChecks,+  )+where++import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Oglyad.Check.BuildLag qualified as BuildLag+import Oglyad.Check.Drift qualified as Drift+import Oglyad.Check.DuplicateName qualified as DuplicateName+import Oglyad.Check.FedoraOverlap qualified as FedoraOverlap+import Oglyad.Check.NoAutoupdate qualified as NoAutoupdate+import Oglyad.Check.Stale qualified as Stale+import Oglyad.Check.UnparsedRhai qualified as UnparsedRhai+import Oglyad.Check.UpstreamError qualified as UpstreamError+import Oglyad.Types++allChecks :: [(Text, Check)]+allChecks =+  [ ("build-lag", BuildLag.check),+    ("drift", Drift.check),+    ("duplicate-name", DuplicateName.check),+    ("fedora-overlap", FedoraOverlap.check),+    ("no-autoupdate", NoAutoupdate.check),+    ("stale", Stale.check),+    ("unparsed-rhai", UnparsedRhai.check),+    ("upstream-error", UpstreamError.check)+  ]++checkNames :: [Text]+checkNames = map fst allChecks++-- | validate a check name from the command line. a typo has to be an error,+-- otherwise `--only buildlag` quietly runs nothing and reports all clear+parseCheckName :: String -> Either String Text+parseCheckName raw+  | name `elem` checkNames = Right name+  | otherwise =+      Left ("unknown check " <> show raw <> ", expected one of: " <> T.unpack (T.intercalate ", " checkNames))+  where+    name = T.pack raw++-- | run the named checks (all of them when the list is empty) over every package+runChecks :: [Text] -> Snapshot -> [Finding]+runChecks only snap =+  [ f+  | (name, chk) <- allChecks,+    null only || name `elem` only,+    pkg <- Map.elems (snapPackages snap),+    f <- chk snap pkg+  ]

@@ -0,0 +1,25 @@+-- | what's merged in git doesn't match what's published+module Oglyad.Check.BuildLag (check) where++import Oglyad.Types+import Oglyad.Version (compareEVR, renderEVR)++check :: Check+check _ p@Package {..} = case (pkgSpecEVR, pkgRepoBuild) of+  -- the repo fetch failed, which is already a collect error. claiming every+  -- package in it was never published would bury that under noise+  _ | not pkgRepoChecked -> []+  (Just spec, Nothing) ->+    [finding' Error ("never published (spec is at " <> renderEVR spec <> ")")]+  (Just spec, Just RepoBuild {rbEVR = repo})+    | spec == repo -> []+    | otherwise -> case compareEVR spec repo of+        -- merged but not built: the build failed or is still queued+        GT -> [finding' Warn ("spec is at " <> renderEVR spec <> " but repo has " <> renderEVR repo)]+        -- the repo is newer than git, so the monorepo checkout is behind+        LT -> [finding' Info ("repo has " <> renderEVR repo <> " but spec is at " <> renderEVR spec <> ", is the checkout up to date?")]+        -- same version spelled differently, e.g. 1.05 vs 1.5+        EQ -> []+  _ -> []+  where+    finding' = finding "build-lag" p

@@ -0,0 +1,29 @@+-- | upstream has a newer version than the spec+module Oglyad.Check.Drift (check, drift) where++import Data.Text (Text)+import Data.Text qualified as T+import Oglyad.Types+import Oglyad.Version (compareUpstream)++-- | (upstream version, spec version, how upstream compares)+drift :: Package -> Maybe (Text, Text, Ordering)+drift Package {..} = do+  up <- T.strip <$> pkgUpstreamVer+  spec <- evrVersion <$> pkgSpecEVR+  pure (up, spec, compareUpstream up spec)++-- pkgUpstreamVer is only populated with --upstream, so this check is silent+-- by default+check :: Check+check _ p = case drift p of+  Just (up, spec, GT) -> [finding' Warn ("upstream has " <> up <> ", spec is at " <> spec)]+  Just (up, spec, LT)+    -- spec ahead of upstream. snapshots (Version: 1.2^20251101git...) built+    -- after the 1.2 release always look like this and are fine. anything else+    -- usually means a tag that normalizes badly+    | T.any (== '^') spec -> []+    | otherwise -> [finding' Info ("spec " <> spec <> " is ahead of upstream " <> up <> ", check tag normalization")]+  _ -> []+  where+    finding' = finding "drift" p

@@ -0,0 +1,28 @@+-- | two monorepo directories building the same source package into the same+-- repo. only one build can be live in a repo, so they overwrite each other,+-- and nothing (including build-lag) can tell which one a published rpm came+-- from. sometimes deliberate (a bootstrap build, a 32-bit variant), sometimes+-- a copy-pasted Name: that was never changed+module Oglyad.Check.DuplicateName (check) where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Oglyad.Types++check :: Check+check snap p = case others of+  [] -> []+  _ ->+    [ finding "duplicate-name" p Warn $+        "also built by "+          <> T.intercalate ", " (map (T.pack . pkgPath) others)+          <> ", and both publish to the same repo"+    ]+  where+    others =+      [ q+      | q <- Map.elems (snapPackages snap),+        pkgName q == pkgName p,+        pkgSubrepo q == pkgSubrepo p,+        pkgPath q /= pkgPath p+      ]

@@ -0,0 +1,14 @@+-- | a package should live in Terra or Fedora, not both+module Oglyad.Check.FedoraOverlap (check) where++import Data.Set qualified as Set+import Oglyad.Types++-- | subrepos (extras, mesa, multimedia, nvidia) exist to ship replacements+-- for Fedora packages, so overlap there is the whole point+check :: Check+check Snapshot {..} p@Package {..}+  | Just _ <- pkgSubrepo = []+  | pkgName `Set.member` snapFedora =+      [finding "fedora-overlap" p Warn "also shipped by Fedora"]+  | otherwise = []

@@ -0,0 +1,9 @@+-- | packages with no update.rhai have to be bumped by hand+module Oglyad.Check.NoAutoupdate (check) where++import Oglyad.Types++check :: Check+check _ p@Package {..} = case pkgUpstream of+  Nothing -> [finding "no-autoupdate" p Info "no update.rhai, updates are manual"]+  Just _ -> []

@@ -0,0 +1,31 @@+-- | packages that haven't been built in a long time+module Oglyad.Check.Stale (check) where++import Data.Text (Text)+import Data.Text qualified as T+import Data.Time (UTCTime, diffUTCTime, nominalDay)+import Oglyad.Check.Drift (drift)+import Oglyad.Types++-- | a stable package nobody touched for a year might be totally fine, so an+-- old build alone is Info. it only becomes a Warn when upstream has moved on+-- (needs --upstream) and the package is still sitting on the old version+check :: Check+check Snapshot {..} p@Package {..} = case pkgRepoBuild of+  Nothing -> [] -- never published is build-lag's job+  Just RepoBuild {..}+    | diffUTCTime snapNow rbBuildTime < cfgStaleAfter snapConfig -> []+    | otherwise -> [finding "stale" p sev msg]+    where+      upstreamMoved = case drift p of+        Just (_, _, GT) -> True+        _ -> False+      sev = if upstreamMoved then Warn else Info+      msg =+        "last built "+          <> ago rbBuildTime+          <> maybe "" (\c -> ", last commit " <> ago c) pkgLastCommit+          <> (if upstreamMoved then ", and upstream has a newer version" else "")+  where+    ago :: UTCTime -> Text+    ago t = T.pack (show (floor (diffUTCTime snapNow t / nominalDay) :: Int)) <> " days ago"

@@ -0,0 +1,15 @@+-- | reports update.rhai shapes our parser doesn't understand yet. this is your+-- to-do list for Oglyad.Source.Rhai+module Oglyad.Check.UnparsedRhai (check) where++import Data.Text qualified as T+import Oglyad.Types++check :: Check+check _ p@Package {..} = case pkgUpstream of+  Just (Unknown raw) ->+    [finding "unparsed-rhai" p Info ("can't parse update.rhai: " <> T.take 80 (head' (T.lines raw)))]+  _ -> []+  where+    head' (l : _) = l+    head' [] = ""

@@ -0,0 +1,10 @@+-- | the update.rhai source parsed fine but asking upstream failed. usually a+-- renamed or deleted repo, which means `anda update` is failing on it too+module Oglyad.Check.UpstreamError (check) where++import Oglyad.Types++check :: Check+check _ p@Package {..} = case pkgUpstreamErr of+  Just err -> [finding "upstream-error" p Warn err]+  Nothing -> []

@@ -0,0 +1,241 @@+-- | the imperative shell: gather every data source into one 'Snapshot'+module Oglyad.Collect+  ( buildSnapshot,+  )+where++import Control.Concurrent.Async (concurrently)+import Control.Monad (forM, when)+import Control.Monad.Reader (ask, asks, liftIO, runReaderT)+import Data.Either (partitionEithers)+import Data.List (nub, partition)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Time (UTCTime, diffUTCTime, getCurrentTime, nominalDay)+import Oglyad.App (App, Env (..), HttpError (..), forConcurrentlyN, note)+import Oglyad.Source.Cache (CacheEntry (..), UpstreamCache, loadJson, lookupFresh, saveJson)+import Oglyad.Source.Monorepo+import Oglyad.Source.Repodata (fetchRepo)+import Oglyad.Source.Rhai (parseUpdateRhai)+import Oglyad.Source.Upstream (latestVersion)+import Oglyad.Types+import System.Directory (findExecutable, makeAbsolute)+import System.FilePath ((</>))++-- | collect everything. problems along the way become findings instead of+-- crashes, so one broken spec doesn't take down the whole run.+--+-- the monorepo work (rpmspec, git) is all local cpu and the repodata work is+-- all network, so the two halves run at the same time+buildSnapshot :: App (Snapshot, [Finding])+buildSnapshot = do+  cfg@Config {..} <- asks envConfig+  now <- liftIO getCurrentTime+  (dirErrs, dirs) <- partitionEithers <$> liftIO (findPackageDirs cfgMonorepo)+  hd <- liftIO (headCommit cfgMonorepo)++  -- the main repo, every subrepo some package asked for, and Fedora+  let terraRepos =+        (Nothing, cfgTerraRepo)+          : [(Just s, cfgTerraRepo <> "-" <> s) | s <- nub (mapMaybe pdSubrepo dirs)]+  env <- ask+  ((specErrs, pkgs0), (terra, fedora)) <-+    liftIO $+      concurrently+        (runReaderT (readPackages dirs) env)+        (runReaderT (fetchRepos terraRepos cfgFedoraRepos) env)++  let (repoErrs, repos) = partitionEithers terra+      fetched = Map.fromList repos+      pkgs1 =+        [ p+            { pkgRepoBuild = Map.lookup (pkgSubrepo p) fetched >>= Map.lookup (pkgName p),+              pkgRepoChecked = Map.member (pkgSubrepo p) fetched+            }+        | p <- pkgs0+        ]+  (upErrs, pkgs) <- if cfgUpstream then withUpstreams now pkgs1 else pure ([], pkgs1)++  let snap =+        Snapshot+          { snapPackages = Map.fromList [(pkgPath p, p) | p <- pkgs],+            snapFedora = foldMap Map.keysSet fedora,+            snapNow = now,+            snapConfig = cfg,+            snapHead = hd,+            snapIgnoreLabels = Map.fromList [(pdPath d, pdIgnores d) | d <- dirs, not (null (pdIgnores d))]+          }+      unreadable =+        [ (collectErr (T.pack path) ("can't read package dir: " <> err)) {fPath = Just (T.pack path)}+        | (path, err) <- dirErrs+        ]+  pure (snap, unreadable <> specErrs <> repoErrs <> upErrs)++-- | every repo at once. Terra failures become findings, Fedora ones just mean+-- no overlap data+fetchRepos ::+  [(Maybe Text, Text)] ->+  [Text] ->+  App ([Either Finding (Maybe Text, Map Text RepoBuild)], [Map Text RepoBuild])+fetchRepos terraRepos fedoraRepos = do+  let jobs = map Left terraRepos <> map Right fedoraRepos+  results <- forConcurrentlyN (length jobs) jobs $ \case+    Left (sub, url) -> Left . either (Left . collectErr url . T.pack) (\b -> Right (sub, b)) <$> fetchRepo url+    Right url -> Right . either (const Map.empty) id <$> fetchRepo url+  pure (partitionEithers results)++-- | evaluate every spec, reusing cached evaluations for unchanged packages+readPackages :: [PkgDir] -> App ([Finding], [Package])+readPackages dirs = do+  Config {..} <- asks envConfig+  root <- liftIO (makeAbsolute cfgMonorepo)+  -- one cache file per dist, so cron jobs checking different releases don't+  -- keep evicting each other's entries+  let cacheFile = "specs" <> T.unpack cfgDist <> ".json"+  (commits, (macros, cache)) <-+    liftIO $+      concurrently+        (commitTimes cfgMonorepo (map pdPath dirs))+        ((,) <$> macroFingerprint <*> (fromMaybe Map.empty <$> loadJson cacheFile))+  keyed <- forConcurrentlyN cfgConcurrency dirs $ \d -> liftIO $ do+    key <- specFingerprint macros cfgDist root (pdPath d)+    pure (key, d)+  let misses = length [() | (k, _) <- keyed, isNothing (Map.lookup k (cache :: Map Text (Either Text SpecInfo)))]+  note ("evaluating " <> show (length dirs) <> " specs, " <> show (length dirs - misses) <> " unchanged since last run")+  -- without rpmspec, cached evaluations still work. everything else is+  -- skipped and reported once, rather than as one error per package+  hasRpmspec <- liftIO (isJust <$> findExecutable "rpmspec")+  results <- forConcurrentlyN cfgConcurrency keyed $ \(key, d) -> liftIO $ do+    case (Map.lookup key cache, pdSpec d) of+      (Just cached, _) -> pure (Evaluated key d cached)+      (Nothing, Just spec)+        | hasRpmspec -> Evaluated key d <$> querySpec cfgRelease cfgDist (root </> spec)+        | otherwise -> pure Skipped+      (Nothing, Nothing) -> pure (NoSpec d)+  -- keep only entries for packages that still exist, so the file can't grow forever+  liftIO (saveJson cacheFile (Map.fromList [(k, i) | Evaluated k _ i <- results]))+  let skipped = length [() | Skipped <- results]+      missing =+        [ collectErr "rpmspec" ("rpmspec not found, install rpm-build. skipped " <> T.pack (show skipped) <> " specs with no cached result")+        | skipped > 0+        ]+      (errs, pkgs) =+        partitionEithers $+          [toPackage commits d (Just i) | Evaluated _ d i <- results]+            <> [toPackage commits d Nothing | NoSpec d <- results]+  pure (missing <> errs, pkgs)++-- | what happened to one package dir's spec+data SpecResult+  = Evaluated Text PkgDir (Either Text SpecInfo)+  | NoSpec PkgDir+  | Skipped++-- | last commit per package dir, reused as long as HEAD hasn't moved.+-- uncommitted changes can't change any "last commit", so HEAD is the whole key+commitTimes :: FilePath -> [FilePath] -> IO (Map FilePath UTCTime)+commitTimes root dirs = do+  hd <- headCommit root+  cached <- loadJson "commits.json"+  case (hd, cached) of+    (Just h, Just (h', m)) | h == h', all (`Map.member` m) dirs -> pure m+    _ -> do+      m <- lastCommits root dirs+      mapM_ (\h -> saveJson "commits.json" (h, m)) hd+      pure m++toPackage :: Map FilePath UTCTime -> PkgDir -> Maybe (Either Text SpecInfo) -> Either Finding Package+toPackage commits PkgDir {..} = \case+  Nothing -> Left (pathErr "no spec file found")+  Just (Left err) -> Left (pathErr ("rpmspec failed: " <> firstLine err))+  Just (Right SpecInfo {..}) ->+    Right+      Package+        { pkgName = siName,+          pkgPath = pdPath,+          pkgSubrepo = pdSubrepo,+          pkgSpecEVR = Just siEVR,+          pkgRepoBuild = Nothing,+          pkgLastCommit = Map.lookup pdPath commits,+          pkgUpstream = parseUpdateRhai <$> pdUpdateRhai,+          pkgUpstreamVer = Nothing,+          pkgUpstreamErr = Nothing,+          pkgRepoChecked = False+        }+  where+    firstLine t = let l = T.takeWhile (/= '\n') t in if T.null l then "(no output)" else l+    pathErr msg = (collectErr (T.pack pdPath) msg) {fPath = Just (T.pack pdPath)}++-- | fill in upstream versions, from the cache when it's fresh enough.+--+-- crates.io allows one request a second, so its lookups run in their own+-- serial queue next to everything else. inside the shared job pool, a cluster+-- of crates packages would hold every slot while waiting their turn+withUpstreams :: UTCTime -> [Package] -> App ([Finding], [Package])+withUpstreams now pkgs = do+  Config {..} <- asks envConfig+  when (isNothing cfgGitHubToken) $+    note "no GITHUB_TOKEN (or `gh auth token`), GitHub lookups will hit the 60/hour limit fast"+  cache <- liftIO (fromMaybe Map.empty <$> loadJson "upstream.json") :: App UpstreamCache+  let wanted = [p | p <- pkgs, Just src <- [pkgUpstream p], lookable src]+      fresh p = pkgUpstream p >>= \src -> lookupFresh cfgCacheFor now src cache+      (crates, others) = partition (isCrates . pkgUpstream) wanted+      lookup1 p = case (fresh p, pkgUpstream p) of+        (Just e, _) -> pure (pkgPath p, either (Left . HttpFailed) Right (ceResult e))+        (Nothing, Just src) -> (pkgPath p,) <$> latestVersion src+        (Nothing, Nothing) -> pure (pkgPath p, Left (HttpFailed "no source"))+  note ("querying upstreams for " <> show (length wanted) <> " packages, " <> show (length (filter (isJust . fresh) wanted)) <> " cached")+  env <- ask+  (r1, r2) <-+    liftIO $+      concurrently+        (runReaderT (forConcurrentlyN cfgConcurrency others lookup1) env)+        (runReaderT (forM crates lookup1) env)+  -- keyed by path, not name: two dirs can share a package name+  let byPath = Map.fromList (r1 <> r2)+      -- only cache successes. errors are often transient (rate limits, timeouts)+      new =+        Map.fromList+          [ (T.pack (show src), CacheEntry now (Right v))+          | p <- wanted,+            isNothing (fresh p),+            Just src <- [pkgUpstream p],+            Just (Right v) <- [Map.lookup (pkgPath p) byPath]+          ]+      -- forget answers nobody has asked for in a month+      recent = Map.filter (\e -> diffUTCTime now (ceFetched e) < 30 * nominalDay) cache+      limited = [why | Left (RateLimited why) <- Map.elems byPath]+      rateErr = case limited of+        [] -> []+        why : _ ->+          [ (collectErr "upstream" (why <> ", skipped " <> T.pack (show (length limited)) <> " lookups. set GITHUB_TOKEN, or try again later"))+              { fSeverity = Warn+              }+          ]+  liftIO (saveJson "upstream.json" (new <> recent))+  pure+    ( rateErr,+      [ case Map.lookup (pkgPath p) byPath of+          Just (Right v) -> p {pkgUpstreamVer = Just v}+          Just (Left (HttpFailed e)) -> p {pkgUpstreamErr = Just e}+          -- rate limits are reported once above, not as a broken upstream+          Just (Left (RateLimited _)) -> p+          Nothing -> p+      | p <- pkgs+      ]+    )+  where+    lookable = \case+      CommitTracked -> False+      Derived _ -> False+      Unknown _ -> False+      _ -> True+    isCrates = \case+      Just (Crates _ _) -> True+      _ -> False++collectErr :: Text -> Text -> Finding+collectErr what msg = Finding {fCheck = "collect", fPackage = what, fPath = Nothing, fSeverity = Error, fMessage = msg}

@@ -0,0 +1,132 @@+-- | silencing findings that are known and intentional.+--+-- two sources, both matched by check name:+--+--   * an ignore file (--ignore-file), where every entry names a package by+--     monorepo path or package name and must give a reason+--   * an `oglyad_ignore = "check, other-check"` label in a package's+--     anda.hcl, so the exception lives next to the package+--+-- ignored findings don't count toward the exit code. ignore-file entries that+-- no longer match anything are reported, so stale exceptions get cleaned up+module Oglyad.Ignore+  ( IgnoreRule (..),+    Target (..),+    IgnoreFile (..),+    parseIgnoreFile,+    Applied (..),+    applyIgnores,+  )+where++import Data.Aeson (FromJSON (..), Value, eitherDecodeStrict, withObject, (.:), (.:?))+import Data.Aeson.Types (Parser)+import Data.ByteString (ByteString)+import Data.List (partition)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Oglyad.Types++-- | what an ignore rule points at+data Target+  = -- | a monorepo directory, e.g. anda/langs/zig/master-bootstrap+    ByPath Text+  | -- | every directory building this package name+    ByName Text+  deriving stock (Eq, Show)++data IgnoreRule = IgnoreRule+  { irCheck :: Text,+    irTarget :: Target,+    irReason :: Text+  }+  deriving stock (Eq, Show)++newtype IgnoreFile = IgnoreFile [IgnoreRule]+  deriving stock (Eq, Show)++instance FromJSON IgnoreFile where+  parseJSON = withObject "ignore file" $ \o -> IgnoreFile <$> (o .: "ignore" >>= traverse rule)+    where+      rule :: Value -> Parser IgnoreRule+      rule = withObject "ignore entry" $ \o -> do+        check <- o .: "check"+        path <- o .:? "path"+        name <- o .:? "package"+        reason <- o .: "reason"+        target <- case (path, name) of+          (Just p, Nothing) -> pure (ByPath p)+          (Nothing, Just n) -> pure (ByName n)+          _ -> fail ("entry for " <> T.unpack check <> " needs exactly one of \"path\" or \"package\"")+        if T.null (T.strip reason)+          then fail ("entry for " <> T.unpack check <> " has an empty reason. say why it's ok")+          else pure (IgnoreRule check target reason)++-- | parse and validate an ignore file against the known check names+parseIgnoreFile :: [Text] -> ByteString -> Either String IgnoreFile+parseIgnoreFile known raw = do+  f@(IgnoreFile rules) <- eitherDecodeStrict raw+  case [irCheck r | r <- rules, irCheck r `notElem` known] of+    [] -> Right f+    bad -> Left ("unknown checks in ignore file: " <> T.unpack (T.intercalate ", " bad))++data Applied = Applied+  { -- | findings that still count+    apKept :: [Finding],+    -- | findings an ignore matched+    apIgnored :: [Finding],+    -- | problems with the ignores themselves: unused file entries, unknown+    -- check names in anda.hcl labels+    apProblems :: [Finding]+  }++-- | split findings into kept and ignored. known is every check name, ran is+-- the ones that ran this time (an entry for a check that didn't run isn't+-- unused, just idle). labels maps a monorepo path to the check names its+-- anda.hcl ignores+applyIgnores :: [Text] -> [Text] -> IgnoreFile -> Map FilePath [Text] -> [Finding] -> Applied+applyIgnores known ran (IgnoreFile rules) labels findings =+  Applied+    { apKept = kept,+      apIgnored = ignored,+      apProblems = unused <> badLabels+    }+  where+    (ignored, kept) = partition isIgnored findings+    isIgnored f = byLabel f || any (`matches` f) rules+    byLabel f = case fPath f of+      Just path -> fCheck f `elem` Map.findWithDefault [] (T.unpack path) labels+      Nothing -> False+    matches r f =+      irCheck r == fCheck f && case irTarget r of+        ByPath p -> fPath f == Just p+        ByName n -> fPackage f == n+    unused =+      [ Finding+          { fCheck = "unused-ignore",+            fPackage = describe (irTarget r),+            fPath = case irTarget r of ByPath p -> Just p; ByName _ -> Nothing,+            fSeverity = Info,+            fMessage = "ignore file entry for " <> irCheck r <> " matches nothing anymore, remove it"+          }+      | r <- rules,+        irCheck r `elem` ran,+        not (any (matches r) findings)+      ]+    badLabels =+      [ Finding+          { fCheck = "unused-ignore",+            fPackage = T.pack path,+            fPath = Just (T.pack path),+            fSeverity = Warn,+            fMessage = "oglyad_ignore in anda.hcl names unknown check " <> c+          }+      | (path, cs) <- Map.toList labels,+        c <- cs,+        c `notElem` known+      ]+    describe = \case+      ByPath p -> p+      ByName n -> n

@@ -0,0 +1,48 @@+-- | running external tools (rpmspec, git) without ever throwing, hanging, or+-- leaking secrets+module Oglyad.Process+  ( run,+    childEnv,+  )+where++import Control.Exception (IOException, try)+import Data.ByteString.Lazy qualified as LBS+import Data.Char (isUpper)+import Data.List (isPrefixOf)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import System.Environment (getEnvironment)+import System.Exit (ExitCode (..))+import System.Process.Typed (nullStream, proc, readProcess, setEnv, setStdin)+import System.Timeout (timeout)++-- | run a command and return its stdout. a missing executable, a non-zero+-- exit, or a timeout becomes a Left, so callers can report it as a finding+-- instead of crashing the whole run.+--+-- rpmspec runs shell code from specs (%(...) and %{lua:...}), so children get+-- an allowlisted environment: GITHUB_TOKEN and anything else secret in ours+-- never reaches them. stdin is closed so nothing can wait on a prompt+run :: FilePath -> [String] -> IO (Either Text Text)+run cmd args = do+  env <- childEnv <$> getEnvironment+  r <- try (timeout (5 * 60 * 1_000_000) (readProcess (setEnv env (setStdin nullStream (proc cmd args)))))+  pure $ case r of+    Left (e :: IOException) -> Left (T.pack cmd <> ": " <> T.pack (show e))+    Right Nothing -> Left (T.pack cmd <> " timed out after 5 minutes")+    Right (Just (ExitSuccess, out, _)) -> Right (decode out)+    Right (Just (ExitFailure _, _, err)) -> Left (T.strip (decode err))+  where+    decode = TE.decodeUtf8Lenient . LBS.toStrict++-- | the environment children get: only what rpm and git need to find their+-- config and behave, plus GIT_TERMINAL_PROMPT=0 so a git remote asking for+-- credentials fails fast instead of hanging+childEnv :: [(String, String)] -> [(String, String)]+childEnv parent = ("GIT_TERMINAL_PROMPT", "0") : filter (allowed . fst) parent+  where+    allowed k =+      k `elem` ["PATH", "HOME", "USER", "LOGNAME", "LANG", "TZ", "TMPDIR", "XDG_CONFIG_HOME", "XDG_CACHE_HOME", "XDG_DATA_HOME", "XDG_RUNTIME_DIR"]+        || ("LC_" `isPrefixOf` k && all (\c -> isUpper c || c == '_') k)

@@ -0,0 +1,175 @@+-- | rendering findings as terminal text, json for scripts, or markdown for+-- GitHub job summaries+module Oglyad.Report+  ( Report (..),+    Format (..),+    render,+    renderText,+    renderJson,+    renderMarkdown,+  )+where++import Data.Aeson (ToJSON (..), encode, object, (.=))+import Data.ByteString.Lazy qualified as LBS+import Data.List (sortOn)+import Data.Map.Strict qualified as Map+import Data.Ord (Down (..))+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Data.Time (UTCTime, defaultTimeLocale, formatTime)+import Oglyad.Types++data Format = Text | Json | Markdown+  deriving stock (Eq, Show)++-- | everything a report needs besides the findings themselves+data Report = Report+  { rVersion :: Text,+    rGenerated :: UTCTime,+    rMonorepoHead :: Maybe Text,+    rTerraRepo :: Text,+    rUpstream :: Bool,+    rFindings :: [Finding],+    rIgnored :: [Finding]+  }++render :: Format -> Severity -> Report -> LBS.ByteString+render fmt minSev r = case fmt of+  Text -> utf8 (renderText minSev r)+  Markdown -> utf8 (renderMarkdown minSev r)+  Json -> renderJson r <> "\n"+  where+    utf8 = LBS.fromStrict . TE.encodeUtf8++-- * text++renderText :: Severity -> Report -> Text+renderText minSev Report {..} =+  T.unlines (map line (shown minSev rFindings) <> ["", summaryLine rFindings rIgnored])+  where+    amb = ambiguousNames rFindings+    line f@Finding {..} =+      T.justifyLeft 6 ' ' (sevText fSeverity)+        <> T.justifyLeft 16 ' ' fCheck+        <> label amb f+        <> ": "+        <> fMessage++summaryLine :: [Finding] -> [Finding] -> Text+summaryLine fs ignored =+  count Error <> " errors, " <> count Warn <> " warnings, " <> count Info <> " info" <> ignoredPart+  where+    count s = tshow (length (filter ((== s) . fSeverity) fs))+    ignoredPart = if null ignored then "" else " (" <> tshow (length ignored) <> " ignored)"++-- * json++-- | a stable envelope. bump schema on any breaking change to field names or+-- meanings, so scripts reading this can tell+renderJson :: Report -> LBS.ByteString+renderJson Report {..} =+  encode $+    object+      [ "schema" .= (1 :: Int),+        "oglyad" .= rVersion,+        "generated" .= rGenerated,+        "monorepo_head" .= rMonorepoHead,+        "terra_repo" .= rTerraRepo,+        "upstream" .= rUpstream,+        "summary"+          .= object+            [ "error" .= count Error,+              "warn" .= count Warn,+              "info" .= count Info,+              "ignored" .= length rIgnored+            ],+        "findings" .= map findingJson rFindings,+        "ignored" .= map findingJson rIgnored+      ]+  where+    count s = length (filter ((== s) . fSeverity) rFindings)+    findingJson Finding {..} =+      object+        [ "check" .= fCheck,+          "package" .= fPackage,+          "path" .= fPath,+          "severity" .= toJSON fSeverity,+          "message" .= fMessage+        ]++-- * markdown++-- | sized for a GitHub job summary: counts first, errors and warnings in+-- full, info folded away+renderMarkdown :: Severity -> Report -> Text+renderMarkdown minSev Report {..} =+  T.unlines $+    [ "# oglyad report",+      "",+      T.intercalate+        " · "+        [ T.pack (formatTime defaultTimeLocale "%Y-%m-%d %H:%M UTC" rGenerated),+          "terrapkg/packages " <> maybe "(unknown commit)" (\h -> "`" <> T.take 10 h <> "`") rMonorepoHead,+          rTerraRepo,+          if rUpstream then "upstream checks on" else "upstream checks off",+          "oglyad " <> rVersion+        ],+      "",+      "**" <> summaryLine rFindings rIgnored <> "**",+      "",+      "| check | errors | warnings | info |",+      "|---|---:|---:|---:|"+    ]+      <> [ "| `" <> c <> "` | " <> n Error c <> " | " <> n Warn c <> " | " <> n Info c <> " |"+         | c <- Set.toList (Set.fromList (map fCheck rFindings))+         ]+      <> section Error "Errors" False+      <> section Warn "Warnings" False+      <> (if minSev <= Info then section Info "Info" True else [])+  where+    amb = ambiguousNames rFindings+    n s c = tshow (length [() | f <- rFindings, fSeverity f == s, fCheck f == c])+    section sev title folded =+      case [f | f <- shown minSev rFindings, fSeverity f == sev] of+        [] -> []+        fs ->+          let heading = title <> " (" <> tshow (length fs) <> ")"+              table =+                ["", "| package | check | message |", "|---|---|---|"]+                  <> [ "| " <> cell (label amb f) <> " | `" <> fCheck f <> "` | " <> cell (fMessage f) <> " |"+                     | f <- fs+                     ]+           in if folded+                then ["", "<details><summary>" <> heading <> "</summary>"] <> table <> ["", "</details>"]+                else ["", "## " <> heading] <> table+    -- table cells can't contain raw pipes or newlines+    cell = T.replace "|" "\\|" . T.replace "\n" " "++-- * shared++shown :: Severity -> [Finding] -> [Finding]+shown minSev =+  sortOn (\f -> (Down (fSeverity f), fCheck f, fPackage f)) . filter ((>= minSev) . fSeverity)++-- | the package name, plus its directory when the name belongs to several+label :: Set.Set Text -> Finding -> Text+label ambiguous Finding {..} =+  fPackage <> maybe "" (\path -> if fPackage `Set.member` ambiguous then " (" <> path <> ")" else "") fPath++-- | names that show up with more than one directory+ambiguousNames :: [Finding] -> Set.Set Text+ambiguousNames fs =+  Map.keysSet . Map.filter ((> 1) . Set.size) $+    Map.fromListWith (<>) [(fPackage f, Set.fromList (maybe [] pure (fPath f))) | f <- fs]++sevText :: Severity -> Text+sevText = \case+  Info -> "info"+  Warn -> "warn"+  Error -> "error"++tshow :: (Show a) => a -> Text+tshow = T.pack . show

@@ -0,0 +1,68 @@+-- | small json caches under $XDG_CACHE_HOME/oglyad, so reruns skip work that+-- can't have changed: spec evaluation, repodata parsing and upstream lookups+module Oglyad.Source.Cache+  ( loadJson,+    saveJson,+    CacheEntry (..),+    UpstreamCache,+    lookupFresh,+  )+where++import Control.Exception (SomeException, finally, try)+import Data.Aeson (FromJSON, ToJSON, eitherDecodeFileStrict, encode)+import Data.ByteString.Lazy qualified as LBS+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Data.Time (NominalDiffTime, UTCTime, diffUTCTime)+import GHC.Generics (Generic)+import Oglyad.Types (UpstreamSource)+import System.Directory (XdgDirectory (XdgCache), createDirectoryIfMissing, getXdgDirectory, renameFile)+import System.FilePath ((</>))+import System.IO (hClose, openBinaryTempFile)++cacheDir :: IO FilePath+cacheDir = getXdgDirectory XdgCache "oglyad"++-- | a missing or corrupt cache file is just a cache miss+loadJson :: forall a. (FromJSON a) => FilePath -> IO (Maybe a)+loadJson name = do+  path <- (</> name) <$> cacheDir+  r <- try (eitherDecodeFileStrict path) :: IO (Either SomeException (Either String a))+  pure (either (const Nothing) (either (const Nothing) Just) r)++-- | write to a temp file then rename, so a ctrl-c mid-write can't corrupt it.+-- caching is best effort: if the write fails (full disk, read-only home) the+-- run carries on and just won't be faster next time+saveJson :: (ToJSON a) => FilePath -> a -> IO ()+saveJson name x = do+  r <- try $ do+    dir <- cacheDir+    createDirectoryIfMissing True dir+    let path = dir </> name+    -- a unique temp name, so two runs at once can't interleave their writes.+    -- rename is atomic, so readers see the old file or the new one, never half+    (tmp, h) <- openBinaryTempFile dir (name <> ".tmp")+    LBS.hPut h (encode x) `finally` hClose h+    renameFile tmp path+  case r of+    Left (_ :: SomeException) -> pure ()+    Right () -> pure ()++data CacheEntry = CacheEntry+  { ceFetched :: UTCTime,+    ceResult :: Either Text Text+  }+  deriving stock (Show, Generic)+  deriving anyclass (ToJSON, FromJSON)++-- | upstream answers, keyed by the rendered 'UpstreamSource' so json keys+-- stay plain strings+type UpstreamCache = Map Text CacheEntry++lookupFresh :: NominalDiffTime -> UTCTime -> UpstreamSource -> UpstreamCache -> Maybe CacheEntry+lookupFresh maxAge now src c = do+  e <- Map.lookup (T.pack (show src)) c+  if diffUTCTime now (ceFetched e) <= maxAge then Just e else Nothing

@@ -0,0 +1,248 @@+-- | reads a local checkout of terrapkg/packages+module Oglyad.Source.Monorepo+  ( PkgDir (..),+    SpecInfo (..),+    findPackageDirs,+    hclString,+    querySpec,+    lastCommits,+    headCommit,+    specFingerprint,+    macroFingerprint,+  )+where++import Control.Exception (IOException, try)+import Control.Monad (filterM, foldM, forM)+import Crypto.Hash.SHA256 qualified as SHA256+import Data.Aeson (FromJSON, ToJSON)+import Data.ByteString qualified as BS+import Data.ByteString.Base16 qualified as B16+import Data.List (sort)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (listToMaybe)+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Data.Text.Read qualified as TR+import Data.Time (UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import GHC.Generics (Generic)+import Oglyad.Process (run)+import Oglyad.Version (EVR, parseEVR)+import System.Directory (doesDirectoryExist, doesFileExist, getSymbolicLinkTarget, listDirectory, pathIsSymbolicLink)+import System.FilePath (takeDirectory, takeExtension, (</>))++-- | a directory with an anda.hcl in it+data PkgDir = PkgDir+  { -- | relative to the monorepo root+    pdPath :: FilePath,+    -- | relative to the monorepo root+    pdSpec :: Maybe FilePath,+    -- | `subrepo = "extras"` from the labels block+    pdSubrepo :: Maybe Text,+    -- | file contents+    pdUpdateRhai :: Maybe Text,+    -- | `oglyad_ignore = "check, other-check"` from the labels block+    pdIgnores :: [Text]+  }+  deriving stock (Eq, Show)++data SpecInfo = SpecInfo+  { siName :: Text,+    siEVR :: EVR+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (ToJSON, FromJSON)++-- | walk anda/ and return every project directory+-- | walk anda/ and return every project directory. a directory that can't be+-- read comes back as a Left with the reason, instead of ending the walk.+-- symlinked directories aren't followed, so a link loop can't hang the walk+findPackageDirs :: FilePath -> IO [Either (FilePath, Text) PkgDir]+findPackageDirs root = go "anda"+  where+    go rel = do+      let abs' = root </> rel+      listed <- try (listDirectory abs')+      case listed of+        Left (e :: IOException) -> pure [Left (rel, T.pack (show e))]+        Right entries -> do+          hasHcl <- doesFileExist (abs' </> "anda.hcl")+          here <- if hasHcl then pure <$> readPkgDir rel entries else pure []+          subdirs <- filterM (realDir . (abs' </>)) [e | e <- sort entries, take 1 e /= "."]+          nested <- concat <$> forM subdirs (go . (rel </>))+          pure (here <> nested)++    readPkgDir rel entries = do+      r <- try (readPkgDir' rel entries)+      pure (either (\(e :: IOException) -> Left (rel, T.pack (show e))) Right r)++    readPkgDir' rel entries = do+      let abs' = root </> rel+      hcl <- readText (abs' </> "anda.hcl")+      let fromHcl = T.unpack <$> hclString "spec" hcl+          fallback = listToMaybe [e | e <- entries, takeExtension e == ".spec"]+      hasRhai <- doesFileExist (abs' </> "update.rhai")+      rhai <- if hasRhai then Just <$> readText (abs' </> "update.rhai") else pure Nothing+      pure+        PkgDir+          { pdPath = rel,+            pdSpec = (rel </>) <$> maybe fallback Just fromHcl,+            pdSubrepo = hclString "subrepo" hcl,+            pdUpdateRhai = rhai,+            pdIgnores = maybe [] (filter (not . T.null) . map T.strip . T.splitOn ",") (hclString "oglyad_ignore" hcl)+          }++-- | pull the first `key = "value"` out of anda.hcl without a real HCL parser.+-- every anda.hcl in the monorepo is simple enough for this to hold up+hclString :: Text -> Text -> Maybe Text+hclString key hcl =+  listToMaybe+    [ T.takeWhile (/= '"') (T.drop 1 (T.dropWhile (/= '"') rest))+    | l <- map T.strip (T.lines hcl),+      Just rest <- [T.stripPrefix key l],+      "=" `T.isPrefixOf` T.stripStart rest,+      "\"" `T.isInfixOf` rest+    ]++-- | a directory that isn't a symlink+realDir :: FilePath -> IO Bool+realDir path = do+  isDir <- doesDirectoryExist path+  isLink <- either (\(_ :: IOException) -> False) id <$> try (pathIsSymbolicLink path)+  pure (isDir && not isLink)++-- | read a text file as utf-8 no matter the locale, replacing invalid bytes+-- instead of failing+readText :: FilePath -> IO Text+readText path = TE.decodeUtf8Lenient <$> BS.readFile path++-- | let rpm evaluate the spec for us. hand-parsing specs means reimplementing+-- the macro engine, which is a terrible idea+querySpec :: Int -> Text -> FilePath -> IO (Either Text SpecInfo)+querySpec release dist spec = do+  let qf = "%{NAME}\t%|EPOCH?{%{EPOCH}}:{0}|:%{VERSION}-%{RELEASE}\n"+  out <-+    run "rpmspec" $+      [ "-q",+        "--srpm",+        "--define",+        "dist " <> T.unpack dist,+        -- %fedora comes from the host otherwise, so -r 43 on an F44 box would+        -- take the wrong side of every %if 0%{?fedora} >= 44+        "--define",+        "fedora " <> show release,+        -- some specs load macro files from their own dir via %{_sourcedir}+        "--define",+        "_sourcedir " <> takeDirectory spec,+        "--qf",+        qf,+        spec+      ]+  pure $ do+    o <- out+    case T.splitOn "\t" <$> take 1 (T.lines o) of+      [[name, evr]] | Just e <- parseEVR evr -> Right (SpecInfo name e)+      _ -> Left ("unexpected rpmspec output: " <> o)++-- | time of the last commit touching each package dir, from a single+-- `git log` over the whole history.+--+-- asking git once per directory (`git log -1 -- dir`) makes it walk and diff+-- history from the top every time, which for 1300 dirs and 20k commits burned+-- ~25s of cpu. one pass listing every changed file per commit takes ~0.5s,+-- and since git lists newest commits first, the first time we see a path+-- under a dir is that dir's last commit+lastCommits :: FilePath -> [FilePath] -> IO (Map FilePath UTCTime)+lastCommits root dirs = do+  out <-+    run "git" $+      ["-C", root, "-c", "core.quotePath=false", "log", "--format=@%ct", "--name-only", "--no-renames", "HEAD", "--", "anda"]+  -- not a git checkout (or no git at all) just means no commit times+  pure (either (const Map.empty) (go Nothing Map.empty . T.lines) out)+  where+    wanted = Set.fromList (map T.pack dirs)+    total = Set.size wanted+    go _ acc _ | Map.size acc == total = acc -- every dir seen, stop reading+    go _ acc [] = acc+    go cur acc (l : ls) = case T.stripPrefix "@" l of+      -- unix seconds. iso dates would need care since git writes UTC as "Z",+      -- which the ZonedTime parser rejects+      Just stamp -> go (posixSecondsToUTCTime . fromInteger . fst <$> either (const Nothing) Just (TR.decimal stamp)) acc ls+      Nothing -> case cur of+        Just t | not (T.null l) -> go cur (foldl' (claim t) acc (ancestors l)) ls+        _ -> go cur acc ls+    -- a file counts for every package dir above it, like `git log -- dir` does+    claim t acc d+      | d `Set.member` wanted, not (Map.member (T.unpack d) acc) = Map.insert (T.unpack d) t acc+      | otherwise = acc+    ancestors f = case T.breakOnEnd "/" f of+      ("", _) -> []+      (parentSlash, _) -> let parent = T.dropEnd 1 parentSlash in parent : ancestors parent++-- | the commit HEAD points at, if this is a git checkout+headCommit :: FilePath -> IO (Maybe Text)+headCommit root = either (const Nothing) (Just . T.strip) <$> run "git" ["-C", root, "rev-parse", "HEAD"]++-- | a hash of everything that can change what rpmspec says about a package:+-- the files in its directory and any subdirectories like patches/ (but not+-- nested packages, which have their own fingerprint), the dist tag, and the+-- rpm macros in effect (see 'macroFingerprint')+specFingerprint :: Text -> Text -> FilePath -> FilePath -> IO Text+specFingerprint macros dist root rel = do+  files <- packageFiles (root </> rel)+  let header = TE.encodeUtf8 (macros <> "\0" <> dist <> "\0" <> T.pack rel <> "\0")+  -- feed each file to the hash as its own chunk instead of concatenating+  -- them, which would copy every byte of the package dir once more+  ctx <-+    foldM+      ( \c (f, entry) -> do+          body <- case entry of+            -- hash where a symlink points, never what's behind it+            Link target -> pure ("<link> " <> TE.encodeUtf8 (T.pack target))+            File ->+              either (\(e :: IOException) -> "<unreadable> " <> TE.encodeUtf8 (T.pack (show e))) id+                <$> try (BS.readFile (root </> rel </> f))+          pure $! SHA256.updates c [TE.encodeUtf8 (T.pack f), "\0", body, "\0"]+      )+      (SHA256.update SHA256.init header)+      files+  pure (TE.decodeUtf8 (B16.encode (SHA256.finalize ctx)))++data Entry = File | Link FilePath++-- | every file under a package dir, relative to it and sorted, skipping+-- subdirectories that are packages of their own. symlinks are recorded with+-- their target and never followed, so a dangling link or a link loop can't+-- crash or hang the walk+packageFiles :: FilePath -> IO [(FilePath, Entry)]+packageFiles dir = go ""+  where+    go sub = do+      listed <- try (listDirectory (dir </> sub))+      let entries = either (\(_ :: IOException) -> []) sort listed+      fmap concat . forM entries $ \e -> do+        let rel = if null sub then e else sub </> e+        link <- try (getSymbolicLinkTarget (dir </> rel))+        case link of+          Right target -> pure [(rel, Link target)]+          Left (_ :: IOException) -> do+            isDir <- doesDirectoryExist (dir </> rel)+            isPkg <- doesFileExist (dir </> rel </> "anda.hcl")+            case (isDir, isPkg) of+              (True, True) -> pure []+              (True, False) -> go rel+              _ -> pure [(rel, File)]++-- | fingerprint of the whole rpm macro state, so updating rpm,+-- redhat-rpm-config or anda-srpm-macros, or editing ~/.rpmmacros, invalidates+-- cached evaluations. `rpm --showrc` dumps every macro rpm loaded, from every+-- path in its search list, which is more complete than listing files by hand+macroFingerprint :: IO Text+macroFingerprint = do+  showrc <- either ("no rpm: " <>) id <$> run "rpm" ["--showrc"]+  version <- either ("no rpmspec: " <>) id <$> run "rpmspec" ["--version"]+  pure (TE.decodeUtf8 (B16.encode (SHA256.hash (TE.encodeUtf8 (version <> "\0" <> showrc)))))

@@ -0,0 +1,287 @@+-- | reads published dnf repodata: repomd.xml → primary.xml.{zst,gz,xz} → packages+module Oglyad.Source.Repodata+  ( RpmEntry (..),+    fetchRepo,+    decompressAndParse,+    parseRepomd,+    parsePrimary,+    srpmName,+    latestBySource,+  )+where++import Conduit (foldlC, runConduit, sourceHandle, sourceLazy, (.|))+import Control.DeepSeq (deepseq)+import Control.Exception (SomeException, try)+import Control.Monad ((<$!>), (>=>))+import Control.Monad.Reader (liftIO)+import Data.Bifunctor (first)+import Data.ByteString.Lazy qualified as LBS+import Data.Char (isAlphaNum)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (mapMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Read qualified as TR+import Data.Time (UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Data.XML.Types (Content (..), Event (..))+import Oglyad.App (App, HttpError (..), httpGetE, note)+import Oglyad.Process (childEnv)+import Oglyad.Source.Cache (loadJson, saveJson)+import Oglyad.Types (RepoBuild (..))+import Oglyad.Version (EVR (..))+import System.Environment (getEnvironment)+import System.Exit (ExitCode (..))+import System.IO (Handle)+import System.Process.Typed (byteStringInput, createPipe, getStdout, nullStream, proc, setEnv, setStderr, setStdin, setStdout, waitExitCode, withProcessTerm)+import Text.XML (Name (..), def, parseLBS)+import Text.XML.Cursor (attribute, attributeIs, element, fromDocument, ($//), (&/))+import Text.XML.Stream.Parse (parseBytes)++-- | one binary (or source) rpm from primary.xml+-- | strict fields, filled with copied text (see 'finish' in 'parsePrimary'),+-- so a parsed entry never keeps the decompressed file alive+data RpmEntry = RpmEntry+  { rpmName :: !Text,+    rpmArch :: !Text,+    rpmEVR :: !EVR,+    -- | e.g. zed-0.190.0-1.fc44.src.rpm, absent on src rpms+    rpmSourceRpm :: !(Maybe Text),+    rpmBuildTime :: !UTCTime+  }+  deriving stock (Eq, Show)++-- | builds per source package for a repo, reusing the last parse when the+-- repo hasn't changed. repomd.xml is tiny, and the primary.xml href in it+-- embeds a checksum, so an unchanged href means unchanged contents+fetchRepo :: Text -> App (Either String (Map Text RepoBuild))+fetchRepo base = do+  let file = "repodata-" <> T.unpack (T.map (\c -> if isAlphaNum c then c else '_') base) <> ".json"+  repomd <- httpGetE (base <> "/repodata/repomd.xml")+  case first httpErr repomd >>= parseRepomd of+    Left err -> pure (Left err)+    Right href ->+      liftIO (loadJson file) >>= \case+        Just (cachedHref, builds) | cachedHref == href -> pure (Right builds)+        _ -> do+          note ("downloading " <> T.unpack base <> "/" <> T.unpack href)+          r <- fmap latestBySource <$> fetchPrimaryAt base href+          case r of+            Right builds -> liftIO (saveJson file (href, builds))+            Left _ -> pure ()+          pure r++-- | fetch and parse the primary.xml at a href from repomd.xml+fetchPrimaryAt :: Text -> Text -> App (Either String [RpmEntry])+fetchPrimaryAt base href = do+  download <- httpGetE (base <> "/" <> href)+  case first httpErr download of+    Left err -> pure (Left err)+    Right compressed -> liftIO (decompressAndParse href compressed)++httpErr :: HttpError -> String+httpErr = \case+  RateLimited why -> T.unpack why+  HttpFailed why -> T.unpack why++-- | decompress a primary.xml by its file extension and parse it, streaming+-- from the decompressor's pipe so even Fedora's ~250MB file never sits in+-- memory.+--+-- decompression goes through the zstd, gzip and xz commands, which every+-- Fedora install has. Fedora doesn't package a Haskell zstd binding, and+-- oglyad should build from Fedora's own libraries+decompressAndParse :: Text -> LBS.ByteString -> IO (Either String [RpmEntry])+decompressAndParse href compressed+  | ".zst" `T.isSuffixOf` href = viaCommand "zstd" ["--decompress", "--stdout", "--quiet"]+  | ".gz" `T.isSuffixOf` href = viaCommand "gzip" ["--decompress", "--stdout", "--quiet"]+  | ".xz" `T.isSuffixOf` href = viaCommand "xz" ["--decompress", "--stdout", "--quiet"]+  | ".xml" `T.isSuffixOf` href = pure (parsePrimary compressed)+  | otherwise = pure (Left ("don't know how to decompress " <> T.unpack href))+  where+    -- feed the download to the command's stdin and parse its stdout as it+    -- arrives. a corrupt archive makes the command fail, which shows up as+    -- a parse error or a non-zero exit, never a crash+    viaCommand cmd args = do+      env <- childEnv <$> getEnvironment+      let cfg = setEnv env (setStdin (byteStringInput compressed) (setStdout createPipe (setStderr nullStream (proc cmd args))))+      r <- try $ withProcessTerm cfg $ \p -> do+        parsed <- parsePrimaryHandle (getStdout p)+        code <- waitExitCode p+        pure $ case (code, parsed) of+          (ExitFailure n, _) -> Left (cmd <> " exited with " <> show n <> " decompressing " <> T.unpack href)+          (ExitSuccess, _) -> parsed+      pure (either (\e -> Left (cmd <> ": " <> show (e :: SomeException))) id r)++repoNs, commonNs, rpmNs :: Text -> Name+repoNs n = Name n (Just "http://linux.duke.edu/metadata/repo") Nothing+commonNs n = Name n (Just "http://linux.duke.edu/metadata/common") Nothing+rpmNs n = Name n (Just "http://linux.duke.edu/metadata/rpm") Nothing++-- | find the location of primary.xml in repomd.xml.+-- this uses the xml-conduit Cursor api, which builds the whole document in+-- memory. that's fine for a 2KB file:+--   $//  = all descendants matching+--   &/   = children matching+--   >=>  = compose two axes (it's just Kleisli composition on lists)+parseRepomd :: LBS.ByteString -> Either String Text+parseRepomd bs = do+  doc <- first show (parseLBS def bs)+  let hrefs =+        fromDocument doc+          $// (element (repoNs "data") >=> attributeIs "type" "primary")+          &/ (element (repoNs "location") >=> attribute "href")+  case hrefs of+    (h : _) -> Right h+    [] -> Left "no primary entry in repomd.xml"++-- | what we've seen so far of the <package> we're currently inside+data PkgAcc = PkgAcc+  { accName :: Text,+    accArch :: Text,+    accEVR :: Maybe EVR,+    accTime :: Maybe UTCTime,+    accSrpm :: Maybe Text+  }++emptyAcc :: PkgAcc+emptyAcc = PkgAcc "" "" Nothing Nothing Nothing++-- | which element's text we're currently collecting+data Capture = CapName | CapArch | CapSrpm | CapNone+  deriving stock (Eq)++data St = St+  { stAcc :: !PkgAcc,+    stCap :: !Capture,+    -- | finished packages, newest first+    stOut :: [RpmEntry],+    -- | open elements, nonzero at the end means a truncated file+    stDepth :: !Int+  }++-- | parse decompressed primary.xml from memory. the real runs stream from a+-- pipe with 'parsePrimaryHandle'. this one is for small inputs and tests.+--+-- unlike repomd.xml this file is big (Terra's is ~20MB, Fedora's is ~200MB)+-- so we never build a DOM. instead the XML is turned into a stream of events+-- (element opened, text, element closed, ...) and folded over with a small+-- state machine. memory use stays proportional to the results, not the file+parsePrimary :: LBS.ByteString -> Either String [RpmEntry]+parsePrimary bs =+  first (\e -> show (e :: SomeException)) (runConduit (sourceLazy bs .| parseBytes def .| foldlC stepPrimary st0))+    >>= finishPrimary++-- | parse primary.xml straight from a handle.+--+-- reading the handle chunk by chunk matters: handing the parser a lazy+-- ByteString instead lets the thunk evaluating it hold on to the start of the+-- stream, which keeps the whole decompressed file (250MB for Fedora) alive+-- until parsing ends+parsePrimaryHandle :: Handle -> IO (Either String [RpmEntry])+parsePrimaryHandle h = do+  r <- try (runConduit (sourceHandle h .| parseBytes def .| foldlC stepPrimary st0))+  pure (either (\e -> Left (show (e :: SomeException))) finishPrimary r)++st0 :: St+st0 = St emptyAcc CapNone [] 0++finishPrimary :: St -> Either String [RpmEntry]+finishPrimary final+  | stDepth final /= 0 = Left "primary.xml ends in the middle of an element, truncated download?"+  | otherwise = Right (reverse (stOut final))++-- | one xml event. tracks element depth so truncation can be detected+stepPrimary :: St -> Event -> St+stepPrimary cur ev = case ev of+  EventBeginElement _ _ -> step cur {stDepth = stDepth cur + 1} ev+  EventEndElement _ -> step cur {stDepth = stDepth cur - 1} ev+  _ -> step cur ev+  where+    step st = \case+      EventBeginElement name attrs+        | name == commonNs "package" -> st {stAcc = emptyAcc, stCap = CapNone}+        | name == commonNs "name" -> st {stCap = CapName}+        | name == commonNs "arch" -> st {stCap = CapArch}+        | name == rpmNs "sourcerpm" -> st {stCap = CapSrpm}+        | name == commonNs "version" ->+            let attr k = lookupAttr k attrs+                evr = EVR <$> (attr "epoch" >>= readInt) <*> attr "ver" <*> attr "rel"+             in st {stAcc = (stAcc st) {accEVR = evr}}+        | name == commonNs "time" ->+            let t = posixSecondsToUTCTime . fromIntegral <$> (lookupAttr "build" attrs >>= readInt)+             in st {stAcc = (stAcc st) {accTime = t}}+        | otherwise -> st+      EventContent (ContentText t) -> case stCap st of+        CapName -> st {stAcc = (stAcc st) {accName = accName (stAcc st) <> t}}+        CapArch -> st {stAcc = (stAcc st) {accArch = accArch (stAcc st) <> t}}+        CapSrpm -> st {stAcc = (stAcc st) {accSrpm = Just (maybe t (<> t) (accSrpm (stAcc st)))}}+        CapNone -> st+      EventEndElement name+        | name == commonNs "package" -> case finish (stAcc st) of+            Just e -> st {stOut = e : stOut st, stCap = CapNone}+            Nothing -> st {stCap = CapNone}+        | otherwise -> st {stCap = CapNone}+      _ -> st++    -- the text we collected is sliced out of the parser's buffers, and a+    -- slice keeps its whole buffer alive. copying is what stops 75k Fedora+    -- entries from pinning the entire decompressed file in memory+    --+    -- the build time needs the same care. UTCTime's fields are lazy, so+    -- without a deep force it stays a thunk pointing at the xml attribute it+    -- came from, which pins that attribute's whole decoder chunk+    finish PkgAcc {..} = do+      EVR e v r <- accEVR+      t <- accTime+      if T.null accName+        then Nothing+        else t `deepseq` (Just $! RpmEntry (T.copy accName) (T.copy accArch) (EVR e (T.copy v) (T.copy r)) (T.copy <$!> accSrpm) t)++    lookupAttr :: Name -> [(Name, [Content])] -> Maybe Text+    lookupAttr k attrs = do+      cs <- lookup k attrs+      pure (T.concat (mapMaybe contentText cs))++    contentText = \case+      ContentText t -> Just t+      ContentEntity _ -> Nothing++    readInt :: Text -> Maybe Int+    readInt t = case TR.decimal t of+      Right (n, "") -> Just n+      _ -> Nothing++-- | source package name from a srpm filename: strip ".src.rpm", then the last+-- two dash-separated fields (version and release)+srpmName :: Text -> Maybe Text+srpmName file = do+  base <- T.stripSuffix ".src.rpm" file+  let parts = T.splitOn "-" base+  if length parts < 3+    then Nothing+    else Just (T.intercalate "-" (take (length parts - 2) parts))++-- | collapse binary rpms down to one build per source package, keeping the+-- newest build time. this is what lets us line repodata up with the monorepo+latestBySource :: [RpmEntry] -> Map Text RepoBuild+latestBySource = foldr step Map.empty+  where+    step e acc = case srcOf e of+      Nothing -> acc+      Just src -> Map.insertWith newer src (RepoBuild (srcEVR e) (rpmBuildTime e)) acc+    srcOf e = maybe (Just (rpmName e)) srpmName (rpmSourceRpm e)+    newer a b = if rbBuildTime a >= rbBuildTime b then a else b+    -- binary subpackages can carry their own Version/Release, so prefer the+    -- EVR spelled out in the srpm filename when there is one+    srcEVR e = case rpmSourceRpm e >>= srpmEVR of+      Just evr -> evr {evrEpoch = evrEpoch (rpmEVR e)}+      Nothing -> rpmEVR e+    srpmEVR file = do+      base <- T.stripSuffix ".src.rpm" file+      let parts = T.splitOn "-" base+      case reverse parts of+        rel : ver : _ : _ -> Just (EVR 0 ver rel)+        _ -> Nothing

@@ -0,0 +1,218 @@+-- | figures out where an update.rhai gets its version from, without running it.+--+-- evaluating Rhai would mean reimplementing andax, so instead we:+--+--   1. lex the script into tokens with megaparsec (strings, identifiers,+--      punctuation, comments dropped)+--   2. find what's passed to `rpm.version(...)` or `rpm.global("ver", ...)`+--   3. if that's a variable, follow its `let` binding+--   4. if it's (or starts with) a known andax helper like gh("owner/repo"),+--      that's the source+--+-- versions that follow another distro or package (bodhi, madoguchi, nvidia)+-- become 'Derived'. anything fancier, like custom get_json scraping, ends up as+-- 'Unknown', and the unparsed-rhai check lists those+module Oglyad.Source.Rhai+  ( parseUpdateRhai,+    Token (..),+    tokenize,+  )+where++import Data.Char (isAlphaNum, isDigit, isSpace)+import Data.List (nub)+import Data.Maybe (listToMaybe, mapMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Void (Void)+import Oglyad.Types (CrateField (..), UpstreamSource (..))+import Text.Megaparsec hiding (Token)+import Text.Megaparsec.Char (char, space1)+import Text.Megaparsec.Char.Lexer qualified as L++data Token+  = TIdent Text+  | TStr Text+  | TNum Text+  | TSym Char+  deriving stock (Eq, Show)++type Parser = Parsec Void Text++parseUpdateRhai :: Text -> UpstreamSource+parseUpdateRhai src = case tokenize src of+  Nothing -> Unknown (T.strip src)+  Just toks -> case resolveVersion toks of+    Just s -> s+    Nothing+      | hasCommitCall toks -> CommitTracked+      -- no rpm.version we could follow, but the script only ever calls one+      -- source helper, so that's almost certainly it+      | [s] <- nub (allSources toks) -> s+      | otherwise -> Unknown (T.strip src)++-- * lexing++tokenize :: Text -> Maybe [Token]+tokenize = either (const Nothing) Just . parse (sc *> many tokenP <* eof) "update.rhai"++sc :: Parser ()+sc = L.space space1 (L.skipLineComment "//") (L.skipBlockComment "/*" "*/")++tokenP :: Parser Token+tokenP =+  L.lexeme sc $+    choice+      [ TStr <$> quoted '"',+        TStr <$> raw, -- template strings, ${} left as-is+        TStr <$> quoted '\'', -- char literals+        TIdent <$> takeWhile1P (Just "identifier") (\c -> isAlphaNum c || c == '_'),+        TNum <$> takeWhile1P (Just "number") isDigit,+        TSym <$> satisfy (not . isSpace)+      ]+  where+    -- backtick strings are raw in Rhai, so regexes like `[\d.]+` stay intact+    raw = char '`' *> takeWhileP Nothing (/= '`') <* char '`'+    -- in quoted strings a backslash escapes whatever follows it. we only care+    -- about the text being roughly right, so unknown escapes are kept as-is+    quoted q = T.pack <$> (char q *> manyTill (escaped <|> anySingle) (char q))+    escaped = char '\\' *> fmap unescape anySingle+    unescape = \case+      'n' -> '\n'+      't' -> '\t'+      c -> c++-- * analysis++-- | follow rpm.version(...) / rpm.global("ver", ...) back to a source helper+resolveVersion :: [Token] -> Maybe UpstreamSource+resolveVersion toks = listToMaybe (mapMaybe (resolveExpr toks 5) (versionExprs toks))++-- | every expression handed to something that sets the package version+versionExprs :: [Token] -> [[Token]]+versionExprs = \case+  [] -> []+  TIdent "rpm" : TSym '.' : TIdent "version" : TSym '(' : rest ->+    argsOf rest <> versionExprs rest+  TIdent "rpm" : TSym '.' : TIdent f : TSym '(' : TStr key : TSym ',' : rest+    | f `elem` ["global", "define"],+      key `elem` ["ver", "version"] ->+        argsOf' rest <> versionExprs rest+  _ : rest -> versionExprs rest+  where+    -- rpm.version(EXPR)+    argsOf rest = [takeBalanced rest]+    -- rpm.global("ver", EXPR), we're already past the comma+    argsOf' rest = [takeBalanced rest]++-- | tokens up to the ')' that closes the call we're inside+takeBalanced :: [Token] -> [Token]+takeBalanced = go (0 :: Int)+  where+    go _ [] = []+    go depth (t : ts) = case t of+      TSym c+        | c `elem` ("([{" :: String) -> t : go (depth + 1) ts+        | c `elem` (")]}" :: String) -> if depth == 0 then [] else t : go (depth - 1) ts+        | c == ',' && depth == 0 -> []+      _ -> t : go depth ts++-- | what does this expression get its value from? fuel stops let-cycles+resolveExpr :: [Token] -> Int -> [Token] -> Maybe UpstreamSource+resolveExpr toks fuel expr+  | fuel <= 0 = Nothing+  | otherwise = case expr of+      -- a helper call, possibly with a method chain after it+      _ | Just (s, _) <- sourceCall expr -> Just s+      -- a helper from one of the shared andax/*.rhai modules, e.g.+      -- bump::madoguchi(...) or nvidia::nvidia_driver_version()+      TIdent m : TSym ':' : TSym ':' : TIdent f : TSym '(' : _ -> Just (Derived (m <> "::" <> f))+      TIdent f : TSym '(' : _ | f `elem` derivedHelpers -> Just (Derived f)+      -- some other call like find(`regex`, tag, 1): the version comes from+      -- whichever argument we can trace back to a source+      TIdent _ : TSym '(' : rest ->+        listToMaybe (mapMaybe (resolveExpr toks (fuel - 1)) (splitArgs rest))+      -- a variable, possibly with methods: `v` or `v.crop(1)`+      TIdent v : _ -> do+        bound <- letBinding v toks+        resolveExpr toks (fuel - 1) bound+      _ -> Nothing++-- | split the arguments of a call we're inside, up to its closing ')'+splitArgs :: [Token] -> [[Token]]+splitArgs toks = case takeBalanced toks of+  [] -> []+  arg ->+    arg : case drop (length arg) toks of+      TSym ',' : rest -> splitArgs rest+      _ -> []++-- | the right-hand side of `let v = ...;` (first binding wins)+letBinding :: Text -> [Token] -> Maybe [Token]+letBinding v = \case+  [] -> Nothing+  TIdent "let" : TIdent v' : TSym '=' : rest | v == v' -> Just (takeWhile (/= TSym ';') rest)+  _ : rest -> letBinding v rest++-- | recognize an andax source helper at the start of a token list+sourceCall :: [Token] -> Maybe (UpstreamSource, [Token])+sourceCall = \case+  TIdent f : TSym '(' : TStr a : TSym ',' : TStr b : TSym ')' : rest+    | Just s <- twoArg f a b -> Just (s, rest)+  TIdent f : TSym '(' : TStr a : TSym ')' : rest+    | Just s <- oneArg f a -> Just (s, rest)+  _ -> Nothing+  where+    oneArg f a = case f of+      "gh" -> Just (GitHub a)+      "gh_tag" -> Just (GitHubTag a)+      "gitlab" -> Just (GitLab "gitlab.com" a)+      "gitlab_tag" -> Just (GitLabTag "gitlab.com" a)+      "codeberg" -> Just (Gitea "codeberg.org" a)+      "sourcehut" -> Just (GitTags ("https://git.sr.ht/" <> a))+      "tangled" -> Just (GitTags ("https://tangled.org/" <> a))+      "codeberg_tag" -> Just (GiteaTag "codeberg.org" a)+      "pypi" -> Just (PyPI a)+      "crates" -> Just (Crates MaxStable a)+      "crates_max" -> Just (Crates Max a)+      "crates_newest" -> Just (Crates Newest a)+      "npm" -> Just (Npm a)+      "hackage" -> Just (Hackage a)+      "gems" -> Just (Gems a)+      "hex" -> Just (Hex a)+      "cran" -> Just (Cran a)+      "opam" -> Just (Opam a)+      _ -> Nothing+    twoArg f a b = case f of+      "gitlab" -> Just (GitLab a b)+      "gitlab_tag" -> Just (GitLabTag a b)+      "gitea" -> Just (Gitea a b)+      "gitea_tag" -> Just (GiteaTag a b)+      "forgejo" -> Just (Gitea a b)+      "forgejo_tag" -> Just (GiteaTag a b)+      "ansible_galaxy" -> Just (AnsibleGalaxy a b)+      _ -> Nothing++-- | helpers whose version follows something other than an upstream release+derivedHelpers :: [Text]+derivedHelpers =+  [ "bodhi",+    "bodhi_vr",+    "madoguchi",+    "alma",+    "nvidia_driver_version",+    "nvidia_legacy_version",+    "nvidia_component_version"+  ]++allSources :: [Token] -> [UpstreamSource]+allSources = \case+  [] -> []+  ts@(_ : rest) -> maybe id ((:) . fst) (sourceCall ts) (allSources rest)++-- | does the script call any *_commit helper (gh_commit, gitlab_commit, ...)?+hasCommitCall :: [Token] -> Bool+hasCommitCall = \case+  TIdent f : TSym '(' : _ | "_commit" `T.isSuffixOf` f -> True+  _ : rest -> hasCommitCall rest+  [] -> False

@@ -0,0 +1,102 @@+-- | asks upstreams what their latest version is, using the same endpoints and+-- json fields as anda's andax helpers (andax/fns/tsunagu.rs in FyraLabs/anda)+-- so oglyad sees exactly what `anda update` would see+module Oglyad.Source.Upstream+  ( latestVersion,+  )+where++import Control.Monad.Reader (liftIO)+import Data.Aeson (Value (..), eitherDecode)+import Data.Aeson.Key qualified as Key+import Data.Aeson.KeyMap qualified as KM+import Data.Bifunctor (first)+import Data.List (maximumBy)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector qualified as V+import Oglyad.App (App, HttpError (..), httpGetE)+import Oglyad.Process (run)+import Oglyad.Types (CrateField (..), UpstreamSource (..))+import Oglyad.Version (normalizeVersion, rpmvercmp)++-- | a step into a json document: an object key or an array index+data Step = K Text | I Int++-- | latest upstream version, or a reason we couldn't get it+latestVersion :: UpstreamSource -> App (Either HttpError Text)+latestVersion = \case+  GitHub repo -> json ("https://api.github.com/repos/" <> repo <> "/releases/latest") [K "tag_name"]+  GitHubTag repo -> json ("https://api.github.com/repos/" <> repo <> "/tags?per_page=1") [I 0, K "name"]+  GitLab host i -> json ("https://" <> host <> "/api/v4/projects/" <> i <> "/releases/") [I 0, K "tag_name"]+  GitLabTag host i -> json ("https://" <> host <> "/api/v4/projects/" <> i <> "/repository/tags") [I 0, K "name"]+  Gitea host repo -> json ("https://" <> host <> "/api/v1/repos/" <> repo <> "/releases/latest") [K "tag_name"]+  GiteaTag host repo -> json ("https://" <> host <> "/api/v1/repos/" <> repo <> "/tags") [I 0, K "name"]+  PyPI name -> json ("https://pypi.org/pypi/" <> name <> "/json") [K "info", K "version"]+  Crates field name -> json ("https://crates.io/api/v1/crates/" <> name) [K "crate", K (crateKey field)]+  Npm name -> json ("https://registry.npmjs.org/" <> name <> "/latest") [K "version"]+  Hackage name -> json ("https://hackage.haskell.org/package/" <> name <> "/preferred.json") [K "normal-version", I 0]+  Gems name -> json ("https://rubygems.org/api/v1/versions/" <> name <> "/latest.json") [K "version"]+  Hex name -> json ("https://hex.pm/api/packages/" <> name) [K "latest_stable_version"]+  Cran name -> json ("https://crandb.r-pkg.org/" <> name) [K "Version"]+  Opam name -> opam name+  AnsibleGalaxy ns coll ->+    json+      ("https://galaxy.ansible.com/api/v3/plugin/ansible/content/published/collections/index/" <> ns <> "/" <> coll <> "/versions/?limit=1&ordering=-version")+      [K "data", I 0, K "version"]+  GitTags url -> first HttpFailed <$> liftIO (gitTags url)+  Derived how -> pure (Left (HttpFailed ("follows " <> how <> ", not an upstream release")))+  CommitTracked -> pure (Left (HttpFailed "tracks a commit, not a version"))+  Unknown _ -> pure (Left (HttpFailed "unparsed update.rhai"))+  where+    crateKey = \case+      MaxStable -> "max_stable_version"+      Max -> "max_version"+      Newest -> "newest_version"++-- | GET a url and walk a path into the json it returns+json :: Text -> [Step] -> App (Either HttpError Text)+json url path = do+  body <- httpGetE url+  pure $ do+    v <- body >>= either (\e -> Left (HttpFailed ("bad json from " <> url <> ": " <> T.pack e))) Right . eitherDecode+    case walk path v of+      Just (String s) | not (T.null s) -> Right s+      _ -> Left (HttpFailed ("no version at expected spot in " <> url))++walk :: [Step] -> Value -> Maybe Value+walk [] v = Just v+walk (K k : rest) (Object o) = KM.lookup (Key.fromText k) o >>= walk rest+walk (I i : rest) (Array a) = a V.!? i >>= walk rest+walk _ _ = Nothing++-- | opam has no "latest" endpoint. anda lists the package's directory in+-- ocaml/opam-repository and picks the highest `name.version` entry+opam :: Text -> App (Either HttpError Text)+opam name = do+  let url = "https://api.github.com/repos/ocaml/opam-repository/contents/packages/" <> name+  body <- httpGetE url+  pure $ do+    v <- body >>= either (Left . HttpFailed . T.pack) Right . eitherDecode+    let versions = case v of+          Array entries ->+            [ ver+            | Object o <- V.toList entries,+              Just (String n) <- [KM.lookup "name" o],+              Just ver <- [T.stripPrefix (name <> ".") n]+            ]+          _ -> []+    case versions of+      [] -> Left (HttpFailed ("no versions listed at " <> url))+      _ -> Right (maximumBy rpmvercmp versions)++-- | newest tag on a git remote, for forges without a releases api.+-- `git ls-remote` speaks the smart http protocol, so nothing gets cloned+gitTags :: Text -> IO (Either Text Text)+gitTags url = do+  out <- run "git" ["ls-remote", "--tags", "--refs", T.unpack url]+  pure $ case out of+    Left err -> Left ("git ls-remote failed for " <> url <> ": " <> err)+    Right o -> case [t | l <- T.lines o, Just t <- [T.stripPrefix "refs/tags/" (T.takeWhileEnd (/= '\t') l)]] of+      [] -> Left ("no tags at " <> url)+      tags -> Right (maximumBy (\a b -> rpmvercmp (normalizeVersion a) (normalizeVersion b)) tags)

@@ -0,0 +1,173 @@+module Oglyad.Types+  ( EVR (..),+    UpstreamSource (..),+    CrateField (..),+    Package (..),+    RepoBuild (..),+    Severity (..),+    Finding (..),+    finding,+    Snapshot (..),+    Config (..),+    Check,+  )+where++import Data.Aeson (FromJSON, ToJSON (..), Value (String))+import Data.Map.Strict (Map)+import Data.Set (Set)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Time (NominalDiffTime, UTCTime)+import GHC.Generics (Generic)+import Oglyad.Version (EVR (..))++-- | which version field of a crate anda reads+data CrateField+  = -- | crates()+    MaxStable+  | -- | crates_max()+    Max+  | -- | crates_newest()+    Newest+  deriving stock (Eq, Ord, Show, Read, Generic)+  deriving anyclass (ToJSON, FromJSON)++-- | where a package's upstream version comes from, recovered from update.rhai.+-- constructors mirror the andax helpers in FyraLabs/anda (andax/fns/tsunagu.rs)+data UpstreamSource+  = -- | gh("owner/repo"), latest release+    GitHub Text+  | -- | gh_tag("owner/repo"), newest tag+    GitHubTag Text+  | -- | gitlab([domain,] id), latest release+    GitLab Text Text+  | -- | gitlab_tag([domain,] id)+    GitLabTag Text Text+  | -- | gitea(host, repo) and codeberg(repo)+    Gitea Text Text+  | -- | gitea_tag(host, repo) and codeberg_tag(repo)+    GiteaTag Text Text+  | PyPI Text+  | Crates CrateField Text+  | Npm Text+  | Hackage Text+  | Gems Text+  | Hex Text+  | Cran Text+  | Opam Text+  | -- | namespace, collection+    AnsibleGalaxy Text Text+  | -- | newest tag of any git remote (sourcehut, tangled)+    GitTags Text+  | -- | follows another distro or package (bodhi, madoguchi, nvidia), not upstream+    Derived Text+  | -- | follows a branch head (gh_commit and friends), no version to compare+    CommitTracked+  | -- | raw update.rhai we couldn't make sense of+    Unknown Text+  deriving stock (Eq, Ord, Show, Read, Generic)+  deriving anyclass (ToJSON, FromJSON)++-- | what Terra's published repodata says about a source package+data RepoBuild = RepoBuild+  { rbEVR :: EVR,+    rbBuildTime :: UTCTime+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (ToJSON, FromJSON)++-- | one source package, merged from every data source we know about+data Package = Package+  { pkgName :: Text,+    -- | relative to the monorepo, e.g. anda/devs/zed/stable+    pkgPath :: FilePath,+    -- | Terra subrepo from anda.hcl labels, e.g. "extras"+    pkgSubrepo :: Maybe Text,+    -- | what's merged in git+    pkgSpecEVR :: Maybe EVR,+    -- | what's actually published+    pkgRepoBuild :: Maybe RepoBuild,+    pkgLastCommit :: Maybe UTCTime,+    -- | Nothing means no update.rhai+    pkgUpstream :: Maybe UpstreamSource,+    -- | only filled in when upstream lookups ran+    pkgUpstreamVer :: Maybe Text,+    -- | why the upstream lookup failed, if it did+    pkgUpstreamErr :: Maybe Text,+    -- | whether the repo this package publishes to was fetched. when it+    -- wasn't, pkgRepoBuild = Nothing means "unknown", not "never published"+    pkgRepoChecked :: Bool+  }+  deriving stock (Eq, Show)++data Severity = Info | Warn | Error+  deriving stock (Eq, Ord, Show, Enum, Bounded, Generic)++instance ToJSON Severity where+  toJSON = \case+    Info -> String "info"+    Warn -> String "warn"+    Error -> String "error"++data Finding = Finding+  { fCheck :: Text,+    fPackage :: Text,+    -- | the package's directory in the monorepo. package names aren't unique+    -- (see the duplicate-name check), so this is what identifies it+    fPath :: Maybe Text,+    fSeverity :: Severity,+    fMessage :: Text+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (ToJSON)++-- | a finding about a package+finding :: Text -> Package -> Severity -> Text -> Finding+finding check p sev msg =+  Finding+    { fCheck = check,+      fPackage = pkgName p,+      fPath = Just (T.pack (pkgPath p)),+      fSeverity = sev,+      fMessage = msg+    }++data Config = Config+  { -- | local checkout of terrapkg/packages+    cfgMonorepo :: FilePath,+    -- | e.g. https://repos.fyralabs.com/terra44+    cfgTerraRepo :: Text,+    -- | repo base urls to check for overlap+    cfgFedoraRepos :: [Text],+    -- | %{dist} used when evaluating specs, e.g. .fc44+    -- | Fedora/Terra release number, e.g. 44+    cfgRelease :: Int,+    cfgDist :: Text,+    cfgStaleAfter :: NominalDiffTime,+    -- | whether to hit upstream APIs at all+    cfgUpstream :: Bool,+    -- | reuse cached upstream answers younger than this+    cfgCacheFor :: NominalDiffTime,+    -- | parallel jobs, defaults to the number of cores+    cfgConcurrency :: Int,+    cfgGitHubToken :: Maybe Text+  }+  deriving stock (Show)++-- | everything a check is allowed to look at, already collected.+-- checks never do IO, which is what keeps them trivially testable+data Snapshot = Snapshot+  { -- | keyed by monorepo path, since names can repeat+    snapPackages :: Map FilePath Package,+    -- | source package names present in Fedora+    snapFedora :: Set Text,+    snapNow :: UTCTime,+    snapConfig :: Config,+    -- | the monorepo commit this run looked at+    snapHead :: Maybe Text,+    -- | check names each package dir's anda.hcl asks to ignore+    snapIgnoreLabels :: Map FilePath [Text]+  }++type Check = Snapshot -> Package -> [Finding]

@@ -0,0 +1,161 @@+-- | RPM version handling: EVR parsing and the rpmvercmp algorithm+--+-- reference implementation: rpmio/rpmvercmp.c in rpm-software-management/rpm+-- test vectors: tests/rpmvercmp.at in the same repo+module Oglyad.Version+  ( EVR (..),+    parseEVR,+    renderEVR,+    rpmvercmp,+    compareEVR,+    normalizeVersion,+    compareUpstream,+  )+where++import Data.Aeson (FromJSON, ToJSON)+import Data.Char (isAlphaNum, isAsciiLower, isAsciiUpper, isDigit)+import Data.List (find)+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Generics (Generic)+import Text.Read (readMaybe)++-- | epoch:version-release+--+-- note: 'Eq' is structural but 'Ord' goes through rpmvercmp, so "1.05" and+-- "1.5" compare EQ while being /=. build-lag relies on the structural Eq on+-- purpose, since any textual difference between git and the repo is worth+-- reporting+data EVR = EVR+  { evrEpoch :: !Int,+    evrVersion :: !Text,+    evrRelease :: !Text+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (ToJSON, FromJSON)++instance Ord EVR where+  compare = compareEVR++-- | parse "[epoch:]version-release". a missing epoch or "(none)" means 0+parseEVR :: Text -> Maybe EVR+parseEVR raw = do+  let (epochPart, rest) = case T.breakOn ":" raw of+        (vr, "") -> ("0", vr)+        (e, r) -> (e, T.drop 1 r)+  epoch <- if epochPart == "(none)" then Just 0 else readMaybe (T.unpack epochPart)+  -- release is everything after the *last* dash, versions can't contain dashes+  let (verDash, rel) = T.breakOnEnd "-" rest+  ver <- T.stripSuffix "-" verDash+  if T.null ver || T.null rel then Nothing else Just (EVR epoch ver rel)++renderEVR :: EVR -> Text+renderEVR (EVR 0 v r) = v <> "-" <> r+renderEVR (EVR e v r) = T.pack (show e) <> ":" <> v <> "-" <> r++compareEVR :: EVR -> EVR -> Ordering+compareEVR (EVR e1 v1 r1) (EVR e2 v2 r2) =+  compare e1 e2 <> rpmvercmp v1 v2 <> rpmvercmp r1 r2++-- | compare two version (or release) strings exactly the way rpm does.+-- this is a line-by-line port of rpmvercmp.c+--+--   * anything that isn't an ascii letter, digit, '~' or '^' is a separator+--   * '~' sorts before everything, even the end of the string (1.0~rc1 < 1.0)+--   * '^' sorts after the end of the string but before anything else+--     (1.0 < 1.0^git1 < 1.0.1)+--   * otherwise compare segment by segment, where a segment is a run of+--     digits or a run of letters. numbers beat letters, numbers compare+--     numerically, letters compare lexically+--   * when one side runs out, the side with stuff left is newer+rpmvercmp :: Text -> Text -> Ordering+rpmvercmp a b+  | a == b = EQ+  | otherwise = go a b+  where+    go one0 two0+      | T.null one0 && T.null two0 = EQ+      | otherwise =+          let one = T.dropWhile isSep one0+              two = T.dropWhile isSep two0+           in case (T.uncons one, T.uncons two) of+                -- tilde: whoever has it is older+                (Just ('~', one'), Just ('~', two')) -> go one' two'+                (Just ('~', _), _) -> LT+                (_, Just ('~', _)) -> GT+                -- caret: older than anything except the end of the string+                (Just ('^', one'), Just ('^', two')) -> go one' two'+                (Nothing, Just ('^', _)) -> LT+                (Just ('^', _), Nothing) -> GT+                (Just ('^', _), Just _) -> LT+                (Just _, Just ('^', _)) -> GT+                -- one side ran out+                (Nothing, Nothing) -> EQ+                (Just _, Nothing) -> GT+                (Nothing, Just _) -> LT+                (Just (c, _), Just _)+                  | isDigit c -> segment True (T.span isDigit one) (T.span isDigit two)+                  | otherwise -> segment False (T.span isAlpha one) (T.span isAlpha two)++    segment isNum (seg1, rest1) (seg2, rest2)+      -- the other side has a different kind of segment here.+      -- numeric beats alpha+      | T.null seg2 = if isNum then GT else LT+      | isNum =+          let n1 = T.dropWhile (== '0') seg1+              n2 = T.dropWhile (== '0') seg2+           in compare (T.length n1) (T.length n2) <> compare n1 n2 <> go rest1 rest2+      | otherwise = compare seg1 seg2 <> go rest1 rest2++    isAlpha c = isAsciiLower c || isAsciiUpper c+    isSep c = not (isDigit c || isAlpha c || c == '~' || c == '^')++-- | turn an upstream tag (or a sloppy spec Version) into something+-- rpmvercmp can compare. starts from what anda's rpm.version() does (trim,+-- drop a leading v, dashes become dots) and adds:+--+--   * monorepo tags like "pkg/v1.2" keep only the part after the last slash+--   * non-numeric prefixes go, so "release-1.2" and "jq-1.7" line up+--   * prerelease markers become tildes like Fedora spells them,+--     so "6.0.0-alpha1" becomes "6.0.0~alpha1"+normalizeVersion :: Text -> Text+normalizeVersion raw =+  let t = T.takeWhileEnd (/= '/') (T.strip raw)+      noV = maybe t id (T.stripPrefix "v" t)+      fromDigit = case T.dropWhile (not . isDigit) noV of+        "" -> noV+        d -> d+   in T.replace "-" "." (tildePre fromDigit)++-- | "-rc1" / ".beta" / "_alpha2" → "~rc1" / "~beta" / "~alpha2"+tildePre :: Text -> Text+tildePre t = case T.uncons t of+  Nothing -> ""+  Just (c, rest)+    | c `elem` ("-._" :: String), Just _ <- marker rest -> T.cons '~' (tildePre rest)+    | otherwise -> T.cons c (tildePre rest)+  where+    marker r = find (`T.isPrefixOf` T.toLower r) ["alpha", "beta", "rc", "pre", "dev"]++-- | compare an upstream version with a spec Version, forgiving the usual+-- ways packagers respell a version. returns how upstream compares to the spec+--+--   * same letters and digits, different punctuation is the same version+--     (0.4.2 vs 0.4~2, 2026.07.27 vs 20260727)+--   * the same leading dotted number with junk after it is the same version+--     (2.005R vs 2.005, 3.17.0-ogc1 vs 3.17.0^1), unless one side is a+--     prerelease, since 6.0.0 vs 6.0.0~alpha1 is real drift+--   * otherwise rpmvercmp decides+compareUpstream :: Text -> Text -> Ordering+compareUpstream up spec+  | squash u == squash s = EQ+  | not (T.null (core u)) && core u == core s && not (isPre u || isPre s) = EQ+  | otherwise = rpmvercmp u s+  where+    u = normalizeVersion up+    s = normalizeVersion spec+    squash = T.toLower . T.filter isAlphaNum+    core = T.dropWhileEnd (== '.') . T.takeWhile (\c -> isDigit c || c == '.')+    -- a prerelease is never "the same version with junk after it"+    isPre v = "~" `T.isPrefixOf` T.drop (T.length (core v)) (T.dropWhileEnd (== '.') v)

@@ -0,0 +1,451 @@+module Main (main) where++import Control.Exception (bracket)+import Control.Monad (forM_)+import Data.Aeson (Value (..), decode)+import Data.Aeson.KeyMap qualified as KM+import Data.ByteString.Lazy.Char8 qualified as LBS8+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Data.Time (UTCTime (..), addUTCTime, fromGregorian, nominalDay)+import Oglyad.App (runApp)+import Oglyad.Check (checkNames, parseCheckName)+import Oglyad.Check.BuildLag qualified as BuildLag+import Oglyad.Check.Drift qualified as Drift+import Oglyad.Check.DuplicateName qualified as DuplicateName+import Oglyad.Check.FedoraOverlap qualified as FedoraOverlap+import Oglyad.Check.Stale qualified as Stale+import Oglyad.Ignore+import Oglyad.Process (childEnv, run)+import Oglyad.Report (Report (..), renderJson, renderMarkdown, renderText)+import Oglyad.Source.Monorepo (PkgDir (..), findPackageDirs, hclString, lastCommits, macroFingerprint, specFingerprint)+import Oglyad.Source.Repodata (RpmEntry (..), decompressAndParse, fetchRepo, latestBySource, parsePrimary, srpmName)+import Oglyad.Source.Rhai (parseUpdateRhai)+import Oglyad.Types+import Oglyad.Version+import System.Directory (createDirectoryIfMissing, createDirectoryLink, createFileLink)+import System.Environment (lookupEnv, setEnv, unsetEnv)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import System.Process.Typed (byteStringInput, proc, readProcess, runProcess_, setEnv, setStdin)+import Test.Hspec+import Test.QuickCheck++main :: IO ()+main = hspec $ do+  describe "parseEVR" $ do+    it "parses version-release" $+      parseEVR "1.2.3-1.fc44" `shouldBe` Just (EVR 0 "1.2.3" "1.fc44")+    it "parses an epoch" $+      parseEVR "2:1.0-3" `shouldBe` Just (EVR 2 "1.0" "3")+    it "treats (none) as epoch 0" $+      parseEVR "(none):1.0-3" `shouldBe` Just (EVR 0 "1.0" "3")+    it "rejects a missing release" $+      parseEVR "1.0" `shouldBe` Nothing++  -- vectors from rpm's tests/rpmvercmp.at+  describe "rpmvercmp" $ do+    mapM_+      vercmpCase+      [ ("1.0", "1.0", EQ),+        ("1.0", "2.0", LT),+        ("2.0.1", "2.0", GT),+        ("2.0.1a", "2.0.1", GT),+        ("5.5p1", "5.5p2", LT),+        ("5.5p10", "5.5p1", GT),+        ("10xyz", "10.1xyz", LT),+        ("xyz10", "xyz10.1", LT),+        ("xyz.4", "8", LT),+        ("1.05", "1.5", EQ),+        ("2.0", "2_0", EQ),+        ("2a", "2.0", LT),+        ("1.0~rc1", "1.0", LT),+        ("1.0~rc1", "1.0~rc2", LT),+        ("1.0~rc1~git123", "1.0~rc1", LT),+        ("1.0^", "1.0", GT),+        ("1.0^git1", "1.01", LT),+        ("1.0^git1~pre", "1.0^git1", LT),+        ("1.0~rc1^git1", "1.0~rc1", GT),+        ("1.0^git1", "1.0^git2", LT),+        ("1.0^20160101", "1.0.1", LT)+      ]+    it "is reflexive" $ property $ \(V a) -> rpmvercmp a a == EQ+    it "is antisymmetric" $ property $ \(V a) (V b) ->+      rpmvercmp a b == flipOrd (rpmvercmp b a)++  describe "normalizeVersion" $ do+    it "drops a leading v" $ normalizeVersion "v1.2.3" `shouldBe` "1.2.3"+    it "drops a name prefix" $ normalizeVersion "jq-1.7.1" `shouldBe` "1.7.1"+    it "drops a monorepo tag prefix" $ normalizeVersion "v2/v1.0.28" `shouldBe` "1.0.28"+    it "turns dashes into dots like anda" $ normalizeVersion "2024-01-05" `shouldBe` "2024.01.05"+    it "spells prereleases with a tilde" $ normalizeVersion "6.0.0-alpha1" `shouldBe` "6.0.0~alpha1"++  describe "compareUpstream" $ do+    mapM_+      (\(up, spec, o) -> it (T.unpack up <> " vs spec " <> T.unpack spec) $ compareUpstream up spec `shouldBe` o)+      [ ("v1.3.0", "1.2.0", GT),+        ("v1.2.0", "1.2.0", EQ),+        ("1.2.0", "1.3.0", LT),+        ("6.0.0-alpha1", "6.0.0~alpha1", EQ),+        ("6.0.0", "6.0.0~alpha1", GT),+        ("0.4.2", "0.4~2", EQ),+        ("2026-07-27", "20260727", EQ),+        ("2.005R", "2.005", EQ),+        ("3.17.0-ogc1", "3.17.0^1", EQ),+        ("6.7.3", "v6.7.3", EQ),+        ("0.42.0", "0.41.0^20261031.9e2ed65", GT),+        -- a snapshot taken after the release it's based on isn't drift+        ("0.41.0", "0.41.0^20261031.9e2ed65", EQ)+      ]++  describe "srpmName" $ do+    it "strips version and release" $+      srpmName "zed-0.190.0-1.fc44.src.rpm" `shouldBe` Just "zed"+    it "keeps dashes in the name" $+      srpmName "python-foo-bar-1.0-2.fc44.src.rpm" `shouldBe` Just "python-foo-bar"++  describe "parsePrimary" $ do+    let entries = either (const []) id (parsePrimary primaryFixture)+        firstOf f = map f (take 1 entries)+    it "finds every package" $ map rpmName entries `shouldBe` ["zed", "zed-cli"]+    it "reads the EVR" $ firstOf rpmEVR `shouldBe` [EVR 0 "0.190.0" "1.fc44"]+    it "reads the build time" $ firstOf rpmBuildTime `shouldBe` [posix 1794200000]+    it "reads the source rpm" $ firstOf rpmSourceRpm `shouldBe` [Just "zed-0.190.0-1.fc44.src.rpm"]+    it "groups binaries by source package" $+      Map.keys (latestBySource entries) `shouldBe` ["zed"]+    it "rejects garbage" $ parsePrimary "<metadata><package>" `shouldSatisfy` isLeft+    it "decompresses zstd through the zstd command" $ do+      -- the same fixture, compressed by the real zstd tool+      (_, compressed, _) <- readProcess (setStdin (byteStringInput primaryFixture) (proc "zstd" ["-c", "-q"]))+      r <- decompressAndParse "repodata/abc-primary.xml.zst" compressed+      fmap (map rpmName) r `shouldBe` Right ["zed", "zed-cli"]+    forM_ [("gzip", ".gz"), ("xz", ".xz")] $ \(tool, ext) ->+      it ("decompresses " <> tool <> " through the " <> tool <> " command") $ do+        (_, compressed, _) <- readProcess (setStdin (byteStringInput primaryFixture) (proc tool ["-c", "-q"]))+        r <- decompressAndParse ("repodata/abc-primary.xml" <> T.pack ext) compressed+        fmap (map rpmName) r `shouldBe` Right ["zed", "zed-cli"]+    it "reports corrupt zstd instead of crashing" $ do+      r <- decompressAndParse "repodata/abc-primary.xml.zst" "definitely not zstd"+      r `shouldSatisfy` isLeft++  describe "hclString" $ do+    let hcl = "project pkg {\n  rpm {\n    spec = \"zed.spec\"\n  }\n  labels {\n    subrepo = \"extras\"\n  }\n}\n"+    it "finds the spec" $ hclString "spec" hcl `shouldBe` Just "zed.spec"+    it "finds the subrepo" $ hclString "subrepo" hcl `shouldBe` Just "extras"+    it "doesn't match key prefixes" $ hclString "sub" hcl `shouldBe` Nothing++  describe "parseUpdateRhai" $ do+    it "understands gh()" $+      parseUpdateRhai "rpm.version(gh(\"zed-industries/zed\"));\n" `shouldBe` GitHub "zed-industries/zed"+    it "understands two-arg helpers" $+      parseUpdateRhai "rpm.version(gitea(\"gitea.com\", \"gitea/tea\"));" `shouldBe` Gitea "gitea.com" "gitea/tea"+    it "maps codeberg to gitea" $+      parseUpdateRhai "rpm.version(codeberg(\"a/b\"))" `shouldBe` Gitea "codeberg.org" "a/b"+    it "follows let bindings" $+      parseUpdateRhai "let v = gh_tag(\"x/y\");\nif v.len > 0 {\n  rpm.version(v);\n}" `shouldBe` GitHubTag "x/y"+    it "follows rpm.global(\"ver\", ...)" $+      parseUpdateRhai nightly `shouldBe` GitHub "OpenTabletDriver/OpenTabletDriver"+    it "spots commit tracking" $+      parseUpdateRhai "rpm.global(\"commit\", gh_commit(\"a/b\"));\nif rpm.changed() { rpm.release(); }" `shouldBe` CommitTracked+    it "keeps raw backtick regexes intact" $+      parseUpdateRhai "let v = gh_tag(\"a/b\");\nif `[\\d.]+-beta\\.\\d+`.find_all(v).len == 0 {\n  rpm.version(v);\n}" `shouldBe` GitHubTag "a/b"+    it "follows variables through other calls" $+      parseUpdateRhai "let tag = gh_tag(\"x/ghidra\");\nlet v = find(`Ghidra_([\\d.]+)_build`, tag, 1);\nrpm.version(v);" `shouldBe` GitHubTag "x/ghidra"+    it "marks distro-following versions as derived" $+      parseUpdateRhai "import \"andax/bump_extras.rhai\" as bump;\nrpm.version(bump::madoguchi(\"zig-master\", labels.branch));" `shouldBe` Derived "bump::madoguchi"+    it "ignores comments" $+      parseUpdateRhai "// gh(\"wrong/one\")\nrpm.version(pypi(\"west\"));" `shouldBe` PyPI "west"+    it "falls back to Unknown" $+      parseUpdateRhai "let x = get(\"https://example.com\").json();\nrpm.version(x.version);" `shouldSatisfy` isUnknown++  describe "drift check" $ do+    it "warns when upstream is newer" $+      severities (Drift.check snapshot (pkg {pkgUpstreamVer = Just "v1.3.0"})) `shouldBe` [Warn]+    it "is quiet when versions match" $+      Drift.check snapshot (pkg {pkgUpstreamVer = Just "v1.2.0"}) `shouldBe` []+    it "ignores snapshots ahead of the last release" $+      Drift.check snapshot (pkg {pkgSpecEVR = Just (EVR 0 "1.2.0^20261101git1234abc" "1.fc44"), pkgUpstreamVer = Just "1.2.0"}) `shouldBe` []+    it "is quiet without upstream data" $+      Drift.check snapshot pkg `shouldBe` []++  describe "fedora-overlap check" $ do+    let withFedora = snapshot {snapFedora = Set.singleton "zed"}+    it "warns when Fedora ships the same package" $+      severities (FedoraOverlap.check withFedora pkg) `shouldBe` [Warn]+    it "ignores packages in subrepos" $+      FedoraOverlap.check withFedora (pkg {pkgSubrepo = Just "multimedia"}) `shouldBe` []+    it "is quiet when Fedora doesn't have it" $+      FedoraOverlap.check snapshot pkg `shouldBe` []++  describe "duplicate-name check" $ do+    let other = pkg {pkgPath = "anda/devs/zed/nightly"}+        twoOf a b = snapshot {snapPackages = Map.fromList [(pkgPath a, a), (pkgPath b, b)]}+    it "flags two dirs building the same name into one repo" $+      severities (DuplicateName.check (twoOf pkg other) pkg) `shouldBe` [Warn]+    it "allows the same name in different subrepos" $+      DuplicateName.check (twoOf pkg other {pkgSubrepo = Just "extras"}) pkg `shouldBe` []+    it "is quiet for unique names" $+      DuplicateName.check snapshot pkg `shouldBe` []++  describe "report" $ do+    let f path = Finding "build-lag" "zed" (Just path) Warn "x"+    it "shows the directory when a name is ambiguous" $+      renderText Info (report [f "anda/a", f "anda/b"]) `shouldSatisfy` T.isInfixOf "zed (anda/a): x"+    it "keeps it short otherwise" $+      renderText Info (report [f "anda/a"]) `shouldSatisfy` T.isInfixOf "zed: x"+    it "counts ignored findings in the summary" $+      renderText Info ((report [f "anda/a"]) {rIgnored = [f "anda/b"]}) `shouldSatisfy` T.isInfixOf "(1 ignored)"+    it "wraps json in a versioned envelope" $ do+      let o = case decode (renderJson (report [f "anda/a"])) of+            Just (Object x) -> x+            _ -> KM.empty+      KM.lookup "schema" o `shouldBe` Just (Number 1)+      KM.lookup "summary" o `shouldSatisfy` maybe False (\case Object s -> KM.lookup "warn" s == Just (Number 1); _ -> False)+      KM.lookup "findings" o `shouldSatisfy` maybe False (\case Array a -> length a == 1; _ -> False)+    it "escapes pipes in markdown tables" $+      renderMarkdown Info (report [(f "anda/a") {fMessage = "a|b"}]) `shouldSatisfy` T.isInfixOf "a\\|b"+    it "folds info findings away in markdown" $+      renderMarkdown Info (report [(f "anda/a") {fSeverity = Info}]) `shouldSatisfy` T.isInfixOf "<details><summary>Info (1)"++  describe "ignores" $ do+    let f check path name = Finding check name (Just path) Warn "x"+        dup = f "duplicate-name" "anda/langs/zig/master-bootstrap" "zig-master"+        lag = f "build-lag" "anda/devs/zed/stable" "zed"+        file rules = IgnoreFile rules+        rule check target = IgnoreRule check target "because"+        apply rules labels = applyIgnores checkNames checkNames (file rules) (Map.fromList labels)+    it "parses a valid file" $+      parseIgnoreFile checkNames "{\"ignore\": [{\"check\": \"stale\", \"package\": \"zed\", \"reason\": \"fine\"}]}"+        `shouldBe` Right (file [IgnoreRule "stale" (ByName "zed") "fine"])+    forM_+      [ ("an empty reason", "{\"ignore\": [{\"check\": \"stale\", \"package\": \"zed\", \"reason\": \" \"}]}"),+        ("an unknown check", "{\"ignore\": [{\"check\": \"stael\", \"package\": \"zed\", \"reason\": \"x\"}]}"),+        ("both path and package", "{\"ignore\": [{\"check\": \"stale\", \"package\": \"zed\", \"path\": \"anda/x\", \"reason\": \"x\"}]}")+      ]+      $ \(what, raw) -> it ("rejects " <> what) $ parseIgnoreFile checkNames raw `shouldSatisfy` either (const True) (const False)+    it "ignores by path" $ do+      let Applied {..} = apply [rule "duplicate-name" (ByPath "anda/langs/zig/master-bootstrap")] [] [dup, lag]+      (apKept, apIgnored, apProblems) `shouldBe` ([lag], [dup], [])+    it "ignores by package name" $ do+      let Applied {..} = apply [rule "build-lag" (ByName "zed")] [] [dup, lag]+      (apKept, apIgnored) `shouldBe` ([dup], [lag])+    it "ignores by anda.hcl label" $ do+      let Applied {..} = apply [] [("anda/langs/zig/master-bootstrap", ["duplicate-name"])] [dup, lag]+      (apKept, apIgnored) `shouldBe` ([lag], [dup])+    it "only matches the named check" $ do+      let Applied {..} = apply [rule "stale" (ByName "zed")] [] [lag]+      apKept `shouldBe` [lag]+    it "reports entries that match nothing" $ do+      let Applied {..} = apply [rule "stale" (ByName "gone")] [] [lag]+      map fCheck apProblems `shouldBe` ["unused-ignore"]+    it "doesn't call entries unused when their check didn't run" $ do+      let Applied {..} = applyIgnores checkNames ["build-lag"] (file [rule "stale" (ByName "gone")]) Map.empty [lag]+      apProblems `shouldBe` []+    it "flags unknown check names in labels" $ do+      let Applied {..} = apply [] [("anda/x", ["stael"])] []+      map fSeverity apProblems `shouldBe` [Warn]++  describe "build-lag check" $ do+    it "says never published when the repo was fetched" $+      severities (BuildLag.check snapshot pkg) `shouldBe` [Error]+    it "stays quiet when the repo fetch failed" $+      BuildLag.check snapshot pkg {pkgRepoChecked = False} `shouldBe` []++  describe "child processes" $ do+    it "never get secrets from our environment" $ do+      let env = childEnv [("PATH", "/usr/bin"), ("HOME", "/home/x"), ("GITHUB_TOKEN", "secret"), ("GH_TOKEN", "secret"), ("AWS_SECRET_ACCESS_KEY", "s"), ("LC_ALL", "C")]+      map fst env `shouldMatchList` ["GIT_TERMINAL_PROMPT", "PATH", "HOME", "LC_ALL"]+    it "can't read GITHUB_TOKEN even when spec-like code asks for it" $+      withEnv "GITHUB_TOKEN" "oglyad-test-secret" $ do+        r <- run "sh" ["-c", "env"]+        r `shouldSatisfy` either (const False) (not . T.isInfixOf "oglyad-test-secret")++  describe "filesystem edge cases" $ do+    it "fingerprints a package with a dangling symlink instead of crashing" $+      withSystemTempDirectory "oglyad-fp" $ \root -> do+        createDirectoryIfMissing True (root </> "anda/a")+        writeFile (root </> "anda/a/a.spec") "Name: a"+        createFileLink "does-not-exist" (root </> "anda/a/broken")+        key <- specFingerprint "m" ".fc44" root "anda/a"+        T.length key `shouldBe` 64+    it "doesn't follow a symlink loop" $+      withSystemTempDirectory "oglyad-loop" $ \root -> do+        createDirectoryIfMissing True (root </> "anda/a")+        writeFile (root </> "anda/a/anda.hcl") "project pkg {}"+        createDirectoryLink ".." (root </> "anda/a/loop")+        dirs <- findPackageDirs root+        map (fmap pdPath) dirs `shouldBe` [Right "anda/a"]+        _ <- specFingerprint "m" ".fc44" root "anda/a"+        pure ()++  describe "parseCheckName" $ do+    it "accepts known checks" $ parseCheckName "build-lag" `shouldBe` Right "build-lag"+    it "rejects typos instead of silently running nothing" $+      parseCheckName "buildlag" `shouldSatisfy` either (const True) (const False)++  describe "failure handling" $ do+    it "turns a missing executable into a Left" $ do+      r <- run "oglyad-definitely-not-a-real-command" []+      r `shouldSatisfy` either (const True) (const False)+    it "turns an unreachable repo into a Left instead of throwing" $ do+      -- port 9 (discard) on loopback: refused immediately, no network needed+      r <- runApp (snapConfig snapshot) (fetchRepo "http://127.0.0.1:9/repo")+      r `shouldSatisfy` either (const True) (const False)++  describe "macroFingerprint" $+    it "changes when ~/.rpmmacros changes" $+      withSystemTempDirectory "oglyad-home" $ \home ->+        withEnv "HOME" home $ withEnv "XDG_CONFIG_HOME" (home </> ".config") $ do+          fpBefore <- macroFingerprint+          writeFile (home </> ".rpmmacros") "%dist .fc99\n"+          fpAfter <- macroFingerprint+          fpAfter `shouldNotBe` fpBefore++  describe "lastCommits" $+    it "reads commit times, including UTC ones git prints with a Z" $+      withSystemTempDirectory "oglyad-git" $ \repo -> do+        let git env args =+              runProcess_ . System.Process.Typed.setEnv (env <> [("GIT_CONFIG_GLOBAL", "/dev/null"), ("GIT_CONFIG_NOSYSTEM", "1")]) $+                proc "git" (["-C", repo, "-c", "user.name=t", "-c", "user.email=t@t", "-c", "commit.gpgsign=false"] <> args)+            commitAt date dir = do+              createDirectoryIfMissing True (repo </> dir)+              writeFile (repo </> dir </> "anda.hcl") date+              git [] ["add", "-A"]+              git [("GIT_COMMITTER_DATE", date), ("GIT_AUTHOR_DATE", date)] ["commit", "-q", "-m", dir]+        git [] ["init", "-q"]+        commitAt "2026-01-02T03:04:05Z" "anda/a"+        commitAt "2026-02-03T04:05:06+08:00" "anda/b"+        m <- lastCommits repo ["anda/a", "anda/b"]+        Map.lookup "anda/a" m `shouldBe` Just (UTCTime (fromGregorian 2026 1 2) (3 * 3600 + 4 * 60 + 5))+        Map.lookup "anda/b" m `shouldBe` Just (UTCTime (fromGregorian 2026 2 2) (20 * 3600 + 5 * 60 + 6))++  describe "stale check" $ do+    let built daysAgo = Just (RepoBuild (EVR 0 "1.2.0" "1.fc44") (addUTCTime (negate (daysAgo * nominalDay)) now))+    it "is quiet for recent builds" $+      Stale.check snapshot (pkg {pkgRepoBuild = built 10}) `shouldBe` []+    it "notes old builds" $+      severities (Stale.check snapshot (pkg {pkgRepoBuild = built 400})) `shouldBe` [Info]+    it "warns when old and upstream moved on" $+      severities (Stale.check snapshot (pkg {pkgRepoBuild = built 400, pkgUpstreamVer = Just "1.3.0"})) `shouldBe` [Warn]+  where+    nightly =+      "rpm.global(\"commit\", gh_commit(\"OpenTabletDriver/OpenTabletDriver\"));\n\+      \if rpm.changed() {\n\+      \    let v = gh(\"OpenTabletDriver/OpenTabletDriver\");\n\+      \    v.crop(1);\n\+      \    rpm.global(\"ver\", v);\n\+      \}\n"+    isLeft = either (const True) (const False)+    isUnknown = \case Unknown _ -> True; _ -> False++vercmpCase :: (Text, Text, Ordering) -> Spec+vercmpCase (a, b, o) =+  it (T.unpack a <> " vs " <> T.unpack b) $ do+    rpmvercmp a b `shouldBe` o+    rpmvercmp b a `shouldBe` flipOrd o++flipOrd :: Ordering -> Ordering+flipOrd = compare EQ++severities :: [Finding] -> [Severity]+severities = map fSeverity++-- * fixtures++now :: UTCTime+now = UTCTime (fromGregorian 2026 11 9) 0++posix :: Integer -> UTCTime+posix s = addUTCTime (fromIntegral s) (UTCTime (fromGregorian 1970 1 1) 0)++pkg :: Package+pkg =+  Package+    { pkgName = "zed",+      pkgPath = "anda/devs/zed/stable",+      pkgSubrepo = Nothing,+      pkgSpecEVR = Just (EVR 0 "1.2.0" "1.fc44"),+      pkgRepoBuild = Nothing,+      pkgLastCommit = Nothing,+      pkgUpstream = Just (GitHub "zed-industries/zed"),+      pkgUpstreamVer = Nothing,+      pkgUpstreamErr = Nothing,+      pkgRepoChecked = True+    }++snapshot :: Snapshot+snapshot =+  Snapshot+    { snapPackages = Map.singleton (pkgPath pkg) pkg,+      snapFedora = Set.empty,+      snapNow = now,+      snapConfig =+        Config+          { cfgMonorepo = ".",+            cfgTerraRepo = "",+            cfgFedoraRepos = [],+            cfgRelease = 44,+            cfgDist = ".fc44",+            cfgStaleAfter = 180 * nominalDay,+            cfgUpstream = False,+            cfgCacheFor = 0,+            cfgConcurrency = 1,+            cfgGitHubToken = Nothing+          },+      snapHead = Nothing,+      snapIgnoreLabels = Map.empty+    }++report :: [Finding] -> Report+report fs =+  Report+    { rVersion = "0",+      rGenerated = now,+      rMonorepoHead = Just "abc",+      rTerraRepo = "https://repos.fyralabs.com/terra44",+      rUpstream = False,+      rFindings = fs,+      rIgnored = []+    }++primaryFixture :: LBS8.ByteString+primaryFixture =+  "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n\+  \<metadata xmlns=\"http://linux.duke.edu/metadata/common\" xmlns:rpm=\"http://linux.duke.edu/metadata/rpm\" packages=\"2\">\n\+  \<package type=\"rpm\">\n\+  \  <name>zed</name>\n\+  \  <arch>x86_64</arch>\n\+  \  <version epoch=\"0\" ver=\"0.190.0\" rel=\"1.fc44\"/>\n\+  \  <summary>an editor &amp; more</summary>\n\+  \  <time file=\"1794200100\" build=\"1794200000\"/>\n\+  \  <format>\n\+  \    <rpm:license>GPL-3.0-or-later</rpm:license>\n\+  \    <rpm:sourcerpm>zed-0.190.0-1.fc44.src.rpm</rpm:sourcerpm>\n\+  \    <rpm:provides><rpm:entry name=\"zed\"/></rpm:provides>\n\+  \  </format>\n\+  \</package>\n\+  \<package type=\"rpm\">\n\+  \  <name>zed-cli</name>\n\+  \  <arch>x86_64</arch>\n\+  \  <version epoch=\"0\" ver=\"0.190.0\" rel=\"1.fc44\"/>\n\+  \  <time file=\"1794200100\" build=\"1794200001\"/>\n\+  \  <format><rpm:sourcerpm>zed-0.190.0-1.fc44.src.rpm</rpm:sourcerpm></format>\n\+  \</package>\n\+  \</metadata>\n"++-- | version-ish strings: digits, letters and the separators rpm cares about+newtype V = V Text deriving stock (Show)++instance Arbitrary V where+  arbitrary = V . T.pack <$> listOf (elements "0123456789abz.~^_")+  shrink (V t) = V . T.pack <$> shrink (T.unpack t)++-- | set an environment variable for the duration of an action+withEnv :: String -> String -> IO a -> IO a+withEnv key val act =+  bracket+    (lookupEnv key <* System.Environment.setEnv key val)+    (maybe (unsetEnv key) (System.Environment.setEnv key))+    (const act)