feat(web/panettone): Display who opened issues and when r/1441

Add a line to the issue show page displaying who opened the issue and
when, the latter formatted in dottime.

Change-Id: Ie70d7fd9e62ae92f9a479969d4ea21daddccee40
Reviewed-on: https://cl.tvl.fyi/c/depot/+/1345
Reviewed-by: glittershark <grfn@gws.fyi>
Tested-by: BuildkiteCI

2 files changed, 39 insertions, 8 deletions

diff --git a/web/panettone/default.nix b/web/panettone/default.nix
index ae8127eb89..f906fa7a7b 100644
--- a/web/panettone/default.nix
+++ b/web/panettone/default.nix
@@ -7,8 +7,9 @@ depot.nix.buildLisp.program {
     cl-prevalence
     cl-who
     defclass-std
-    hunchentoot
     easy-routes
+    hunchentoot
+    local-time
     trivial-ldap
 
     depot.lisp.klatre
diff --git a/web/panettone/src/panettone.lisp b/web/panettone/src/panettone.lisp
index 16ab7cd969..b8199034e1 100644
--- a/web/panettone/src/panettone.lisp
+++ b/web/panettone/src/panettone.lisp
@@ -14,14 +14,15 @@
 
 (defclass/std issue-comment ()
   ((body :type string)
-   (author-dn :type string)))
+   (author-dn :type string)
+   (created-at :type local-time:timestamp)))
 
 (defclass/std issue (cl-prevalence:object-with-id)
   ((subject body :type string :std "")
    (author-dn :type string)
    (comments :std nil :type list :with-prefix)
-   (created-at :type integer
-               :std (get-universal-time))))
+   (created-at :type local-time:timestamp
+               :std (local-time:now))))
 
 (defclass/std user ()
   ((cn dn mail displayname :type string)))
@@ -55,15 +56,28 @@
   (ldap:search
    *ldap*
    `(and (= objectClass organizationalPerson)
-         (= cn ,username))
+         (or
+          (= cn ,username)
+          (= dn ,username)))
    ;; TODO(grfn): make this configurable
    :base "ou=users,dc=tvl,dc=fyi")
   (ldap:next-search-result *ldap*))
 
 (defun find-user (username)
   (check-type username (simple-array character (*)))
-  (ldap-entry->user
-   (find-user/ldap username)))
+  (when-let ((ldap-entry (find-user/ldap username)))
+    (ldap-entry->user ldap-entry)))
+
+(defun find-user-by-dn (dn)
+  (ldap:search *ldap* `(= objectClass organizationalPerson)
+               :base dn
+               :scope 'ldap:base)
+  (when-let ((ldap-entry (ldap:next-search-result *ldap*)))
+    (ldap-entry->user ldap-entry)))
+
+(comment
+ (user-by-dn "cn=glittershark,ou=users,dc=tvl,dc=fyi")
+ )
 
 (defun authenticate-user (user-or-username password)
   "Checks the given USER-OR-USERNAME has the given PASSWORD, by making a bind
@@ -81,6 +95,9 @@ successful, `nil' otherwise"
       (when (equalp code-sym 'trivial-ldap:success)
         user))))
 
+(defun author (object)
+  (find-user-by-dn (author-dn object)))
+
 ;;;
 ;;; Persistence
 ;;;
@@ -138,6 +155,7 @@ updated issue"
   (ensure-directories-exist data-dir)
   (setq *p-system* (cl-prevalence:make-prevalence-system data-dir))
 
+
   (when (null (list-issues *p-system*))
     (cl-prevalence:tx-create-id-counter *p-system*)))
 
@@ -208,11 +226,22 @@ updated issue"
      (:input :type :submit
              :value "Create Issue"))))
 
+(defun created-by-at (issue)
+  (format nil "Opened by ~A at ~A"
+          (when-let ((author (author issue)))
+            (displayname author))
+          (format-dottime (created-at issue))))
+
+(comment
+ (format nil "foo: ~A" "foo")
+ )
+
 (defun render/issue (issue)
   (check-type issue issue)
   (render
     (:h1 (who:esc (subject issue)))
-    (:div (who:esc (body issue)))))
+    (:p (who:esc (created-by-at issue)))
+    (:p (who:esc (body issue)))))
 
 (defun render/not-found (entity-type)
   (render
@@ -301,6 +330,7 @@ updated issue"
               (sb-thread:list-all-threads)))))
 
 (comment
+ (setq hunchentoot:*catch-errors-p* nil)
  (start-panettone :port 6161
                   :data-dir "/tmp/panettone"
                   :ldap-port 3899)