Initial commit

1 files changed, 338 insertions, 0 deletions

diff --git a/bffe/view/activity.scm b/bffe/view/activity.scm
new file mode 100644
index 0000000..484aa36
--- /dev/null
+++ b/bffe/view/activity.scm
@@ -0,0 +1,338 @@
+(define-module (bffe view activity)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
+  #:use-module (bffe view util)
+  #:use-module ((guix store) #:select (%store-prefix))
+  #:export (activity))
+
+(define (activity title state)
+  (define categorised-agents
+    (let ((categories
+           '(("x86_64-linux" "i686-linux")
+             ("aarch64-linux" "armhf-linux")
+             ("powerpc64le-linux")
+             ("i586-gnu"))))
+      (map
+       (lambda (systems)
+         (cons systems
+               (sort
+                (filter
+                 (lambda (agent)
+                   (not
+                    (null?
+                     (lset-intersection
+                      string=?
+                      (vector->list
+                       (assoc-ref agent "requested_systems"))
+                      systems))))
+                 (vector->list
+                  (assoc-ref state "agents")))
+                (lambda (a b)
+                  (string<? (or (assoc-ref a "name") "")
+                            (or (assoc-ref b "name") ""))))))
+       categories)))
+
+  (define (abbreviate-derivation drv)
+    (let ((base (string-drop
+                 drv
+                 (+ 1 (string-length (%store-prefix))))))
+      (string-drop-right
+       (string-drop base (+ 32 1))      ;32 hash part + 1 hyphen
+       4)))                             ;.drv
+
+  (define (git-commit-hash-length? str)
+    (= (string-length str) 40))
+
+  (layout
+   #:title (string-append "Activity — " title)
+   #:head
+   `((style "
+table tr:nth-child(even) {
+    background-color: var(--color-bg);
+}
+
+.agents {
+    display: grid;
+    column-gap: 5px;
+    row-gap: 5px;
+    grid-template-columns: repeat(auto-fill, minmax(355px, 355px));
+}
+
+.agent {
+    border: 2px solid var(--color-bg-secondary);
+    border-radius: var(--border-radius);
+    padding: 8px;
+}
+
+.agent h4 {
+    margin-block-start: 0px;
+    font-size: 22px;
+}
+
+.agent-load {
+    border-width: 0px 12px 0px 0px;
+    border-style: solid;
+    padding-right: 3px;
+
+    border-radius: 3px;
+}
+
+.agent-load-normal {
+    border-color: #28a745;
+}
+
+.agent-load-medium {
+    border-color: orange;
+}
+
+.agent-load-high {
+    border-color: red;
+}
+
+.agent-plan-size {
+    float: right;
+    clear: right;
+
+    border-radius: 3px;
+}
+
+.build-tag {
+    display: inline-block;
+    padding: .2em .4em .3em;
+    font-size: 77%;
+    font-weight: 700;
+    line-height: 1;
+    text-align: center;
+    white-space: nowrap;
+    vertical-align: baseline;
+    border-radius: .25em;
+
+    background-color: var(--color-secondary-accent);
+}
+
+.build {
+    overflow-x: auto;
+    white-space: nowrap;
+
+    padding-top: 3px;
+    padding-bottom: 4px;
+    margin-bottom: 3px;
+}
+
+.build:not(:first-child) {
+    border-top: 2px solid var(--color-bg-secondary);
+}
+
+.hidden {
+    display: none;
+}
+
+#recent-activity {
+    width: 100%;
+    height: 200px;
+    overflow-y: scroll;
+}
+
+"))
+   #:body
+   `((main
+      (@ (id "main")
+         (data-stateid ,(assoc-ref state "state_id")))
+
+      (h2 "Recent activity")
+      (table
+       (@ (id "recent-activity"))
+       (tbody
+        (@ (id "recent-activity-body"))))
+
+      (h2 "Agents")
+      ,@(append-map
+         (match-lambda
+           ((systems . agents)
+            `((h3 (@ (class "monospace"))
+                  ,(string-join systems ", "))
+
+              (div
+               (@ (class "agents"))
+
+               ,@(filter-map
+                  (lambda (agent)
+                    (if (assoc-ref agent "active")
+                        (let ((all-builds
+                               (vector->list
+                                (assoc-ref agent "builds"))))
+                          `(div
+                            (@ (class "agent")
+                               (id
+                                ,(string-append
+                                  "agent-"
+                                  (assoc-ref agent "uuid")))
+                               (data-name
+                                ,(assoc-ref agent "name")))
+                            ,(let ((last-status-update
+                                    (assoc-ref
+                                     agent
+                                     "last_status_update")))
+                               (if (and last-status-update
+                                        (and=>
+                                         (assoc-ref last-status-update
+                                                    "timestamp")
+                                         (lambda (timestamp)
+                                           (let ((seconds
+                                                  (time-second
+                                                   (time-difference
+                                                    (current-time time-utc)
+                                                    (date->time-utc
+                                                     (string->date
+                                                      (string-append timestamp "Z")
+                                                      "~Y-~m-~d ~H:~M:~S~z"))))))
+                                             (< seconds (* 60 5))))))
+                                   (let* ((1min
+                                           (assoc-ref
+                                            last-status-update
+                                            "1min_load_average"))
+                                          (cores
+                                           (assoc-ref
+                                            last-status-update
+                                            "processor_count"))
+                                          (load-percentage
+                                           (/ (* 100 1min)
+                                              cores)))
+                                     `(span
+                                       (@ (style "float: right;")
+                                          (id
+                                           ,(string-append
+                                             "agent-"
+                                             (assoc-ref agent "uuid")
+                                             "-load"))
+                                          (class
+                                            ,(string-append
+                                              "agent-load "
+                                              (cond
+                                               ((< load-percentage 150)
+                                                "agent-load-normal")
+                                               ((< load-percentage 250)
+                                                "agent-load-medium")
+                                               (else
+                                                "agent-load-high"))))
+                                          (data-value
+                                           ,load-percentage))
+                                       "Load: "
+                                       ,(number->string
+                                         (round load-percentage))
+                                       "%"))
+                                   `(span
+                                     (@ (style "float: right;")
+                                        (id
+                                         ,(string-append
+                                           "agent-"
+                                           (assoc-ref agent "uuid")
+                                           "-load"))
+                                        (class "agent-load-unknown"))
+                                     "Status unknown")))
+                            (span
+                             (@ (class "agent-plan-size")
+                                (id
+                                 ,(string-append
+                                   "agent-"
+                                   (assoc-ref agent "uuid")
+                                   "-plan-size"))
+                                (data-value
+                                 ,(assoc-ref
+                                   (assoc-ref agent "allocation_plan")
+                                   "count")))
+                             "Plan size: "
+                             ,(assoc-ref
+                               (assoc-ref agent "allocation_plan")
+                               "count"))
+                            (h4 (@ (style "display: block;"))
+                                ,(assoc-ref agent "name"))
+                            (div
+                             (@ (class "agent-builds")
+                                (id
+                                 ,(string-append
+                                   "agent-"
+                                   (assoc-ref agent "uuid")
+                                   "-builds")))
+                             ,@(map
+                                (lambda (build index)
+                                  (let ((tags
+                                         (sort
+                                          (vector->list
+                                           (assoc-ref build "tags"))
+                                          (lambda (a b)
+                                            (string<?
+                                             (assoc-ref a "key")
+                                             (assoc-ref b "key"))))))
+                                    `(div
+                                      (@ (id
+                                          ,(string-append
+                                            "build-"
+                                            (assoc-ref build "uuid")))
+                                         (data-derivation
+                                          ,(or (assoc-ref build "derivation_name")
+                                               (assoc-ref build "derivation-name")))
+                                         (class
+                                           ,(string-append
+                                             "build"
+                                             (if (> index 3)
+                                                 " hidden"
+                                                 ""))))
+                                      (span
+                                       (@ (class "monospace")
+                                          (style "display: block;"))
+                                       ,(abbreviate-derivation
+                                         (or (assoc-ref build "derivation_name")
+                                             (assoc-ref build "derivation-name"))))
+                                      ,@(append-map
+                                         (lambda (tag)
+                                           `((span
+                                              (@ (class "build-tag"))
+                                              ,(assoc-ref tag "key")
+                                              ": "
+                                              ,(let ((val (assoc-ref
+                                                           tag "value")))
+                                                 (if (git-commit-hash-length? val)
+                                                     (string-take val 8)
+                                                     val)))
+                                             (*ENTITY* nbsp)))
+                                         tags))))
+                                ;; TODO Sort builds by priority?
+                                all-builds
+                                (iota (length all-builds))))
+                            (span
+                             (@ (id ,(string-append
+                                      "agent-"
+                                      (assoc-ref agent "uuid")
+                                      "-plus-x-builds"))
+                                (style ,(string-append
+                                         (if (> (length all-builds) 4)
+                                             "display: block;"
+                                             "display: none;")
+                                         "margin-top: 10px; text-align: center;")))
+                             ,(let ((additional-builds
+                                     (- (length all-builds)
+                                        4)))
+                                (if (= additional-builds 1)
+                                    (simple-format #f "Plus ~A other build"
+                                                   additional-builds)
+                                    (simple-format #f "Plus ~A other builds"
+                                                   additional-builds))))
+                            (span
+                             (@ (id ,(string-append
+                                      "agent-"
+                                      (assoc-ref agent "uuid")
+                                      "-no-allocated-builds"))
+                                (style ,(string-append
+                                         (if (= 0 (length all-builds))
+                                             "display: block;"
+                                             "display: none;")
+                                         "margin-top: 10px; text-align: center;")))
+                             "No allocated builds")))
+                        #f))
+                  agents)))))
+         categorised-agents)
+
+      (script (@ (src "/assets/js/activity.js")))))))