04/04: Fix some URL encoding issues around derivation names

[Christopher Baines]

cbaines pushed a commit to branch master
in repository data-service.

commit 8ed53099ba75a4e5e1eb027623251bbc7b6674cf
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Mon Jan 31 20:27:11 2022 +0000

    Fix some URL encoding issues around derivation names
---
 guix-data-service/web/revision/html.scm |  2 +-
 guix-data-service/web/util.scm          | 10 +++++++++-
 guix-data-service/web/view/html.scm     | 10 ++++------
 3 files changed, 14 insertions(+), 8 deletions(-)

diff --git a/guix-data-service/web/revision/html.scm 
b/guix-data-service/web/revision/html.scm
index 2f5efa2..45d58ec 100644
--- a/guix-data-service/web/revision/html.scm
+++ b/guix-data-service/web/revision/html.scm
@@ -300,7 +300,7 @@
                 `(tr
                   (td (samp ,system))
                   (td (samp ,target))
-                  (td (a (@ (href ,file-name))
+                  (td (a (@ (href ,(uri-encode-filename file-name)))
                          ,(display-store-item-short file-name)))
                   (td
                    (ul
diff --git a/guix-data-service/web/util.scm b/guix-data-service/web/util.scm
index 1dd193a..6c0caa7 100644
--- a/guix-data-service/web/util.scm
+++ b/guix-data-service/web/util.scm
@@ -29,7 +29,9 @@
 
             hyphenate-words
             remove-brackets
-            underscore-join-words))
+            underscore-join-words
+
+            uri-encode-filename))
 
 (define (most-appropriate-mime-type accepted-mime-types
                                     supported-mime-types)
@@ -112,3 +114,9 @@
   (string-join
    (string-split words #\space)
    "_"))
+
+(define (uri-encode-filename s)
+  (string-join
+   (map uri-encode
+        (string-split s #\/))
+   "/"))
diff --git a/guix-data-service/web/view/html.scm 
b/guix-data-service/web/view/html.scm
index 024eeda..8a0b64b 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -537,7 +537,7 @@
                    (h4 "Derivation: ")
                    ,(match derivation
                       ((file-name output-id)
-                       `(a (@ (href ,file-name))
+                       `(a (@ (href ,(uri-encode-filename file-name)))
                            ,(display-store-item file-name))))))))
              derivations)))))
 
@@ -623,7 +623,8 @@
                 ,@(map (match-lambda
                          ((derivation-file-name outputs)
                           `(tr
-                            (td (a (@ (href ,derivation-file-name))
+                            (td (a (@ (href ,(uri-encode-filename
+                                              derivation-file-name)))
                                    ,(display-store-item-short 
derivation-file-name))))))
                        derivation-inputs)))))
        (div
@@ -683,10 +684,7 @@
           ,@(map (match-lambda
                    ((output-name path hash-algorithm hash recursive?)
                     `(tr
-                      (td (a (@ (href ,(string-join
-                                        (map uri-encode
-                                             (string-split path #\/))
-                                        "/")))
+                      (td (a (@ (href ,(uri-encode-filename path)))
                              ,(display-store-item-short path))))))
                  derivation-outputs)))))))))