WIPchallenge-changes

1 files changed, 56 insertions, 30 deletions

diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm
index cc706d6e37..143d856e47 100644
--- a/guix/scripts/challenge.scm
+++ b/guix/scripts/challenge.scm
@@ -25,6 +25,7 @@
   #:use-module (guix monads)
   #:use-module (guix base32)
   #:use-module (guix packages)
+  #:use-module (guix progress)
   #:use-module (guix serialization)
   #:use-module (guix scripts substitute)
   #:use-module (gnu packages)
@@ -66,7 +67,10 @@
 ;;; Code:
 
 (define ensure-store-item                         ;XXX: move to (guix ui)?
-  (@@ (guix scripts size) ensure-store-item))
+  (lambda args
+    (display ".")
+    (force-output)
+    (apply (@@ (guix scripts size) ensure-store-item) args)))
 
 ;; Representation of a comparison report for ITEM.
 (define-record-type <comparison-report>
@@ -148,7 +152,14 @@ taken since we do not import the archives."
 
   (mlet* %store-monad ((local     (mapm %store-monad
                                         query-locally-built-hash items))
-                       (remote -> (append-map (cut lookup-narinfos <> items)
+                       (remote -> (append-map (lambda args
+                                                (let ((foo
+                                                       (apply
+                                                        (cut lookup-narinfos <> items)
+                                                        args)))
+                                                  (peek args)
+                                                  (simple-format #t "\nfoo: ~A \n\n" (length foo))
+                                                  foo))
                                               servers))
                        ;; No 'assert-valid-narinfo' on purpose.
                        (narinfos -> (fold (lambda (narinfo vhash)
@@ -156,30 +167,41 @@ taken since we do not import the archives."
                                                         vhash))
                                           vlist-null
                                           remote)))
-    (return (map (lambda (item local)
-                   (match (vhash-fold* cons '() item narinfos)
-                     (()                          ;no substitutes
-                      (comparison-report item 'inconclusive local '()))
-                     ((narinfo)
-                      (if local
-                          (if ((compare item local) narinfo (first servers))
-                              (comparison-report item 'match
-                                                 local (list narinfo))
-                              (comparison-report item 'mismatch
-                                                 local (list narinfo)))
-                          (comparison-report item 'inconclusive
-                                             local (list narinfo))))
-                     ((narinfos ...)
-                      (let ((reference
-                             (or local (select-reference item narinfos
-                                                         servers))))
-                        (if (every (compare item reference) narinfos servers)
-                            (comparison-report item 'match
-                                               local narinfos)
-                            (comparison-report item 'mismatch
-                                               local narinfos))))))
-                 items
-                 local))))
+    (return ;;(call-with-progress-reporter (progress-reporter/bar (length items))
+              ;;(lambda (report)
+                (map (lambda (item local)
+                       ;;(report)
+                       (display (length (vhash-fold* cons '() item narinfos)))
+                       (match (vhash-fold* cons '() item narinfos)
+                         (()                          ;no substitutes
+                          (comparison-report item 'inconclusive local '()))
+                         ((narinfo)
+                          (if local
+                              (if ((compare item local) narinfo (first servers))
+                                  (comparison-report item 'match
+                                                     local (list narinfo))
+                                  (comparison-report item 'mismatch
+                                                     local (list narinfo)))
+                              (comparison-report item 'inconclusive
+                                                 local (list narinfo))))
+                         ((narinfos ...)
+                          (let ((reference
+                                 (or local (select-reference item narinfos
+                                                             servers))))
+                            (when (= (length narinfos) 3)
+                              (for-each
+                               (lambda (narinfo)
+                                 (simple-format #t "\nnarinfos: ~A\n"
+                                                (narinfo-path narinfo)))
+                               narinfos))
+
+                            (if (every (compare item reference) narinfos servers)
+                                (comparison-report item 'match
+                                                   local narinfos)
+                                (comparison-report item 'mismatch
+                                                   local narinfos))))))
+                     items
+                     local))))
 
 (define* (summarize-report comparison-report
                            #:key
@@ -201,10 +223,12 @@ inconclusive reports."
 
   (match comparison-report
     (($ <comparison-report> item 'mismatch local (narinfos ...))
-     (report (G_ "~a contents differ:~%") item)
-     (report-hashes item local narinfos))
+     ;;(report (G_ "~a contents differ:~%") item)
+     ;;(report-hashes item local narinfos)
+     #f)
     (($ <comparison-report> item 'inconclusive #f narinfos)
-     (warning (G_ "could not challenge '~a': no local build~%") item))
+     ;;(warning (G_ "could not challenge '~a': no local build~%") item)
+     #f)
     (($ <comparison-report> item 'inconclusive locals ())
      (warning (G_ "could not challenge '~a': no substitutes~%") item))
     (($ <comparison-report> item 'match local (narinfos ...))
@@ -338,7 +362,9 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
              (run-with-store store
                (mlet* %store-monad ((items   (mapm %store-monad
                                                    ensure-store-item files))
-                                    (reports (compare-contents items urls)))
+                                    (reports (compare-contents
+                                              (delete-duplicates items string=?)
+                                              urls)))
                  (if export?
                      (begin
                        (report (scm->json-string