Suggest why derivations might not be found

This is now exported.

guix-data-service/database.scm

@@ -48,10 +48,6 @@
             NULL?
             exec-query-with-null-handling))
 
-;; TODO This isn't exported for some reason
-(define pg-conn-finish
-  (@@ (squee) pg-conn-finish))
-
 (define %database-metrics-registry
   (make-parameter #f))
 

guix-data-service/metrics.scm

@@ -107,25 +107,25 @@ WHERE relname NOT LIKE 'package_derivations_by_guix_revision_range_git_branch_%'
                    last-vacuum last-autovacuum last-analyze last-autoanalyze
                    vacuum-count autovacuum-count analyze-count autoanalyze-count)
           `((name                . ,relname)
-            (seq-scan            . ,seq-scan)
+            (seq-scan            . ,(string->number seq-scan))
-            (seq-tup-read        . ,seq-tup-read)
+            (seq-tup-read        . ,(string->number seq-tup-read))
-            (idx-scan            . ,idx-scan)
+            (idx-scan            . ,(string->number idx-scan))
-            (idx-tup-fetch       . ,idx-tup-fetch)
+            (idx-tup-fetch       . ,(string->number idx-tup-fetch))
-            (n-tup-ins           . ,n-tup-ins)
+            (n-tup-ins           . ,(string->number n-tup-ins))
-            (n-tup-upd           . ,n-tup-upd)
+            (n-tup-upd           . ,(string->number n-tup-upd))
-            (n-tup-del           . ,n-tup-del)
+            (n-tup-del           . ,(string->number n-tup-del))
-            (n-tup-hot-upd       . ,n-tup-hot-upd)
+            (n-tup-hot-upd       . ,(string->number n-tup-hot-upd))
-            (n-live-tup          . ,n-live-tup)
+            (n-live-tup          . ,(string->number n-live-tup))
-            (n-dead-tup          . ,n-dead-tup)
+            (n-dead-tup          . ,(string->number n-dead-tup))
-            (n-mod-since-analyze . ,n-mod-since-analyze)
+            (n-mod-since-analyze . ,(string->number n-mod-since-analyze))
-            (last-vacuum         . ,last-vacuum)
+            (last-vacuum         . ,(string->number last-vacuum))
-            (last-autovacuum     . ,last-autovacuum)
+            (last-autovacuum     . ,(string->number last-autovacuum))
-            (last-analyze        . ,last-analyze)
+            (last-analyze        . ,(string->number last-analyze))
-            (last-autoanalyze    . ,last-autoanalyze)
+            (last-autoanalyze    . ,(string->number last-autoanalyze))
-            (vacuum-count        . ,vacuum-count)
+            (vacuum-count        . ,(string->number vacuum-count))
-            (autovacuum-count    . ,autovacuum-count)
+            (autovacuum-count    . ,(string->number autovacuum-count))
-            (analyze-count       . ,analyze-count)
+            (analyze-count       . ,(string->number analyze-count))
-            (autoanalyze-count   . ,autoanalyze-count))))
+            (autoanalyze-count   . ,(string->number autoanalyze-count)))))
        (exec-query conn query)))
 
 (define (fetch-pg-stat-user-indexes-metrics conn)
@@ -153,10 +153,10 @@ WHERE pg_stat_user_indexes.schemaname = 'guix_data_service'
       `((name          . ,indexname)
         (table-name    . ,tablename)
         (tablespace    . ,tablespace)
-        (idx-scan      . ,idx_scan)
+        (idx-scan      . ,(string->number idx_scan))
-        (idx-tup-read  . ,idx_tup_read)
+        (idx-tup-read  . ,(string->number idx_tup_read))
-        (idx-tup-fetch . ,idx_tup_fetch)
+        (idx-tup-fetch . ,(string->number idx_tup_fetch))
-        (bytes         . ,size_in_bytes))))
+        (bytes         . ,(string->number size_in_bytes)))))
    (exec-query conn query)))
 
 (define (fetch-pg-stats-metrics conn)

guix-data-service/model/nar.scm

@@ -18,6 +18,8 @@
 (define-module (guix-data-service model nar)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-43)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:use-module (web uri)
   #:use-module (squee)
@@ -56,26 +58,36 @@
                (or (narinfo-deriver narinfo) NULL)))))
          narinfos))
 
-  (let ((nar-ids
+  (let* ((nar-ids
-         (vector->list
+          new-ids
           (insert-missing-data-and-return-all-ids
            conn
            "nars"
            '(store_path hash_algorithm hash size system deriver)
-           (list->vector data)))))
+           (list->vector data)))
+         (new-narinfos
+          (filter-map
+           (lambda (nar-id narinfo)
+             (if (vector-any (lambda (x)
+                               (= x nar-id))
+                             new-ids)
+                 (cons nar-id narinfo)
+                 #f))
+           (vector->list nar-ids)
+           narinfos)))
 
     (let ((reference-data
            (concatenate
-            (map (lambda (nar-id narinfo)
+            (map (match-lambda
+                   ((nar-id . narinfo)
                     (map (lambda (reference)
                            (simple-format
                             #f
                             "(~A, ~A)"
                             nar-id
                             (quote-string reference)))
-                        (narinfo-references narinfo)))
+                         (narinfo-references narinfo))))
-                 nar-ids
+                 new-narinfos))))
-                 narinfos))))
       (unless (null? reference-data)
         (exec-query
          conn
@@ -83,9 +95,7 @@
           "
 INSERT INTO nar_references (nar_id, reference)
 VALUES "
-          (string-join reference-data ", ")
+          (string-join reference-data ", ")))))
-          "
-ON CONFLICT DO NOTHING"))))
 
     (exec-query
      conn
@@ -95,7 +105,8 @@ INSERT INTO nar_urls (nar_id, url, compression, file_size)
 VALUES "
       (string-join
        (concatenate
-        (map (lambda (nar-id narinfo)
+        (map (match-lambda
+               ((nar-id . narinfo)
                 (map (lambda (uri compression file-size)
                        (simple-format
                         #f
@@ -107,14 +118,12 @@ VALUES "
                         (or file-size "NULL")))
                      (narinfo-uris narinfo)
                      (narinfo-compressions narinfo)
-                    (narinfo-file-sizes narinfo)))
+                     (narinfo-file-sizes narinfo))))
-             nar-ids
+             new-narinfos))
-             narinfos))
+       ", ")))
-       ", ")
-      "
-ON CONFLICT DO NOTHING"))
 
-    (for-each (lambda (nar-id narinfo)
+    (for-each (match-lambda
+                ((nar-id . narinfo)
                  (let ((narinfo-signature-data-id
                         (narinfo-signature->data-id conn narinfo)))
 
@@ -128,9 +137,7 @@ VALUES "
                       #f
                       "(~A,~A)"
                       nar-id
-                     narinfo-signature-data-id)
+                      narinfo-signature-data-id)))
-                    "
-ON CONFLICT DO NOTHING"))
 
                    (exec-query
                     conn
@@ -139,11 +146,10 @@ ON CONFLICT DO NOTHING"))
 INSERT INTO narinfo_fetch_records (narinfo_signature_data_id, build_server_id)
 VALUES ($1, $2)")
                     (list (number->string narinfo-signature-data-id)
-                         (number->string build-server-id)))))
+                          (number->string build-server-id))))))
-              nar-ids
+              new-narinfos)
-              narinfos)
 
-    nar-ids))
+    (vector->list nar-ids)))
 
 (define (sexp->json-string sexp)
   (define (transform x)

guix-data-service/web/compare/controller.scm

@@ -628,7 +628,7 @@
          (render-html
           #:sxml (compare/derivation
                   query-parameters
-                  '()))))
+                  #f))))
 
       (let ((base-derivation    (assq-ref query-parameters 'base_derivation))
             (target-derivation  (assq-ref query-parameters 'target_derivation)))

guix-data-service/web/compare/html.scm

@@ -483,7 +483,9 @@
              "View JSON")))))
       (div
        (@ (class "row"))
-       (div
+       ,@(if
+          data
+          `((div
              (@ (class "col-sm-12"))
              (h2 "Outputs")
              ,@(let ((outputs (assq-ref data 'outputs)))
@@ -667,7 +669,8 @@
                                                   (list target
                                                         (display-possible-store-item
                                                          target-value))))))))))))
-                 environment-variables))))))))))
+                      environment-variables))))))
+          '()))))))
 
 (define* (compare/package-derivations query-parameters
                                       mode

guix-data-service/web/controller.scm

@@ -347,11 +347,13 @@
             (for-each
              (match-lambda
                ((stat . value)
+                (and=> (assq-ref resource-pool-metrics stat)
+                       (lambda (metric)
                          (metric-set
-                 (assq-ref resource-pool-metrics stat)
+                          metric
                           value
                           #:label-values
-                 `((pool_name . ,name)))))
+                          `((pool_name . ,name)))))))
              (with-exception-handler
                  (lambda (exn)
                    (simple-format
@@ -496,7 +498,8 @@
         (render-html
          #:sxml (general-not-found
                  "Derivation not found"
-                 "No derivation found with this file name.")
+                 "Derivations can differ, but produce the same outputs, so try querying by
+output, rather than derivation file name.")
          #:code 404))))
 
 (define (render-json-derivation derivation-file-name)

guix-data-service/web/revision/controller.scm

@@ -933,7 +933,8 @@
 
   (define has-replacement? (assq-ref query-parameters 'has_replacement))
 
-  (fibers-let ((metadata
+  (fibers-let
+      ((metadata
         (with-resource-from-pool (connection-pool) conn
           (select-package-metadata-by-revision-name-and-version
            conn
@@ -992,6 +993,12 @@
            '(application/json text/html)
            mime-types)
       ((application/json)
+       (if (null? metadata)
+           (render-json
+            `((name . ,name)
+              (version . ,version)
+              (error . "package not found"))
+            #:code 404)
            (render-json
             `((name . ,name)
               (version . ,version)
@@ -1013,7 +1020,7 @@
                                          (derivation . ,file-name)
                                          (outputs . ,(list->vector outputs)))))
                                     derivations))))
-        #:extra-headers http-headers-for-unchanging-content))
+            #:extra-headers http-headers-for-unchanging-content)))
       (else
        (render-html
         #:sxml (view-revision-package-and-version commit-hash
@@ -1029,6 +1036,9 @@
                                                   #:header-link header-link
                                                   #:version-history-link
                                                   version-history-link)
+        #:code (if (null? metadata)
+                   404
+                   200)
         #:extra-headers http-headers-for-unchanging-content)))))
 
 (define* (render-revision-package-derivations mime-types

guix-data-service/web/revision/html.scm

@@ -243,6 +243,8 @@
        (div
         (@ (class "col-sm-12"))
         ,(match package-metadata
+           (()
+            "Package not found at this version")
            (((synopsis synopsis-locale description description-locale home-page file line column-number
                        licenses))
             `(dl

guix-data-service/web/server.scm

@@ -325,8 +325,8 @@ port. Also, the port used can be changed by passing the --port option.\n"
                                     (or (resource-pool-timeout-error? exn)
                                         (resource-pool-too-many-waiters-error? exn))))
                                (case (most-appropriate-mime-type
-                                      mime-types
+                                      '(text/html application/json)
-                                      '(text/html application/json))
+                                      mime-types)
                                  ((application/json)
                                   (apply
                                    values

guix-data-service/web/util.scm

@@ -33,8 +33,8 @@
 
             uri-encode-filename))
 
-(define (most-appropriate-mime-type accepted-mime-types
+(define (most-appropriate-mime-type supported-mime-types
-                                    supported-mime-types)
+                                    accepted-mime-types)
   (or
    ;; Pick the first supported mime-type
    (find (lambda (accepted-mime-type)

guix-dev.scm

@@ -44,39 +44,6 @@
              (gnu packages ruby)
              (srfi srfi-1))
 
-(define guile-knots
-  (let ((commit "d18b5b8d5de5beff3b9f84cfb359b73a4dcf2070")
-        (revision "1"))
-    (package
-    (name "guile-knots")
-    (version (git-version "0" revision commit))
-    (source (origin
-              (method git-fetch)
-              (uri (git-reference
-                    (url "https://git.cbaines.net/git/guile/knots")
-                    (commit commit)))
-              (sha256
-               (base32
-                "0ygf0m6y6mf53pgq5i7agv4a54fkml2akg3ws55jj79v5ndy3lnb"))
-              (file-name (string-append name "-" version "-checkout"))))
-    (build-system gnu-build-system)
-    (native-inputs
-     (list pkg-config
-           autoconf
-           automake
-           guile-next
-           guile-lib
-           guile-fibers-next))
-    (inputs
-     (list guile-next))
-    (propagated-inputs
-     (list guile-fibers-next))
-    (home-page "https://git.cbaines.net/guile/knots")
-    (synopsis "Patterns and functionality to use with Guile Fibers")
-    (description
-     "")
-    (license license:gpl3+))))
-
 (package
   (name "guix-data-service")
   (version "0.0.0")