(define-module (guix-qa-frontpage reproducible-builds)
  #:use-module (srfi srfi-43)
  #:use-module (ice-9 threads)
  #:use-module (zlib)
  #:use-module (json)
  #:use-module (guix-qa-frontpage guix-data-service)
  #:export (start-generate-reproducible.json-thread))

(define* (start-generate-reproducible.json-thread)
  (define (generate)
    (let* ((revision (get-latest-processed-branch-revision "master"))
           (data
            (guix-data-service-request
             (string-append
              "https://data.qa.guix.gnu.org/revision/" revision
              "/package-derivation-outputs.json?"
              "system=x86_64-linux&target=none&field=nars"
              "&limit_results=&all_results=on")))
           (output-consistency-by-package
            (make-hash-table)))

      (vector-for-each
       (lambda (_ output)
         (let ((consistency
                (assoc-ref output "output_consistency")))
           (unless (string=? consistency "unknown")
             (let* ((package (assoc-ref output "package"))
                    (key (cons (assoc-ref package "name")
                               (assoc-ref package "version"))))
               (hash-set! output-consistency-by-package
                          key
                          (cons consistency
                                (or (hash-ref output-consistency-by-package
                                              key)
                                    '())))))))
       (assoc-ref data "store_paths"))

      (let ((result
             (hash-fold
              (lambda (key val result)
                (cons
                 `((package . ,(car key))
                   (version . ,(cdr key))
                   (architecture . "x86_64-linux")
                   (status . ,(if (member "not-matching" val)
                                  "unreproducible"
                                  "reproducible")))
                 result))
              '()
              output-consistency-by-package)))

        (call-with-output-file "reproducible.json.gz"
          (lambda (port)
            (call-with-zlib-output-port
             port
             (lambda (port)
               (set-port-encoding! port "UTF-8")
               (scm->json (list->vector result)
                          port
                          #:pretty #t))
             #:format 'gzip))))))

  (call-with-new-thread
   (lambda ()
     (while #t
       (with-exception-handler
           (lambda (exn)
             (simple-format
              (current-error-port)
              "exception in generate reproducible.json fiber: ~A\n"
              exn))
         (lambda ()
           (with-throw-handler #t
             generate
             (lambda args
               (display (backtrace) (current-error-port))
               (newline (current-error-port)))))
         #:unwind? #t)
       (simple-format #t "finished generating reproducible.json.gz\n")

       (sleep (* 60 60 24))))))