From 54b992246637fb4f73a9d8b15d381cdc7bce3183 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Mon, 24 Jun 2019 20:30:47 +0100
Subject: Iterate the log viewing

Replace the Guile-side HTML escaping with a less complete, but hopefully
faster PostgreSQL side HTML escaping approach.

Also, allow reading part of the log, by default, the last 1,000,000
characters, as this should render quickly.
---
 guix-data-service/jobs/load-new-guix-revision.scm | 35 ++++++++++++++++++++---
 guix-data-service/web/controller.scm              | 21 ++++++++++----
 guix-data-service/web/view/html.scm               | 25 ++++++++++++++--
 3 files changed, 70 insertions(+), 11 deletions(-)

(limited to 'guix-data-service')

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index 8650202..7eb6cdf 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -69,14 +69,41 @@
            #f) ; number of characters that can be read
    "w"))
 
-(define (log-for-job conn job-id)
+(define* (log-for-job conn job-id
+                      #:key
+                      character-limit
+                      start-character)
+  (define (sql-html-escape s)
+    (string-append
+     "replace("
+     (string-append
+      "replace("
+      (string-append
+       "replace("
+       s
+       ",'&','&amp;')")
+      ",'<','&lt;')")
+     ",'>','&gt;')"))
+
+  (define (get-characters s)
+    (if start-character
+        (simple-format #f "substr(~A, ~A, ~A)"
+                       s start-character
+                       character-limit)
+        (simple-format #f "right(~A, ~A)" s character-limit)))
+
   (define log-query
-    "SELECT contents FROM load_new_guix_revision_job_logs WHERE job_id = $1")
+    (string-append
+     "SELECT "
+     (sql-html-escape (get-characters "contents"))
+     " FROM load_new_guix_revision_job_logs WHERE job_id = $1"))
 
   (define parts-query
     (string-append
-     "SELECT STRING_AGG(contents, '' ORDER BY id ASC) "
-     "FROM load_new_guix_revision_job_log_parts WHERE job_id = $1"))
+     "SELECT "
+     (sql-html-escape
+      (get-characters "STRING_AGG(contents, '' ORDER BY id ASC)"))
+     " FROM load_new_guix_revision_job_log_parts WHERE job_id = $1"))
 
   (match (exec-query conn log-query (list job-id))
     (((contents))
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index 6990fb9..d964497 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -529,11 +529,16 @@
    #:sxml (view-jobs
            (select-jobs-and-events conn))))
 
-(define (render-job mime-types conn job-id)
+(define (render-job mime-types conn job-id query-parameters)
   (render-html
    #:sxml (view-job
            job-id
-           (log-for-job conn job-id))))
+           query-parameters
+           (log-for-job conn job-id
+                        #:character-limit
+                        (assq-ref query-parameters 'characters)
+                        #:start-character
+                        (assq-ref query-parameters 'start_character)))))
 
 (define (parse-commit conn)
   (lambda (s)
@@ -823,8 +828,14 @@
      (render-jobs mime-types
                   conn))
     ((GET "job" job-id)
-     (render-job mime-types
-                 conn
-                 job-id))
+     (let ((parsed-query-parameters
+            (parse-query-parameters
+             request
+             `((start_character ,parse-number)
+               (characters ,parse-number #:default 1000000)))))
+       (render-job mime-types
+                   conn
+                   job-id
+                   parsed-query-parameters)))
     ((GET path ...)
      (not-found (request-uri request)))))
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index da7e992..ca744ff 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -975,7 +975,7 @@
                              '())))))
                  jobs-and-events)))))))))
 
-(define (view-job job-id log)
+(define (view-job job-id query-parameters log)
   (layout
    #:body
    `(,(header)
@@ -989,7 +989,28 @@
       (div
        (@ (class "row"))
        (div
-        (pre ,log)))))))
+        (@ (class "col-md-12"))
+        (div
+         (@ (class "well"))
+         (form
+          (@ (method "get")
+             (action "")
+             (class "form-horizontal"))
+          ,(form-horizontal-control
+            "Characters" query-parameters
+            #:help-text "Return at most this many characters.")
+          ,(form-horizontal-control
+            "Start character" query-parameters
+            #:help-text "Start reading the log from this character.")
+          (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 log")))))))
+      (div
+       (@ (class "row"))
+       (div
+        (pre (raw ,log))))))))
 
 (define (view-derivation derivation derivation-inputs derivation-outputs
                          builds)
-- 
cgit v1.2.3