Package: guix-patches;
Reported by: Maxime Devos <maximedevos <at> telenet.be>
Date: Thu, 20 Jan 2022 13:01:02 UTC
Severity: normal
Tags: patch
Message #8 received at 53389 <at> debbugs.gnu.org (full text, mbox):
From: Maxime Devos <maximedevos <at> telenet.be> To: 53389 <at> debbugs.gnu.org Cc: ludo <at> gnu.org, Maxime Devos <maximedevos <at> telenet.be> Subject: [PATCH 3/9] tests/minetest: Run a HTTP server instead of mocking. Date: Thu, 20 Jan 2022 13:08:43 +0000
Fixes: <https://issues.guix.gnu.org/53060#3>
Unfortunately, for some unknown reason (a limitation of (guix tests http)
perhaps?), parallelism causes ECONNREFUSED in tests but not in the wild,
so 'par-map' has to be mocked for now.
* tests/minetest.scm (call-with-packages): Avoid mocking by running an
actual HTTP server.
* guix/import/minetest.scm (par-map): Allow mocking the Minetest importer's
use of par-map without impacting anything else.
Suggested-by: Ludovic Courtès <ludo <at> gnu.org>
---
guix/import/minetest.scm | 5 ++-
tests/minetest.scm | 82 ++++++++++++++++++++++++----------------
2 files changed, 53 insertions(+), 34 deletions(-)
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index 3b2cdcdcac..3eab5f703f 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -19,7 +19,6 @@
(define-module (guix import minetest)
#:use-module (ice-9 match)
#:use-module (ice-9 receive)
- #:use-module (ice-9 threads)
#:use-module (ice-9 hash-table)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
@@ -69,6 +68,10 @@
(define (delete-cr text)
(string-delete #\cr text))
+;; Mocked by tests.
+(define par-map (@ (ice-9 threads) par-map))
+(set! par-map par-map)
+
;;;
diff --git a/tests/minetest.scm b/tests/minetest.scm
index cbb9e83889..bdd8bd0645 100644
--- a/tests/minetest.scm
+++ b/tests/minetest.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos <at> telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,6 +23,7 @@
#:use-module (guix import minetest)
#:use-module (guix import utils)
#:use-module (guix tests)
+ #:use-module (guix tests http)
#:use-module (guix packages)
#:use-module (guix git-download)
#:use-module ((gnu packages minetest)
@@ -30,6 +31,9 @@
#:use-module ((gnu packages base)
#:select (hello))
#:use-module (json)
+ #:use-module (web request)
+ #:use-module (web uri)
+ #:use-module (web client)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -152,7 +156,7 @@
(invalidate-memoization! minetest->guix-package)
(define (scm->json-port scm)
(open-input-string (scm->json-string scm)))
- (define (handle-package url requested-author requested-name . rest)
+ (define (handle-package subresource requested-author requested-name . rest)
(define relevant-argument-list
(any (lambda (argument-list)
(apply (lambda* (#:key (author "Author") (name "foo")
@@ -164,14 +168,15 @@
argument-lists))
(when (not relevant-argument-list)
(error "the package ~a/~a should be irrelevant, but ~a is fetched"
- requested-author requested-name url))
- (scm->json-port
- (apply (match rest
- (("") make-package-json)
- (("dependencies" "") make-dependencies-json)
- (("releases" "") make-releases-json)
- (_ (error "TODO ~a" rest)))
- relevant-argument-list)))
+ requested-author requested-name subresource))
+ (define json (apply
+ (match rest
+ (("") make-package-json)
+ (("dependencies" "") make-dependencies-json)
+ (("releases" "") make-releases-json)
+ (_ (error "TODO ~a" rest)))
+ relevant-argument-list))
+ (values '() (lambda (port) (scm->json json port))))
(define (handle-mod-search sort)
;; Produce search results, sorted by SORT in descending order.
(define arguments->key
@@ -191,29 +196,40 @@
("name" . ,name)
("type" . ,type))))
(define argument-list->json (cut apply arguments->json <>))
- (scm->json-port
- (list->vector (filter-map argument-list->json sorted-argument-lists))))
- (mock ((guix http-client) http-fetch
- (lambda* (url #:key headers)
- (unless (string-prefix? "mock://api/packages/" url)
- (error "the URL ~a should not be used" url))
- (define resource
- (substring url (string-length "mock://api/packages/")))
- (define components (string-split resource #\/))
- (match components
- ((author name . rest)
- (apply handle-package url author name rest))
- (((? (cut string-prefix? "?type=mod&q=" <>) query))
- (handle-mod-search
- (cond ((string-contains query "sort=score") "score")
- ((string-contains query "sort=downloads") "downloads")
- (#t (error "search query ~a has unknown sort key"
- query)))))
- (_
- (error "the URL ~a should have an author and name component"
- url)))))
- (parameterize ((%contentdb-api "mock://api/"))
- (thunk))))
+ (define json
+ (list->vector (filter-map argument-list->json sorted-argument-lists)))
+ (values '()
+ (lambda (port) (scm->json json port))))
+ (with-http-server*
+ (lambda (request _)
+ (unless (eq? 'GET (request-method request))
+ (error "wrong HTTP method"))
+ (define resource (uri-path (request-uri request)))
+ (unless (string-prefix? "/api/packages/" resource)
+ (error "the resource ~a should not be used" resource))
+ (define subresource
+ (substring resource (string-length "/api/packages/")))
+ (define components (string-split subresource #\/))
+ (match components
+ ((author name . rest)
+ (apply handle-package subresource author name rest))
+ (("")
+ (let ((query (uri-query (request-uri request))))
+ (handle-mod-search
+ (cond ((string-contains query "sort=score") "score")
+ ((string-contains query "sort=downloads") "downloads")
+ (#t (error "search query ~a has unknown sort key"
+ query))))))
+ (_
+ (error "the resource ~a should have an author and name component"
+ resource))))
+ (parameterize ((%contentdb-api
+ (format #f "http://localhost:~a/api/" (%http-server-port)))
+ (current-http-proxy #f))
+ ;; XXX: for some unknown reason, parallelism causes ECONNREFUSED in
+ ;; tests but not in the wild.
+ (mock ((guix import minetest) par-map map)
+ (thunk)))))
(define* (minetest->guix-package* #:key (author "Author") (name "foo")
(sort %default-sort-key)
--
2.30.2
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.