mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
This commit is contained in:
Griffin Smith 2020-07-21 22:12:02 -04:00 committed by glittershark
parent 32c3f7731b
commit d3b7de0783
2 changed files with 39 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
web/panettone/default.nix
View file

@ -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

44
web/panettone/src/panettone.lisp
View file

@ -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)