`guix lint' warn of GitHub autogenerated source tarballs

`guix lint' warn of GitHub autogenerated source tarballs

[Arun Isaac]

Now that we are avoiding GitHub autogenerated source tarballs since they
are unstable and cause hash mismatch errors, can we have `guix lint'
emit a warning if these autogenerated source tarballs are used?

Re: `guix lint' warn of GitHub autogenerated source tarballs

[Pierre Neidhardt]

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

+1! :)

-- 
Pierre Neidhardt
https://ambrevar.xyz/

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

Re: `guix lint' warn of GitHub autogenerated source tarballs

[Ludovic Courtès]

Hi!

Arun Isaac <arunisaac@systemreboot.net> skribis:

> Now that we are avoiding GitHub autogenerated source tarballs since they
> are unstable and cause hash mismatch errors, can we have `guix lint'
> emit a warning if these autogenerated source tarballs are used?

I think Efraim had submitted a patch that does this but I can no longer
find it.  Efraim?

Thanks,
Ludo’.

Re: `guix lint' warn of GitHub autogenerated source tarballs

[Efraim Flashner]

On December 19, 2018 2:07:55 PM UTC, "Ludovic Courtès" <ludo@gnu.org> wrote:
>Hi!
>
>Arun Isaac <arunisaac@systemreboot.net> skribis:
>
>> Now that we are avoiding GitHub autogenerated source tarballs since
>they
>> are unstable and cause hash mismatch errors, can we have `guix lint'
>> emit a warning if these autogenerated source tarballs are used?
>
>I think Efraim had submitted a patch that does this but I can no longer
>find it.  Efraim?
>
>Thanks,
>Ludo’.

I think I just posted a paste on IRC but haven't sent a patch yet. I'll grab it and submit it, it's almost done, just needs some cleaning up and tightening the test cases.
-- 
Sent from my Android device with K-9 Mail. Please excuse my brevity.

Re: `guix lint' warn of GitHub autogenerated source tarballs

[Arun Isaac]

>>> Now that we are avoiding GitHub autogenerated source tarballs since
>>they
>>> are unstable and cause hash mismatch errors, can we have `guix lint'
>>> emit a warning if these autogenerated source tarballs are used?
>>
> I think I just posted a paste on IRC but haven't sent a patch
> yet. I'll grab it and submit it, it's almost done, just needs some
> cleaning up and tightening the test cases.

Great, thank you!

Re: `guix lint' warn of GitHub autogenerated source tarballs

[Efraim Flashner]

[-- Attachment #1.1: Type: text/plain, Size: 1081 bytes --]

On Wed, Dec 19, 2018 at 11:13:56PM +0530, Arun Isaac wrote:
> 
> >>> Now that we are avoiding GitHub autogenerated source tarballs since
> >>they
> >>> are unstable and cause hash mismatch errors, can we have `guix lint'
> >>> emit a warning if these autogenerated source tarballs are used?
> >>
> > I think I just posted a paste on IRC but haven't sent a patch
> > yet. I'll grab it and submit it, it's almost done, just needs some
> > cleaning up and tightening the test cases.
> 
> Great, thank you!
> 

Here's what I currently have. I don't think I've tried running the tests
I've written yet, and Ludo said there was a better way to check if the
download was a git-fetch or a url-fetch. As the logic is currently
written it'll flag any package hosted on github owned by 'archive' or
any package named 'archive' in addition to the ones we want.

-- 
Efraim Flashner   <efraim@flashner.co.il>   אפרים פלשנר
GPG key = A28B F40C 3E55 1372 662D  14F7 41AA E7DC CA3D 8351
Confidentiality cannot be guaranteed on emails sent or received unencrypted

[-- Attachment #1.2: 0001-lint-Add-checker-for-unstable-tarballs.patch --]
[-- Type: text/plain, Size: 5763 bytes --]

From 8a07c8aea1f23db48a9e69956ad15f79f0f70e35 Mon Sep 17 00:00:00 2001
From: Efraim Flashner <efraim@flashner.co.il>
Date: Tue, 23 Oct 2018 12:01:53 +0300
Subject: [PATCH] lint: Add checker for unstable tarballs.

* guix/scripts/lint.scm (check-source-unstable-tarball): New procedure.
(%checkers): Add it.
* tests/lint.scm ("source-unstable-tarball", source-unstable-tarball:
source #f", "source-unstable-tarball: valid", source-unstable-tarball:
not-github", source-unstable-tarball: git-fetch"): New tests.
---
 guix/scripts/lint.scm | 23 ++++++++++++++-
 tests/lint.scm        | 68 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 90 insertions(+), 1 deletion(-)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index e477bf0dd..cce7af66c 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -7,7 +7,7 @@
 ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
-;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -747,6 +747,23 @@ descriptions maintained upstream."
                     (G_ "the source file name should contain the package name")
                     'source))))
 
+(define (check-source-unstable-tarball package)
+  "Emit a warning if PACKAGE's source is an autogenerated tarball."
+  (define (github-tarball? origin)
+    (string-contains origin "github.com"))
+  (define (autogenerated-tarball? origin)
+    (string-contains origin "/archive/"))
+  (let ((origin (package-source package)))
+    (unless (not origin) ; check for '(source #f)'
+      (let ((uri       (origin-uri origin))
+            (dl-method (origin-method origin)))
+        (unless (not (pk dl-method "url-fetch"))
+        (when (and (github-tarball? uri)
+                   (autogenerated-tarball? uri))
+          (emit-warning package
+                        (G_ "the source URI should not be an autogenerated tarball")
+                        'source)))))))
+
 (define (check-mirror-url package)
   "Check whether PACKAGE uses source URLs that should be 'mirror://'."
   (define (check-mirror-uri uri)                  ;XXX: could be optimized
@@ -1051,6 +1068,10 @@ or a list thereof")
      (name        'source-file-name)
      (description "Validate file names of sources")
      (check       check-source-file-name))
+   (lint-checker
+     (name        'source-unstable-tarball)
+     (description "Check for autogenerated tarballs")
+     (check       check-source-unstable-tarball))
    (lint-checker
      (name        'derivation)
      (description "Report failure to compile a package to a derivation")
diff --git a/tests/lint.scm b/tests/lint.scm
index ab0e8b9a8..723a35107 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -571,6 +571,74 @@
          (check-source-file-name pkg)))
      "file name should contain the package name"))))
 
+(test-assert "source-unstable-tarball"
+  (not
+    (->bool
+     (string-contains
+      (with-warnings
+        (let ((pkg (dummy-package "x"
+                     (source
+                       (origin
+                         (method url-fetch)
+                         (uri "https://github.com/example/example/archive/v0.0.tar.gz")
+                         (sha256 %null-sha256))))))
+          (check-source-unstable-tarball pkg)))
+      "source URI should not be an autogenerated tarball"))))
+
+(test-assert "source-unstable-tarball: source #f"
+  (not
+    (->bool
+     (string-contains
+      (with-warnings
+        (let ((pkg (dummy-package "x"
+                     (source #f))))
+          (check-source-unstable-tarball pkg)))
+      "source URI should not be an autogenerated tarball"))))
+
+(test-assert "source-unstable-tarball: valid"
+  (not
+    (->bool
+     (string-contains
+      (with-warnings
+        (let ((pkg (dummy-package "x"
+                     (source
+                       (origin
+                         (method url-fetch)
+                         (uri "https://github.com/example/example/releases/download/x-0.0/x-0.0.tar.gz")
+                         (sha256 %null-sha256))))))
+          (check-source-unstable-tarball pkg)))
+      "source URI should not be an autogenerated tarball"))))
+
+(test-assert "source-unstable-tarball: not-github"
+  (not
+    (->bool
+     (string-contains
+      (with-warnings
+        (let ((pkg (dummy-package "x"
+                     (source
+                       (origin
+                         (method url-fetch)
+                         (uri "https://bitbucket.org/archive/example/download/x-0.0.tar.gz")
+                         (sha256 %null-sha256))))))
+          (check-source-unstable-tarball pkg)))
+      "source URI should not be an autogenerated tarball"))))
+
+(test-assert "source-unstable-tarball: git-fetch"
+  (not
+    (->bool
+     (string-contains
+      (with-warnings
+        (let ((pkg (dummy-package "x"
+                     (source
+                       (origin
+                         (method git-fetch)
+                         (uri (git-reference
+                                (url "https://github.com/archive/example.git")
+                                (commit "0")))
+                         (sha256 %null-sha256))))))
+          (check-source-unstable-tarball pkg)))
+      "source URI should not be an autogenerated tarball"))))
+
 (test-skip (if (http-server-can-listen?) 0 1))
 (test-equal "source: 200"
   ""
-- 
2.19.1


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]

Re: `guix lint' warn of GitHub autogenerated source tarballs

[Ludovic Courtès]

Hi!

Efraim Flashner <efraim@flashner.co.il> skribis:

> Here's what I currently have. I don't think I've tried running the tests
> I've written yet, and Ludo said there was a better way to check if the
> download was a git-fetch or a url-fetch. As the logic is currently
> written it'll flag any package hosted on github owned by 'archive' or
> any package named 'archive' in addition to the ones we want.

OK.  I think you’re pretty much there anyway, so please don’t drop the
ball.  ;-)

Some comments follow:

> From 8a07c8aea1f23db48a9e69956ad15f79f0f70e35 Mon Sep 17 00:00:00 2001
> From: Efraim Flashner <efraim@flashner.co.il>
> Date: Tue, 23 Oct 2018 12:01:53 +0300
> Subject: [PATCH] lint: Add checker for unstable tarballs.
>
> * guix/scripts/lint.scm (check-source-unstable-tarball): New procedure.
> (%checkers): Add it.
> * tests/lint.scm ("source-unstable-tarball", source-unstable-tarball:
> source #f", "source-unstable-tarball: valid", source-unstable-tarball:
> not-github", source-unstable-tarball: git-fetch"): New tests.

[...]

> +(define (check-source-unstable-tarball package)
> +  "Emit a warning if PACKAGE's source is an autogenerated tarball."
> +  (define (github-tarball? origin)
> +    (string-contains origin "github.com"))
> +  (define (autogenerated-tarball? origin)
> +    (string-contains origin "/archive/"))
> +  (let ((origin (package-source package)))
> +    (unless (not origin) ; check for '(source #f)'
> +      (let ((uri       (origin-uri origin))
> +            (dl-method (origin-method origin)))
> +        (unless (not (pk dl-method "url-fetch"))
> +        (when (and (github-tarball? uri)
> +                   (autogenerated-tarball? uri))
> +          (emit-warning package
> +                        (G_ "the source URI should not be an autogenerated tarball")
> +                        'source)))))))

You should use ‘origin-uris’ (plural), which always returns a list of
URIs, and iterate on them (see ‘check-mirror-url’ as an example.)

Also, when you have a URI, you can obtain just the host part and decode
the path part like this:

--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> (string->uri "https://github.com/foo/bar/archive/whatnot")
$2 = #<<uri> scheme: https userinfo: #f host: "github.com" port: #f path: "/foo/bar/archive/whatnot" query: #f fragment: #f>
scheme@(guile-user)> (uri-host $2)
$3 = "github.com"
scheme@(guile-user)> (split-and-decode-uri-path (uri-path $2))
$4 = ("foo" "bar" "archive" "whatnot")
--8<---------------cut here---------------end--------------->8---

That way you should be able to get more accurate matching than with
‘string-contains’.  Does that make sense?

The tests look good… but could you make sure they pass?  :-)

Thank you!

Ludo’.

Re: `guix lint' warn of GitHub autogenerated source tarballs

[swedebugia]

On 2018-12-21 21:50, Ludovic Courtès wrote:
> Hi!
> 
> Efraim Flashner <efraim@flashner.co.il> skribis:
> 
>> Here's what I currently have. I don't think I've tried running the tests
>> I've written yet, and Ludo said there was a better way to check if the
>> download was a git-fetch or a url-fetch. As the logic is currently
>> written it'll flag any package hosted on github owned by 'archive' or
>> any package named 'archive' in addition to the ones we want.
> 
> OK.  I think you’re pretty much there anyway, so please don’t drop the
> ball.  ;-)
> 
> Some comments follow:
> 
>> From 8a07c8aea1f23db48a9e69956ad15f79f0f70e35 Mon Sep 17 00:00:00 2001
>> From: Efraim Flashner <efraim@flashner.co.il>
>> Date: Tue, 23 Oct 2018 12:01:53 +0300
>> Subject: [PATCH] lint: Add checker for unstable tarballs.
>>
>> * guix/scripts/lint.scm (check-source-unstable-tarball): New procedure.
>> (%checkers): Add it.
>> * tests/lint.scm ("source-unstable-tarball", source-unstable-tarball:
>> source #f", "source-unstable-tarball: valid", source-unstable-tarball:
>> not-github", source-unstable-tarball: git-fetch"): New tests.
> 
> [...]
> 
>> +(define (check-source-unstable-tarball package)
>> +  "Emit a warning if PACKAGE's source is an autogenerated tarball."
>> +  (define (github-tarball? origin)
>> +    (string-contains origin "github.com"))
>> +  (define (autogenerated-tarball? origin)
>> +    (string-contains origin "/archive/"))
>> +  (let ((origin (package-source package)))
>> +    (unless (not origin) ; check for '(source #f)'
>> +      (let ((uri       (origin-uri origin))
>> +            (dl-method (origin-method origin)))
>> +        (unless (not (pk dl-method "url-fetch"))
>> +        (when (and (github-tarball? uri)
>> +                   (autogenerated-tarball? uri))
>> +          (emit-warning package
>> +                        (G_ "the source URI should not be an autogenerated tarball")
>> +                        'source)))))))
> 
> You should use ‘origin-uris’ (plural), which always returns a list of
> URIs, and iterate on them (see ‘check-mirror-url’ as an example.)
> 
> Also, when you have a URI, you can obtain just the host part and decode
> the path part like this:
> 
> --8<---------------cut here---------------start------------->8---
> scheme@(guile-user)> (string->uri "https://github.com/foo/bar/archive/whatnot")
> $2 = #<<uri> scheme: https userinfo: #f host: "github.com" port: #f
> path: "/foo/bar/archive/whatnot" query: #f fragment: #f>
> scheme@(guile-user)> (uri-host $2)
> $3 = "github.com"
> scheme@(guile-user)> (split-and-decode-uri-path (uri-path $2))
> $4 = ("foo" "bar" "archive" "whatnot")
> --8<---------------cut here---------------end--------------->8---
> 
> That way you should be able to get more accurate matching than with
> ‘string-contains’.  Does that make sense?

This is super nice! I did not know this. It makes URL parsing much
easier :D

-- 
Cheers 
Swedebugia

Re: `guix lint' warn of GitHub autogenerated source tarballs

[Efraim Flashner]

[-- Attachment #1.1: Type: text/plain, Size: 3505 bytes --]

On Fri, Dec 21, 2018 at 09:50:51PM +0100, Ludovic Courtès wrote:
> Hi!
> 
> Efraim Flashner <efraim@flashner.co.il> skribis:
> 
> > Here's what I currently have. I don't think I've tried running the tests
> > I've written yet, and Ludo said there was a better way to check if the
> > download was a git-fetch or a url-fetch. As the logic is currently
> > written it'll flag any package hosted on github owned by 'archive' or
> > any package named 'archive' in addition to the ones we want.
> 
> OK.  I think you’re pretty much there anyway, so please don’t drop the
> ball.  ;-)
> 
> Some comments follow:
> 
> > From 8a07c8aea1f23db48a9e69956ad15f79f0f70e35 Mon Sep 17 00:00:00 2001
> > From: Efraim Flashner <efraim@flashner.co.il>
> > Date: Tue, 23 Oct 2018 12:01:53 +0300
> > Subject: [PATCH] lint: Add checker for unstable tarballs.
> >
> > * guix/scripts/lint.scm (check-source-unstable-tarball): New procedure.
> > (%checkers): Add it.
> > * tests/lint.scm ("source-unstable-tarball", source-unstable-tarball:
> > source #f", "source-unstable-tarball: valid", source-unstable-tarball:
> > not-github", source-unstable-tarball: git-fetch"): New tests.
> 
> [...]
> 
> > +(define (check-source-unstable-tarball package)
> > +  "Emit a warning if PACKAGE's source is an autogenerated tarball."
> > +  (define (github-tarball? origin)
> > +    (string-contains origin "github.com"))
> > +  (define (autogenerated-tarball? origin)
> > +    (string-contains origin "/archive/"))
> > +  (let ((origin (package-source package)))
> > +    (unless (not origin) ; check for '(source #f)'
> > +      (let ((uri       (origin-uri origin))
> > +            (dl-method (origin-method origin)))
> > +        (unless (not (pk dl-method "url-fetch"))
> > +        (when (and (github-tarball? uri)
> > +                   (autogenerated-tarball? uri))
> > +          (emit-warning package
> > +                        (G_ "the source URI should not be an autogenerated tarball")
> > +                        'source)))))))
> 
> You should use ‘origin-uris’ (plural), which always returns a list of
> URIs, and iterate on them (see ‘check-mirror-url’ as an example.)

That works really well

> 
> Also, when you have a URI, you can obtain just the host part and decode
> the path part like this:
> 
> --8<---------------cut here---------------start------------->8---
> scheme@(guile-user)> (string->uri "https://github.com/foo/bar/archive/whatnot")
> $2 = #<<uri> scheme: https userinfo: #f host: "github.com" port: #f path: "/foo/bar/archive/whatnot" query: #f fragment: #f>
> scheme@(guile-user)> (uri-host $2)
> $3 = "github.com"
> scheme@(guile-user)> (split-and-decode-uri-path (uri-path $2))
> $4 = ("foo" "bar" "archive" "whatnot")
> --8<---------------cut here---------------end--------------->8---
> 
> That way you should be able to get more accurate matching than with
> ‘string-contains’.  Does that make sense?

'third' from srfi-1 also helped a lot, considering how the github uris
are formatted.

> 
> The tests look good… but could you make sure they pass?  :-)

pfft, little things :) (forgot to export check-source-unstable-tarball)

> 
> Thank you!
> 
> Ludo’.

Next version attached

-- 
Efraim Flashner   <efraim@flashner.co.il>   אפרים פלשנר
GPG key = A28B F40C 3E55 1372 662D  14F7 41AA E7DC CA3D 8351
Confidentiality cannot be guaranteed on emails sent or received unencrypted

[-- Attachment #1.2: 0001-lint-Add-checker-for-unstable-tarballs.patch --]
[-- Type: text/plain, Size: 6599 bytes --]

From dcd8b207f932289cb3b35720af45f49f849b7c27 Mon Sep 17 00:00:00 2001
From: Efraim Flashner <efraim@flashner.co.il>
Date: Tue, 25 Dec 2018 16:29:12 +0200
Subject: [PATCH] lint: Add checker for unstable tarballs.

* guix/scripts/lint.scm (check-source-unstable-tarball): New procedure.
(%checkers): Add it.
* tests/lint.scm ("source-unstable-tarball", "source-unstable-tarball:
source #f", "source-unstable-tarball: valid", "source-unstable-tarball:
package named archive", "source-unstable-tarball: not-github",
"source-unstable-tarball: git-fetch"): New tests.
---
 guix/scripts/lint.scm | 23 ++++++++++++-
 tests/lint.scm        | 80 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 102 insertions(+), 1 deletion(-)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 354f6f703..2c1c7ec66 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -7,7 +7,7 @@
 ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
-;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -76,6 +76,7 @@
             check-home-page
             check-source
             check-source-file-name
+            check-source-unstable-tarball
             check-mirror-url
             check-github-url
             check-license
@@ -752,6 +753,22 @@ descriptions maintained upstream."
                     (G_ "the source file name should contain the package name")
                     'source))))
 
+(define (check-source-unstable-tarball package)
+  "Emit a warning if PACKAGE's source is an autogenerated tarball."
+  (define (check-source-uri uri)
+    (when (and (string=? (uri-host (string->uri uri)) "github.com")
+               (string=? (third (split-and-decode-uri-path
+                                   (uri-path (string->uri uri))))
+                     "archive"))
+      (emit-warning package
+                    (G_ "the source URI should not be an autogenerated tarball")
+                    'source)))
+  (let ((origin (package-source package)))
+    (when (and (origin? origin)
+               (eqv? (origin-method origin) url-fetch))
+      (let ((uris (origin-uris origin)))
+        (for-each check-source-uri uris)))))
+
 (define (check-mirror-url package)
   "Check whether PACKAGE uses source URLs that should be 'mirror://'."
   (define (check-mirror-uri uri)                  ;XXX: could be optimized
@@ -1098,6 +1115,10 @@ or a list thereof")
      (name        'source-file-name)
      (description "Validate file names of sources")
      (check       check-source-file-name))
+   (lint-checker
+     (name        'source-unstable-tarball)
+     (description "Check for autogenerated tarballs")
+     (check       check-source-unstable-tarball))
    (lint-checker
      (name        'derivation)
      (description "Report failure to compile a package to a derivation")
diff --git a/tests/lint.scm b/tests/lint.scm
index d4aa7c0e8..fe12bebd8 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -572,6 +572,86 @@
          (check-source-file-name pkg)))
      "file name should contain the package name"))))
 
+(test-assert "source-unstable-tarball"
+  (string-contains
+   (with-warnings
+     (let ((pkg (dummy-package "x"
+                  (source
+                    (origin
+                      (method url-fetch)
+                      (uri "https://github.com/example/example/archive/v0.0.tar.gz")
+                      (sha256 %null-sha256))))))
+       (check-source-unstable-tarball pkg)))
+   "source URI should not be an autogenerated tarball"))
+
+(test-assert "source-unstable-tarball: source #f"
+  (not
+    (->bool
+     (string-contains
+      (with-warnings
+        (let ((pkg (dummy-package "x"
+                     (source #f))))
+          (check-source-unstable-tarball pkg)))
+      "source URI should not be an autogenerated tarball"))))
+
+(test-assert "source-unstable-tarball: valid"
+  (not
+    (->bool
+     (string-contains
+      (with-warnings
+        (let ((pkg (dummy-package "x"
+                     (source
+                       (origin
+                         (method url-fetch)
+                         (uri "https://github.com/example/example/releases/download/x-0.0/x-0.0.tar.gz")
+                         (sha256 %null-sha256))))))
+          (check-source-unstable-tarball pkg)))
+      "source URI should not be an autogenerated tarball"))))
+
+(test-assert "source-unstable-tarball: package named archive"
+  (not
+    (->bool
+     (string-contains
+      (with-warnings
+        (let ((pkg (dummy-package "x"
+                     (source
+                       (origin
+                         (method url-fetch)
+                         (uri "https://github.com/example/archive/releases/download/x-0.0/x-0.0.tar.gz")
+                         (sha256 %null-sha256))))))
+          (check-source-unstable-tarball pkg)))
+      "source URI should not be an autogenerated tarball"))))
+
+(test-assert "source-unstable-tarball: not-github"
+  (not
+    (->bool
+     (string-contains
+      (with-warnings
+        (let ((pkg (dummy-package "x"
+                     (source
+                       (origin
+                         (method url-fetch)
+                         (uri "https://bitbucket.org/archive/example/download/x-0.0.tar.gz")
+                         (sha256 %null-sha256))))))
+          (check-source-unstable-tarball pkg)))
+      "source URI should not be an autogenerated tarball"))))
+
+(test-assert "source-unstable-tarball: git-fetch"
+  (not
+    (->bool
+     (string-contains
+      (with-warnings
+        (let ((pkg (dummy-package "x"
+                     (source
+                       (origin
+                         (method git-fetch)
+                         (uri (git-reference
+                                (url "https://github.com/archive/example.git")
+                                (commit "0")))
+                         (sha256 %null-sha256))))))
+          (check-source-unstable-tarball pkg)))
+      "source URI should not be an autogenerated tarball"))))
+
 (test-skip (if (http-server-can-listen?) 0 1))
 (test-equal "source: 200"
   ""
-- 
2.20.1


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]

Re: `guix lint' warn of GitHub autogenerated source tarballs

[Ludovic Courtès]

Hello!

Efraim Flashner <efraim@flashner.co.il> skribis:

> From dcd8b207f932289cb3b35720af45f49f849b7c27 Mon Sep 17 00:00:00 2001
> From: Efraim Flashner <efraim@flashner.co.il>
> Date: Tue, 25 Dec 2018 16:29:12 +0200
> Subject: [PATCH] lint: Add checker for unstable tarballs.
>
> * guix/scripts/lint.scm (check-source-unstable-tarball): New procedure.
> (%checkers): Add it.
> * tests/lint.scm ("source-unstable-tarball", "source-unstable-tarball:
> source #f", "source-unstable-tarball: valid", "source-unstable-tarball:
> package named archive", "source-unstable-tarball: not-github",
> "source-unstable-tarball: git-fetch"): New tests.

One last thing:

> +(define (check-source-unstable-tarball package)
> +  "Emit a warning if PACKAGE's source is an autogenerated tarball."
> +  (define (check-source-uri uri)
> +    (when (and (string=? (uri-host (string->uri uri)) "github.com")
> +               (string=? (third (split-and-decode-uri-path
> +                                   (uri-path (string->uri uri))))
> +                     "archive"))

‘third’ could fail badly if the list has fewer elements, so I’d suggest
writing it something like:

  (when (and …
             (match (split-and-decode-uri-path …)
               ((_ _ "archive" _ ...) #t)
               (_ #f)))
     …)

Otherwise LGTM, thank you!

Ludo’.

Learning the match-syntax...

[swedebugia]

Saluton Ludo' :)

I write this to you for no other reason than I like the code your write
and would love to learn more.

If you don't have time/energy just let me know and I will ask Pierre or
somebody else. :)

On 2019-01-05 18:39, Ludovic Courtès wrote:
> One last thing:
> 
>> +(define (check-source-unstable-tarball package)
>> +  "Emit a warning if PACKAGE's source is an autogenerated tarball."
>> +  (define (check-source-uri uri)
>> +    (when (and (string=? (uri-host (string->uri uri)) "github.com")
>> +               (string=? (third (split-and-decode-uri-path
>> +                                   (uri-path (string->uri uri))))
>> +                     "archive"))
> 
> ‘third’ could fail badly if the list has fewer elements, so I’d suggest
> writing it something like:
> 
>   (when (and …
>              (match (split-and-decode-uri-path …)
>                ((_ _ "archive" _ ...) #t)
>                (_ #f)))
>      …)

This is an elegant rewrite to return a boolean #f in case the URL is bad
in some way.

I'm trying very hard to learn the guile match-syntax.

To make sure I understand the above I would like to explain it and you
can verify that I got it right. Ok?

>              (match (split-and-decode-uri-path …) <- this is the input
>                ((_ _ "archive" _ ...) #t)
                   ^ ^ ^ =third  ^       ^return true if the clause
match
                                 ^fourth & more
                   ^ ^ = anything twice 
>                (_ #f)))
                  ^ =the general case =else return #f.

Correct?

This is a more complicated (nested) match example from Juliens opam
importer which I find is an elegant functional way to find what we need:

(define (metadata-ref file lookup)
  (fold (lambda (record acc)
          (match record
            ((record key val)
             (if (equal? key lookup)
	       (match val
                 (('list-pat . stuff) stuff)
                 (('string-pat stuff) stuff)
                 (('multiline-string stuff) stuff)
                 (('dict records ...) records))
	       acc))))
        #f file))

(define (metadata-ref file lookup)
                      ^ 2 arguments
  (fold (lambda (record acc)
                  ^2 formals, why the acc?
          (match record
                 ^input
            ((record key val)
               ^match "record" "key" "val" in a list?
             (if (equal? key lookup)
                          ^ we continue if the key is right
	       (match val
                       ^input
                 (('list-pat . stuff) stuff)
                     ^ if 'list-pat return stuff
                 (('string-pat stuff) stuff)
                     ^ if 'string-pat return stuff
                 (('multiline-string stuff) stuff)
                 (('dict records ...) records))
                    ^if 'dict return first record
	       acc))))
                ^ this is the else (what is this good for?)
        #f file))
             ^ input to fold
         ^ no initial in the fold

If I understood this correctly I hope I will be able to get something
like this to work in the quicklisp importer :)

-- 
Cheers 
Swedebugia

Re: Learning the match-syntax...

[Ricardo Wurmus]

Hi swedebugia,

> (define (metadata-ref file lookup)
>                       ^ 2 arguments
>   (fold (lambda (record acc)
>                   ^2 formals, why the acc?

“fold” is a higher order function that takes a two-argument procedure
(the lambda here), an initial value, and a list to fold over.

The procedure that is provided as the first argument is applied to each
element of the list *and* is given the current value of the
so-called accumulator (here bound to “acc”).

The accumulator first gets the initial value; in this case that’s #F.
The return value of the procedure is the new value of the accumulator.
The body is essentially just an “if” expression: the new value of the
accumulator is either whatever the “match” expression returns or it is
the unchanged value “acc”.

But nothing of this has anything to do with “match”.  Let’s look at the
match expressions.

>           (match record
>                  ^input
>             ((record key val)
>                ^match "record" "key" "val" in a list?

This is really destructuring the value of “record”, assuming that it is
a three element list, and binding each of the elements to a variable.
Try this:

--8<---------------cut here---------------start------------->8---
(use-modules (ice-9 match))
(match '(hello world how are you ?)
  ((greeting object . question)
   (length question)))
--8<---------------cut here---------------end--------------->8---

This will match the quoted expression against a pattern that binds a
list with at least two values to the variables “greeting”, “object”, and
“question” (for everything after the first two values).

> 	       (match val
>                        ^input
>                  (('list-pat . stuff) stuff)
>                      ^ if 'list-pat return stuff

If (eq? (car val) 'list-pat) then return (cdr val), even if that might
be the empty list.

>                  (('string-pat stuff) stuff)
>                      ^ if 'string-pat return stuff

This matches if “val” is a two element list where the car is
'string-pat.  It returns the cadr of “val” (cadr = car of the cdr).

>                  (('multiline-string stuff) stuff)

Similar here.

>                  (('dict records ...) records))
>                     ^if 'dict return first record

Close.  It returns all the values following 'dict.  This is the same as
if the pattern ('dict . records) had been used.

Hope this helps!

--
Ricardo

Re: Learning the match-syntax...

[Chris Marusich]

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

swedebugia@riseup.net writes:

> I'm trying very hard to learn the guile match-syntax.

When I first learned about "match", I found the Guile documentation to
be insufficient.  It is good as a reference, though.

I recommend looking beyond the Guile reference manual for a tutorial.
Check the Guile source for "match" related things.  Also, look at
introductions to "match" from other Schemes, such as Racket.  I think
you will understand it better by doing that.

-- 
Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

Re: Learning the match-syntax...

[swedebugia]

Hej :)

On 2019-01-06 22:36, Chris Marusich wrote:
> swedebugia@riseup.net writes:
> 
>> I'm trying very hard to learn the guile match-syntax.
> 
> When I first learned about "match", I found the Guile documentation to
> be insufficient.  It is good as a reference, though.
> 
> I recommend looking beyond the Guile reference manual for a tutorial.
> Check the Guile source for "match" related things. 

Good idea.

> Also, look at
> introductions to "match" from other Schemes, such as Racket.  I think
> you will understand it better by doing that.
> 

Thanks I already did that actually. The Racket guide was way better but 
not enough. Now I finally crossed the threshold to partially 
understanding it.

e.g.
(match '(1 2 "y" "x")
   (1
    'one)
   (number
    'number))

Will match any number for the first clause and any string for the 
second. It ONLY checks if it is a number.

To actually match something e.g. the "x" literally we need to nest the 
match like this:

(match '(1 2 y x)
   (string
    (match string
	("x"
           'x!)))
   (number
    'number))

Positional arguments work like this:

(match '(1 2 y x)
   ;match the third item
   (_ _ string
    ;check if it is the literal "x"
    (match string
	("x"
           'x!)))
   (number
    'number))

Correct?

-- 
Cheers Swedebugia

Re: Learning the match-syntax...

[Ricardo Wurmus]

Hej swedebugia,

> e.g.
> (match '(1 2 "y" "x")
>   (1
>    'one)
>   (number
>    'number))
>
> Will match any number for the first clause and any string for the
> second. It ONLY checks if it is a number.

This is not correct.  The first clause does not match because the number
1 is not equal to the list '(1 2 "y" "x").  So we fall through to the
next pattern.  That pattern is just the variable name “number”, which
will match absolutely anything.  “number” will be bound to '(1 2 "y"
"x") and the return value of the clause is the symbol 'number.

> To actually match something e.g. the "x" literally we need to nest the
> match like this:
>
> (match '(1 2 y x)
>   (string
>    (match string
> 	("x"
>           'x!)))
>   (number
>    'number))

No.  Here the first pattern matches absolutely anything.  The name
“string” could be anything at all.  It’s just the name of a variable
that should be bound.  So here you first bind '(1 2 y x) to the variable
“string”, and then you try match the value of that very same variable to
the string "x", which fails.  Hence we fall through to the next clause,
where the pattern is just the variable “number”, which will bind to
absolutely anything.  So that’s what happens and the symbol 'number is
returned.

> Positional arguments work like this:
>
> (match '(1 2 y x)
>   ;match the third item
>   (_ _ string
>    ;check if it is the literal "x"
>    (match string
> 	("x"
>           'x!)))
>   (number
>    'number))
>
> Correct?

No.  If you run this in the REPL you’ll see an error.  You have
misunderstood how match works.  Here’s another example:

(match '(1 2 x y)
  ((one two three four)
   (format #f
           "the first value is ~a, the second is ~a, the third is ~a and the fourth is ~a\n"
           one two three four))
  ((this will never match)
   #f))

Here we have two clauses: the first clause has the pattern

   (one two three four)

i.e. a list of four variables.  This matches the value exactly.  Each
variable is bound to one of the values of the list.

The second clause has also four variables and would match just as well,
but it will not be considered as the first pattern has already matched.

Does this make things clearer?


To match by *type* (as you tried above) you need to use predicates.
Here’s an example:

(match '(1 2 x y)
  (((? string? one) two three four)
   'will-not-match)
  ((this (? number? will) totally match)
   will))

The first pattern would only match if the first value were a string
(which would be bound to the variable “one”).  But it is not, so the
next pattern is tried.  There we want to match against four variables of
which the second needs to be a number.  This matches, so “will” is bound
to the number 2, which is what we return.

--
Ricardo

Re: Learning the match-syntax...

[swedebugia]

On 2019-01-07 23:18, Ricardo Wurmus wrote:
> 
> Hej swedebugia,
> 
>> e.g.
>> (match '(1 2 "y" "x")
>>    (1
>>     'one)
>>    (number
>>     'number))
>>
>> Will match any number for the first clause and any string for the
>> second. It ONLY checks if it is a number.
> 
> This is not correct.  The first clause does not match because the number
> 1 is not equal to the list '(1 2 "y" "x").  So we fall through to the
> next pattern.  That pattern is just the variable name “number”, which
> will match absolutely anything.  “number” will be bound to '(1 2 "y"
> "x") and the return value of the clause is the symbol 'number.
> 
>> To actually match something e.g. the "x" literally we need to nest the
>> match like this:
>>
>> (match '(1 2 y x)
>>    (string
>>     (match string
>> 	("x"
>>            'x!)))
>>    (number
>>     'number))
> 
> No.  Here the first pattern matches absolutely anything.  The name
> “string” could be anything at all.  It’s just the name of a variable
> that should be bound.  So here you first bind '(1 2 y x) to the variable
> “string”, and then you try match the value of that very same variable to
> the string "x", which fails.  Hence we fall through to the next clause,
> where the pattern is just the variable “number”, which will bind to
> absolutely anything.  So that’s what happens and the symbol 'number is
> returned.
> 
>> Positional arguments work like this:
>>
>> (match '(1 2 y x)
>>    ;match the third item
>>    (_ _ string
>>     ;check if it is the literal "x"
>>     (match string
>> 	("x"
>>            'x!)))
>>    (number
>>     'number))
>>
>> Correct?
> 
> No.  If you run this in the REPL you’ll see an error.  You have
> misunderstood how match works.  Here’s another example:
> 
> (match '(1 2 x y)
>    ((one two three four)
>     (format #f
>             "the first value is ~a, the second is ~a, the third is ~a and the fourth is ~a\n"
>             one two three four))
>    ((this will never match)
>     #f))
> 
> Here we have two clauses: the first clause has the pattern
> 
>     (one two three four)
> 
> i.e. a list of four variables.  This matches the value exactly.  Each
> variable is bound to one of the values of the list.
> 
> The second clause has also four variables and would match just as well,
> but it will not be considered as the first pattern has already matched.
> 
> Does this make things clearer?
> 
> 
> To match by *type* (as you tried above) you need to use predicates.
> Here’s an example:
> 
> (match '(1 2 x y)
>    (((? string? one) two three four)
>     'will-not-match)
>    ((this (? number? will) totally match)
>     will))
> 
> The first pattern would only match if the first value were a string
> (which would be bound to the variable “one”).  But it is not, so the
> next pattern is tried.  There we want to match against four variables of
> which the second needs to be a number.  This matches, so “will” is bound
> to the number 2, which is what we return.

This was exactly what I needed to understand! <3

I went ahead and coded all morning and now I ported one of the 
medium-level procedures in guile-wikidata to use match:

(define* (get-label qid
		    #:key (language 'en))
   "Return STRING with label in the target language. Supports only one
language. Defaults to \"en\"."
   (and-let* ((l "labels")
	     (result (wdquery-alist (getentities-uri qid l #:languages language))))
     (match result
       ((_ (entities (q id type (labels (result (value . val) lang) _ 
...) _ ...)))
        val))))

scheme@(wikidata apis) [39]> (load "../guile-wikidata/wikidata/apis.scm")
scheme@(wikidata apis) [39]> (get-label "Q1111")
$25 = "electric charge"
scheme@(wikidata apis) [39]> (get-label "Q1111" #:language 'sv)
$26 = "elektrisk laddning"

-- 
Cheers Swedebugia

Re: Learning the match-syntax...

[Ricardo Wurmus]

swedebugia <swedebugia@riseup.net> writes:

> This was exactly what I needed to understand! <3

Yay, I'm glad you found this useful!

> I went ahead and coded all morning and now I ported one of the
> medium-level procedures in guile-wikidata to use match:
>
> (define* (get-label qid
> 		    #:key (language 'en))
>   "Return STRING with label in the target language. Supports only one
> language. Defaults to \"en\"."
>   (and-let* ((l "labels")
> 	     (result (wdquery-alist (getentities-uri qid l #:languages language))))

“and-let*” doesn’t make much sense here, because “l” will never be #F.
You could use “and=>” and “match-lambda” without storing the
intermediate “result” value:

(and=> (wdquery-alist (getentities-uri qid "labels" #:languages language))
       (match-lambda
        ((_ (entities . and-so-on)) 'whatever)))

I’d also like to advise against using *really* complicated patterns.  It
may make more sense to write smaller procedures that each extract some
part of the result alist, because when a pattern inevitably fails to
match (e.g. due to changes in the remote API or your procedures) you get
very poor error messages.

--
Ricardo