Don't hardcode the system and target for the derivation history page

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

@@ -24,6 +24,7 @@
   #:use-module (guix-data-service web util)
   #:use-module (guix-data-service model utils)
   #:use-module (guix-data-service model build-server)
+  #:use-module (guix-data-service model derivation)
   #:use-module (guix-data-service model package)
   #:use-module (guix-data-service model git-branch)
   #:use-module (guix-data-service model git-repository)
@@ -114,7 +115,8 @@
                    package-name
                    package-versions))))))
     (('GET "repository" repository-id "branch" branch-name "package" package-name "derivation-history")
-     (render-branch-package-derivation-history mime-types
+     (render-branch-package-derivation-history request
+                                               mime-types
                                                conn
                                                repository-id
                                                branch-name
@@ -229,17 +231,38 @@
                                     commit-hash))))
     (_ #f)))
 
-(define (render-branch-package-derivation-history mime-types
+(define (parse-build-system conn)
+  (let ((systems
+         (valid-systems conn)))
+    (lambda (s)
+      (if (member s systems)
+          s
+          (make-invalid-query-parameter
+           s "unknown system")))))
+
+(define (render-branch-package-derivation-history request
+                                                  mime-types
                                                   conn
                                                   repository-id
                                                   branch-name
                                                   package-name)
-  (let ((package-derivations
+  (let ((parsed-query-parameters
+         (parse-query-parameters
+          request
+          `((system  ,(parse-build-system conn)
+                     #:default "x86_64-linux")
+            (target  ,(parse-build-system conn)
+                     #:default "x86_64-linux")))))
+    (let* ((system
+            (assq-ref parsed-query-parameters 'system))
+           (target
+            (assq-ref parsed-query-parameters 'target))
+           (package-derivations
             (package-derivations-for-branch conn
                                             (string->number repository-id)
                                             branch-name
-                                         "x86_64-linux"
+                                            system
-                                         "x86_64-linux"
+                                            target
                                             package-name))
            (build-server-urls
            (group-to-alist
@@ -271,8 +294,10 @@
         (else
          (render-html
           #:sxml (view-branch-package-derivations
+                  parsed-query-parameters
                   repository-id
                   branch-name
                   package-name
+                  (valid-systems conn)
                   build-server-urls
-                package-derivations))))))
+                  package-derivations)))))))

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

@@ -290,9 +290,11 @@
                                 (rationalize width 1)))))))))))
                versions-by-revision-range))))))))))
 
-(define (view-branch-package-derivations git-repository-id
+(define (view-branch-package-derivations query-parameters
+                                         git-repository-id
                                          branch-name
                                          package-name
+                                         valid-systems
                                          build-server-urls
                                          derivations-by-revision-range)
   (define versions-list
@@ -334,6 +336,29 @@
            "View JSON")
         (h1 (@ (style "white-space: nowrap;"))
             (samp ,package-name))))
+      (div
+       (@ (class "col-md-12"))
+       (div
+        (@ (class "well"))
+        (form
+         (@ (method "get")
+            (action "")
+            (class "form-horizontal"))
+         ,(form-horizontal-control
+           "System" query-parameters
+           #:options valid-systems
+           #:allow-selecting-multiple-options #f
+           #:help-text "Show derivations with this system.")
+         ,(form-horizontal-control
+           "Target" query-parameters
+           #:options valid-systems
+           #:allow-selecting-multiple-options #f
+           #:help-text "Show derivations with this target.")
+         (div (@ (class "form-group form-group-lg"))
+              (div (@ (class "col-sm-offset-2 col-sm-10"))
+                   (button (@ (type "submit")
+                              (class "btn btn-lg btn-primary"))
+                           "Update results"))))))
       (div
        (@ (class "row"))
        (div