+(test-assertm "inconclusive: no local build"
+ (let ((text (random-text)))
+ (mlet* %store-monad ((drv (gexp->derivation "something"
+ #~(list #$output #$text)))
+ (out -> (derivation->output-path drv))
+ (hash -> (gcrypt:sha256 #vu8())))
+ (with-derivation-narinfo* drv (sha256 => hash)
+ (>>= (compare-contents (list out) (%test-substitute-urls))
+ (match-lambda
+ ((report)
+ (return
+ (and (string=? out (comparison-report-item report))
+ (comparison-report-inconclusive? report)
+ (not (comparison-report-local-sha256 report))
+ (match (comparison-report-narinfos report)
+ ((narinfo)
+ (bytevector=? (narinfo-hash->sha256
+ (narinfo-hash narinfo))
+ hash))))))))))))
+(define (make-narinfo item size hash)
+ (format #f "StorePath: ~a
+Compression: none
+URL: nar/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo
+NarSize: ~d
+NarHash: sha256:~a
+References: ~%" item size (bytevector->nix-base32-string hash)))
+
+(define (call-mismatch-test proc)
+ "Pass PROC a <comparison-report> for a mismatch and return its return
+value."
+
+ ;; Pretend we have two different results for the same store item, ITEM, with
+ ;; "/bin/guile" differing between the two nars.
+ (mlet* %store-monad
+ ((drv1 (package->derivation %bootstrap-guile))
+ (drv2 (gexp->derivation
+ "broken-guile"
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+ (copy-recursively #$drv1 #$output)
+ (chmod (string-append #$output "/bin/guile")
+ #o755)
+ (call-with-output-file (string-append
+ #$output
+ "/bin/guile")
+ (lambda (port)
+ (display "corrupt!" port)))))))
+ (out1 -> (derivation->output-path drv1))
+ (out2 -> (derivation->output-path drv2))
+ (item -> (string-append (%store-prefix) "/"
+ (bytevector->nix-base32-string
+ (random-bytevector 32))
+ "-foo"
+ (number->string (current-time) 16))))
+ (mbegin %store-monad
+ (built-derivations (list drv1 drv2))
+ (mlet* %store-monad ((size1 (query-path-size out1))
+ (size2 (query-path-size out2))
+ (hash1 (query-path-hash* out1))
+ (hash2 (query-path-hash* out2))
+ (nar1 -> (call-with-bytevector-output-port
+ (lambda (port)
+ (write-file out1 port))))
+ (nar2 -> (call-with-bytevector-output-port
+ (lambda (port)
+ (write-file out2 port)))))
+ (parameterize ((%http-server-port 9000))
+ (with-http-server `((200 ,(make-narinfo item size1 hash1))
+ (200 ,nar1))
+ (parameterize ((%http-server-port 9001))
+ (with-http-server `((200 ,(make-narinfo item size2 hash2))
+ (200 ,nar2))
+ (mlet* %store-monad ((urls -> (list (%local-url 9000)
+ (%local-url 9001)))
+ (reports (compare-contents (list item)
+ urls)))
+ (pk 'report reports)
+ (return (proc (car reports))))))))))))
+
+(test-assertm "differing-files"
+ (call-mismatch-test
+ (lambda (report)
+ (equal? (differing-files report) '("/bin/guile")))))
+
+(test-assertm "call-with-mismatches"
+ (call-mismatch-test
+ (lambda (report)
+ (call-with-mismatches
+ report
+ (lambda (directory1 directory2)
+ (let* ((files1 (find-files directory1))
+ (files2 (find-files directory2))
+ (files (map (cute string-drop <> (string-length directory1))
+ files1)))
+ (and (equal? files
+ (map (cute string-drop <> (string-length directory2))
+ files2))
+ (equal? (remove (lambda (file)
+ (file=? (string-append directory1 "/" file)
+ (string-append directory2 "/" file)))
+ files)
+ '("/bin/guile")))))))))
+
+(test-end)