[bug#44427] [PATCH] lint: Add 'check-haskell-stackage' checker.

[Timothy Sample <samplet@ngyro.com>]

[-- Attachment #1: Type: text/plain, Size: 1008 bytes --]

Hello!

After the most recent issue with Haskell package versions, I was
inspired to finally make it a bit better.  This patch adds a lint
checker to make sure that a Haskell package’s version is not ahead of
the desired Stackage LTS version!  The check itself is nice and simple,
but I also added a test that is anything but.

To make the test work, I made sure our Hackage and Stackage importers
use base URLs that are parameters.  Then, I used ‘with-http-server’ and
‘parameterize’d the URLs to use the local server.  (This all follows the
example of the SWH checker.)  It might be clearer if the test were split
in two, but the Stackage importer memoizes the list of packages sent
from the Stackage server.  That means that the two tests would have to
be run in a certain order to work, which is pretty dodgy.

Is the test too complicated to be worth it?  I might be able to make it
a little clearer, but I’m not sure it’s worth including at all.
Thoughts?


-- Tim


[-- Attachment #2: 0001-lint-Add-check-haskell-stackage-checker.patch --]
[-- Type: text/x-patch, Size: 8759 bytes --]

From 7e01e8adddeaba7a2c0b3a79425da26f3c2584df Mon Sep 17 00:00:00 2001
From: Timothy Sample <samplet@ngyro.com>
Date: Tue, 3 Nov 2020 15:30:28 -0500
Subject: [PATCH] lint: Add 'check-haskell-stackage' checker.

* guix/lint.scm (check-haskell-stackage): New procedure.
(%network-dependent-checkers): Add 'haskell-stackage' checker.
* guix/import/hackage.scm (%hackage-url): New variable.
(hackage-source-url, hackage-cabal-url): Use it in place of a
hard-coded string.
* guix/import/stackage.scm (%stackage-url): Make it a parameter.
(stackage-lts-info-fetch): Update accordingly.
* tests/lint.scm ("hackage-stackage"): New test.
---
 guix/import/hackage.scm  | 14 +++++++++-----
 guix/import/stackage.scm |  8 +++++---
 guix/lint.scm            | 28 +++++++++++++++++++++++++++-
 tests/lint.scm           | 32 ++++++++++++++++++++++++++++++++
 4 files changed, 73 insertions(+), 9 deletions(-)

diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm
index 35c67cad8d..6ca4f65cb0 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -40,7 +40,8 @@
   #:use-module (guix upstream)
   #:use-module (guix packages)
   #:use-module ((guix utils) #:select (call-with-temporary-output-file))
-  #:export (hackage->guix-package
+  #:export (%hackage-url
+            hackage->guix-package
             hackage-recursive-import
             %hackage-updater
 
@@ -92,20 +93,23 @@
 
 (define package-name-prefix "ghc-")
 
+(define %hackage-url
+  (make-parameter "https://hackage.haskell.org"))
+
 (define (hackage-source-url name version)
   "Given a Hackage package NAME and VERSION, return a url to the source
 tarball."
-  (string-append "https://hackage.haskell.org/package/" name
-                 "/" name "-" version ".tar.gz"))
+  (string-append (%hackage-url) "/package/"
+                 name "/" name "-" version ".tar.gz"))
 
 (define* (hackage-cabal-url name #:optional version)
   "Given a Hackage package NAME and VERSION, return a url to the corresponding
 .cabal file on Hackage.  If VERSION is #f or missing, the url for the latest
 version is returned."
   (if version
-      (string-append "https://hackage.haskell.org/package/"
+      (string-append (%hackage-url) "/package/"
                      name "-" version "/" name ".cabal")
-      (string-append "https://hackage.haskell.org/package/"
+      (string-append (%hackage-url) "/package/"
                      name "/" name ".cabal")))
 
 (define (hackage-name->package-name name)
diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm
index 93cf214127..77cc6350cb 100644
--- a/guix/import/stackage.scm
+++ b/guix/import/stackage.scm
@@ -30,7 +30,8 @@
   #:use-module (guix memoization)
   #:use-module (guix packages)
   #:use-module (guix upstream)
-  #:export (stackage->guix-package
+  #:export (%stackage-url
+            stackage->guix-package
             stackage-recursive-import
             %stackage-updater))
 
@@ -39,7 +40,8 @@
 ;;; Stackage info fetcher and access functions
 ;;;
 
-(define %stackage-url "https://www.stackage.org")
+(define %stackage-url
+  (make-parameter "https://www.stackage.org"))
 
 ;; Latest LTS version compatible with GHC 8.6.5.
 (define %default-lts-version "14.27")
@@ -55,7 +57,7 @@
   ;; "Retrieve the information about the LTS Stackage release VERSION."
   (memoize
    (lambda* (#:optional (version ""))
-     (let* ((url (string-append %stackage-url
+     (let* ((url (string-append (%stackage-url)
                                 "/lts-" (if (string-null? version)
                                             %default-lts-version
                                             version)))
diff --git a/guix/lint.scm b/guix/lint.scm
index e1a77e8ac7..b552aa5d62 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -10,6 +10,7 @@
 ;;; Copyright © 2017, 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2020 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -50,6 +51,7 @@
   #:use-module ((guix swh) #:hide (origin?))
   #:autoload   (guix git-download) (git-reference?
                                     git-reference-url git-reference-commit)
+  #:use-module (guix import stackage)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 format)
@@ -87,6 +89,7 @@
             check-formatting
             check-archival
             check-profile-collisions
+            check-haskell-stackage
 
             lint-warning
             lint-warning?
@@ -1240,6 +1243,25 @@ Heritage")
               '()
               (apply throw key args))))))))
 
+(define (check-haskell-stackage package)
+  "Check whether PACKAGE is a Haskell package ahead of the current
+Stackage LTS version."
+  (match (with-networking-fail-safe
+          (format #f (G_ "while retrieving upstream info for '~a'")
+                  (package-name package))
+          #f
+          (package-latest-release package (list %stackage-updater)))
+    ((? upstream-source? source)
+     (if (version>? (package-version package)
+                    (upstream-source-version source))
+         (list
+          (make-warning package
+                        (G_ "ahead of Stackage LTS version ~a")
+                        (list (upstream-source-version source))
+                        #:field 'version))
+         '()))
+    (#f '())))
+
 \f
 ;;;
 ;;; Source code formatting.
@@ -1462,7 +1484,11 @@ or a list thereof")
    (lint-checker
      (name        'archival)
      (description "Ensure source code archival on Software Heritage")
-     (check       check-archival))))
+     (check       check-archival))
+   (lint-checker
+     (name        'haskell-stackage)
+     (description "Ensure Haskell packages use Stackage LTS versions")
+     (check       check-haskell-stackage))))
 
 (define %all-checkers
   (append %local-checkers
diff --git a/tests/lint.scm b/tests/lint.scm
index 95abd71378..10a4585c65 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -36,6 +37,8 @@
   #:use-module (guix lint)
   #:use-module (guix ui)
   #:use-module (guix swh)
+  #:use-module ((guix import hackage) #:select (%hackage-url))
+  #:use-module ((guix import stackage) #:select (%stackage-url))
   #:use-module (gnu packages)
   #:use-module (gnu packages glib)
   #:use-module (gnu packages pkg-config)
@@ -1001,6 +1004,35 @@
     (string-contains (single-lint-warning-message warnings)
                      "rate limit reached")))
 
+(test-skip (if (http-server-can-listen?) 0 1))
+(test-assert "haskell-stackage"
+  (let* ((stackage (string-append "{ \"packages\": [{"
+                                  "    \"name\":\"x\","
+                                  "    \"version\":\"1.0\" }]}"))
+         (packages (map (lambda (version)
+                          (dummy-package
+                           (string-append "ghc-x")
+                           (version version)
+                           (source
+                            (dummy-origin
+                             (method url-fetch)
+                             (uri (string-append
+                                   "https://hackage.haskell.org/package/"
+                                   "x-" version "/x-" version ".tar.gz"))))))
+                        '("0.9" "1.0" "2.0")))
+         (warnings (pk (with-http-server `((200 ,stackage) ; memoized
+                                           (200 "name: x\nversion: 1.0\n")
+                                           (200 "name: x\nversion: 1.0\n")
+                                           (200 "name: x\nversion: 1.0\n"))
+                         (parameterize ((%hackage-url (%local-url))
+                                        (%stackage-url (%local-url)))
+                           (append-map check-haskell-stackage packages))))))
+    (match warnings
+      (((? lint-warning? warning))
+       (and (string=? (package-version (lint-warning-package warning)) "2.0")
+            (string-contains (lint-warning-message warning)
+                             "ahead of Stackage LTS version"))))))
+
 (test-end "lint")
 
 ;; Local Variables:
-- 
2.29.2