feat(panettone): Use postgres as the storage backend r/1497

Switch from cl-prevalence to postgres (via postmodern) as the storage
backend for panettone. The first time the application starts up after
this commit, it will (idempotently) initialize the db schema and migrate
over all data from the prevalence snapshot to the database - the plan is
then to get rid of the prevalence classes and dependency once that's
deployed.

Change-Id: I4f35707efead67d8854f1c224ef67f8471620453
Reviewed-on: https://cl.tvl.fyi/c/depot/+/1467
Tested-by: BuildkiteCI
Reviewed-by: tazjin <mail@tazj.in>
Reviewed-by: eta <eta@theta.eu.org>

5 files changed, 394 insertions, 116 deletions

diff --git a/web/panettone/default.nix b/web/panettone/default.nix
index 2de000b7e8..93000b0f50 100644
--- a/web/panettone/default.nix
+++ b/web/panettone/default.nix
@@ -12,6 +12,7 @@ depot.nix.buildLisp.program {
     hunchentoot
     lass
     local-time
+    postmodern
     trivial-ldap
 
     depot.lisp.klatre
@@ -21,6 +22,7 @@ depot.nix.buildLisp.program {
     ./panettone.asd
     ./src/packages.lisp
     ./src/css.lisp
+    ./src/model.lisp
     ./src/panettone.lisp
   ];
 }
diff --git a/web/panettone/src/model.lisp b/web/panettone/src/model.lisp
new file mode 100644
index 0000000000..3b19901c99
--- /dev/null
+++ b/web/panettone/src/model.lisp
@@ -0,0 +1,225 @@
+(in-package :panettone.model)
+(declaim (optimize (safety 3)))
+
+(defun connect-postgres (&key
+                           (host (or (uiop:getenvp "PGHOST") "localhost"))
+                           (user (or (uiop:getenvp "PGUSER") "panettone"))
+                           (password (or (uiop:getenvp "PGPASSWORD") "password"))
+                           (database (or (uiop:getenvp "PGDATABASE") "panettone"))
+                           (port (or (integer-env "PGPORT") 5432)))
+  "Initialize the global postgresql connection for Panettone"
+  (postmodern:connect-toplevel database user password host :port port))
+
+;;;
+;;; Schema
+;;;
+
+(define-constant +issue-statuses+ '(:open :closed)
+  :test #'equal)
+
+(deftype issue-status ()
+  "Type specifier for the status of an `issue'"
+  (cons 'member +issue-statuses+))
+
+(defun ddl/create-issue-status ()
+  "Issue DDL to create the `issue-status' type, if it doesn't exist"
+  (unless (query (:select (:exists (:select 1
+                                    :from 'pg_type
+                                    :where (:= 'typname "issue_status"))))
+                 :single)
+    (query (sql-compile
+            `(:create-enum issue-status ,+issue-statuses+)))))
+
+(defclass issue ()
+  ((id :col-type serial :initarg :id :accessor id)
+   (subject :col-type string :initarg :subject :accessor subject)
+   (body :col-type string :initarg :body :accessor body :col-default "")
+   (author-dn :col-type string :initarg :author-dn :accessor author-dn)
+   (comments :type list :accessor issue-comments)
+   (num-comments :type integer :accessor num-comments)
+   (status :col-type issue_status
+           :initarg :status
+           :accessor status
+           :initform :open
+           :col-default "open")
+   (created-at :col-type timestamp
+               :col-default (local-time:now)
+               :accessor created-at))
+  (:metaclass dao-class)
+  (:keys id)
+  (:table-name issues)
+  (:documentation
+   "Issues are the primary entity in the Panettone database. An issue is
+   reported by a user, has a subject and an optional body, and can be either
+   open or closed"))
+
+(defmethod cl-postgres:to-sql-string ((kw (eql :open)))
+  (cl-postgres:to-sql-string "open"))
+(defmethod cl-postgres:to-sql-string ((kw (eql :closed)))
+  (cl-postgres:to-sql-string "closed"))
+
+(defun created-at->timestamp (object)
+  (assert (slot-exists-p object 'created-at))
+  (unless (or (not (slot-boundp object 'created-at))
+              (typep (slot-value object 'created-at) 'local-time:timestamp))
+    (setf (slot-value object 'created-at)
+          (local-time:universal-to-timestamp (created-at object)))))
+
+(defmethod initialize-instance :after
+    ((issue issue) &rest initargs &key &allow-other-keys)
+  (declare (ignore initargs))
+  (unless (symbolp (status issue))
+    (setf (status issue)
+          (intern (string-upcase (status issue))
+                  "KEYWORD")))
+  (created-at->timestamp issue))
+
+(deftable issue (!dao-def))
+
+(defclass issue-comment ()
+  ((id :col-type integer :col-identity t :initarg :id :accessor id)
+   (body :col-type string :initarg :body :accessor body)
+   (author-dn :col-type string :initarg :author-dn :accessor author-dn)
+   (issue-id :col-type integer :initarg :issue-id :accessor :user-id)
+   (created-at :col-type timestamp
+               :col-default (local-time:now)
+               :accessor created-at))
+  (:metaclass dao-class)
+  (:keys id)
+  (:table-name issue_comments)
+  (:documentation "Comments on an `issue'"))
+(deftable (issue-comment "issue_comments")
+  (!dao-def)
+  (!foreign 'issues 'issue-id 'id :on-delete :cascade :on-update :cascade))
+
+(defmethod initialize-instance :after
+    ((issue-comment issue-comment) &rest initargs &key &allow-other-keys)
+  (declare (ignore initargs))
+  (created-at->timestamp issue-comment))
+
+(defun ddl/create-tables ()
+  "Issue DDL to create all tables, if they don't already exist."
+  (dolist (table '(issue issue-comment))
+    (unless (table-exists-p (dao-table-name table))
+      (create-table table))))
+
+(defun ddl/init ()
+  "Idempotently nitialize the full database schema for Panettone"
+  (ddl/create-issue-status)
+  (ddl/create-tables))
+
+;;;
+;;; Querying
+;;;
+
+(define-condition issue-not-found (error)
+  ((id :type integer
+       :initarg :id
+       :reader not-found-id
+       :documentation "ID of the issue that was not found"))
+  (:documentation
+   "Error condition for when an issue requested by ID is not found"))
+
+(defun get-issue (id)
+  "Look up the 'issue with the given ID and return it, or signal a condition of
+type `ISSUE-NOT-FOUND'."
+  (restart-case
+      (or (get-dao 'issue id)
+          (error 'issue-not-found :id id))
+    (different-id (new-id)
+      :report "Use a different issue ID"
+      :interactive (lambda ()
+                     (format t "Enter a new ID: ")
+                     (multiple-value-list (eval (read))))
+      (get-issue new-id))))
+
+(defun issue-exists-p (id)
+  "Returns `T' if an issue with the given ID exists"
+  (query
+   (:select (:exists (:select 1
+                      :from 'issues
+                      :where (:= 'id id))))
+   :single))
+
+(defun list-issues (&key status (with '(:num-comments)))
+  "Return a list of all issues with the given STATUS (or all if nil), ordered by
+  ID descending. If WITH contains `:NUM-COMMENTS' (the default) each issue will
+  have the `num-comments' slot filled with the number of comments on that issue
+  (to avoid N+1 queries)."
+  (let* ((condition (unless (null status)
+                      `(:where (:= status $1))))
+         (select (if (find :num-comments with)
+                     `(:select issues.* (:as (:count issue-comments.id)
+                                             num-comments)
+                               :from issues
+                               :left-join issue-comments
+                               :on (:= issues.id issue-comments.issue-id)
+                               ,@condition
+                               :group-by issues.id)
+                     `(:select * :from issues ,@condition)))
+         (query (sql-compile
+                 `(:order-by ,select (:desc id)))))
+    (with-column-writers ('num_comments 'num-comments)
+      (query-dao 'issue query status))))
+
+(defmethod num-comments ((issue-id integer))
+  "Return the number of comments for the given ISSUE-ID."
+  (query
+   (:select (:count '*)
+    :from 'issue-comments
+    :where (:= 'issue-id issue-id))
+   :single))
+
+(defmethod slot-unbound (cls (issue issue) (slot (eql 'comments)))
+  (declare (ignore cls) (ignore slot))
+  (setf (issue-comments issue) (issue-comments (id issue))))
+
+(defmethod issue-comments ((issue-id integer))
+  "Return a list of all comments with the given ISSUE-ID, sorted oldest first.
+NOTE: This makes a database query, so be wary of N+1 queries"
+  (query-dao
+   'issue-comment
+   (:order-by
+    (:select '*
+     :from 'issue-comments
+     :where (:= 'issue-id issue-id))
+    (:asc 'created-at))))
+
+;;;
+;;; Writing
+;;;
+
+(defun create-issue (&rest attrs)
+  "Insert a new issue into the database with the given ATTRS, which should be
+a plist of initforms, and return an instance of `issue'"
+  (insert-dao (apply #'make-instance 'issue attrs)))
+
+(defun delete-issue (issue)
+  (delete-dao issue))
+
+(defun set-issue-status (issue-id status)
+  "Set the status of the issue with the given ISSUE-ID to STATUS in the db. If
+the issue doesn't exist, signals `issue-not-found'"
+  (check-type issue-id integer)
+  (check-type status issue-status)
+  (when (zerop (execute (:update 'issues
+                         :set 'status (cl-postgres:to-sql-string status)
+                         :where (:= 'id issue-id))))
+    (error 'issue-not-found :id issue-id)))
+
+(defun create-issue-comment (&rest attrs &key issue-id &allow-other-keys)
+  "Insert a new issue comment into the database with the given ATTRS and
+ISSUE-ID, which should be a plist of initforms, and return an instance of
+`issue-comment'. If no issue exists with `ID' ISSUE-ID, signals
+`issue-not-found'."
+  (unless (issue-exists-p issue-id)
+    (error 'issue-not-found :id issue-id))
+  (insert-dao (apply #'make-instance 'issue-comment :issue-id issue-id attrs)))
+
+(comment
+ (connect-postgres)
+ (ddl/init)
+ (make-instance 'issue :subject "test")
+ (create-issue :subject "test"
+               :author-dn "cn=glittershark,ou=users,dc=tvl,dc=fyi")
+ )
diff --git a/web/panettone/src/packages.lisp b/web/panettone/src/packages.lisp
index 8ebf528cca..169d8833a7 100644
--- a/web/panettone/src/packages.lisp
+++ b/web/panettone/src/packages.lisp
@@ -1,10 +1,36 @@
+(defpackage panettone.util
+  (:use :cl :klatre)
+  (:import-from :alexandria :when-let)
+  (:export :integer-env))
+
 (defpackage panettone.css
   (:use :cl :lass)
   (:export :styles))
 
+(defpackage panettone.model
+  (:nicknames :model)
+  (:use :cl :panettone.util :klatre :postmodern)
+  (:import-from :alexandria :if-let :define-constant)
+  (:export
+   :connect-postgres :ddl/init
+
+   :issue
+   :issue-comment
+   :id :subject :body :author-dn :issue-id :status :created-at
+
+   :get-issue :issue-exists-p :list-issues :create-issue :set-issue-status
+   :delete-issue
+
+   :issue-comments :num-comments :create-issue-comment))
+
 (defpackage panettone
-  (:use :cl :klatre :easy-routes)
+  (:use :cl :panettone.util :klatre :easy-routes :iterate)
   (:import-from :cl-prevalence :get-id)
   (:import-from :defclass-std :defclass/std)
   (:import-from :alexandria :if-let :when-let)
+  (:import-from
+   :panettone.model
+   :id :subject :body :author-dn :issue-id :status :created-at
+   :issue-comments :num-comments)
+  (:shadow :next)
   (:export :start-pannetone :config :main))
diff --git a/web/panettone/src/panettone.lisp b/web/panettone/src/panettone.lisp
index 7d29edb7ac..07285e6930 100644
--- a/web/panettone/src/panettone.lisp
+++ b/web/panettone/src/panettone.lisp
@@ -5,14 +5,15 @@
 ;;; Data model
 ;;;
 
-(deftype issue-status ()
-  '(member :open :closed))
+(deftype issue-status () '(member :open :closed))
 
 (defclass/std issue-comment ()
   ((body :type string)
    (author-dn :type string)
    (created-at :type local-time:timestamp
-               :std (local-time:now))))
+               :std (local-time:now)))
+  (:documentation
+   "DEPRECATED: use `PANETTONE.MODEL::ISSUE-COMMENT' instead"))
 
 (defclass/std issue (cl-prevalence:object-with-id)
   ((subject body :type string :std "")
@@ -20,7 +21,9 @@
    (comments :std nil :type list :with-prefix)
    (status :std :open :type issue-status)
    (created-at :type local-time:timestamp
-               :std (local-time:now))))
+               :std (local-time:now)))
+  (:documentation
+   "DEPRECATED: use `PANETTONE.MODEL::ISSUE' instead"))
 
 (defclass/std user ()
   ((cn dn mail displayname :type string)))
@@ -84,12 +87,12 @@ successful, `nil' otherwise"
   (when-let ((user (if (typep user-or-username 'user) user-or-username
                        (find-user user-or-username))))
     (let ((dn (dn user)))
-      (multiple-value-bind (_r code-sym _msg)
-          (ldap:bind
-           (ldap:new-ldap :host (ldap:host *ldap*)
-                          :port (ldap:port *ldap*)
-                          :user dn
-                          :pass password))
+      (let ((code-sym
+              (nth-value 1 (ldap:bind
+                            (ldap:new-ldap :host (ldap:host *ldap*)
+                                           :port (ldap:port *ldap*)
+                                           :user dn
+                                           :pass password)))))
         (when (equalp code-sym 'trivial-ldap:success)
           user)))))
 
@@ -103,58 +106,6 @@ successful, `nil' otherwise"
 (defvar *p-system* nil
   "The persistence system for this instance of Panettone")
 
-(define-condition issue-not-found (error)
-  ((id :type integer
-       :initarg :id
-       :reader not-found-id
-       :documentation "ID of the issue that was not found"))
-  (:documentation
-   "Error condition for when an issue requested by ID is not
-  found"))
-
-(defun get-issue (system id)
-  (restart-case
-      (or
-       (cl-prevalence:find-object-with-id system 'issue id)
-       (error 'issue-not-found :id id))
-    (different-id (new-id)
-      :report "Use a different issue ID"
-      :interactive (lambda ()
-                     (format t "Enter a new ID: ")
-                     (multiple-value-list (eval (read))))
-      (get-issue system new-id))))
-
-(defun list-issues (system)
-  (cl-prevalence:find-all-objects system 'issue))
-
-(defun issues-with-status (system status)
-  (remove-if-not (lambda (issue) (eq (status issue) status))
-                 (list-issues system)))
-
-(defun open-issues (system) (issues-with-status system :open))
-(defun closed-issues (system) (issues-with-status system :closed))
-
-(defun create-issue (system &rest attrs)
-  (cl-prevalence:tx-create-object
-   system
-   'issue
-   (chunk-list 2 attrs)))
-
-(defun add-comment (system issue-id &rest attrs)
-  "Add a comment with the given ATTRS to the issue ISSUE-ID, and return the
-updated issue"
-  (let* ((comment (apply #'make-instance 'issue-comment attrs))
-         (issue (get-issue system issue-id))
-         (comments (append (issue-comments issue)
-                           (list comment))))
-    (cl-prevalence:tx-change-object-slots
-     system
-     'issue
-     issue-id
-     `((comments ,comments)))
-    (setf (slot-value issue 'comments) comments)
-    comments))
-
 (defun initialize-persistence (data-dir)
   "Initialize the Panettone persistence system, storing data in DATA-DIR"
   (ensure-directories-exist data-dir)
@@ -165,9 +116,67 @@ updated issue"
                       "/snapshot.xml")))
 
 
-  (when (null (list-issues *p-system*))
+  (when (null (cl-prevalence:find-all-objects *p-system* 'issue))
     (cl-prevalence:tx-create-id-counter *p-system*)))
 
+(defun prevalence->postgresql (system &key force)
+  "Idempotently migrate all data from the cl-prevalence system SYSTEM into the
+global postgresql connection (eg as initialized by
+`model:connect-postgres'). With FORCE=t, will clear the database first"
+  (pomo:with-transaction (prevalence->postgresql)
+    (when force
+      (pomo:query (:delete-from 'issues)))
+    (iter
+      (for issue in (cl-prevalence:find-all-objects system 'issue))
+      (counting
+       (unless (model:issue-exists-p (get-id issue))
+         (model:create-issue
+          :id (get-id issue)
+          :subject (subject issue)
+          :body (or (body issue) "")
+          :status (status issue)
+          :author-dn (author-dn issue)
+          :created-at (created-at issue)))
+       into num-issues)
+      (sum
+       (iter
+         (for comment in (issue-comments issue))
+         (counting
+          (unless (pomo:query
+                   (:select
+                    (:exists
+                     (:select 1
+                      :from 'issue_comments
+                      :where (:and
+                              (:= 'issue_id (get-id issue))
+                              (:= 'body (body comment))
+                              (:= 'author_dn (author-dn comment))))))
+                   :single)
+            (model:create-issue-comment
+             :body (body comment)
+             :author-dn (author-dn comment)
+             :issue-id (get-id issue)
+             :created-at (created-at comment)))))
+       into num-comments)
+      (finally
+       (let ((next-id (pomo:query
+                       (:select (:+ 1 (:max 'id))
+                        :from 'issues)
+                       :single)))
+         (pomo:query
+          (pomo:sql-compile
+           `(:alter-sequence issues_id_seq :restart ,next-id))))
+       (format t "Created ~A issues and ~A comments~&"
+               num-issues num-comments)
+       (return (values num-issues num-comments))))))
+
+(comment
+ (initialize-persistence "/home/grfn/code/depot/web/panettone/")
+ (model:connect-postgres)
+ (model:ddl/init)
+ (prevalence->postgresql *p-system* :force t)
+ )
+
 ;;;
 ;;; Views
 ;;;
@@ -178,7 +187,7 @@ updated issue"
 
 (setf (who:html-mode) :html5)
 
-(defun render/footer-nav (&rest extra)
+(defun render/footer-nav ()
   (who:with-html-output (*standard-output*)
     (:footer
      (:nav
@@ -250,6 +259,7 @@ updated issue"
                :value "Submit"))))))
 
 (defun created-by-at (issue)
+  (check-type issue model:issue)
   (who:with-html-output (*standard-output*)
     (:span :class "created-by-at"
            "Opened by "
@@ -269,7 +279,7 @@ updated issue"
     (:ol
      :class "issue-list"
      (dolist (issue issues)
-       (let ((issue-id (get-id issue)))
+       (let ((issue-id (model:id issue)))
          (who:htm
           (:li
            (:a :href (format nil "/issues/~A" issue-id)
@@ -350,8 +360,8 @@ updated issue"
              :value "Comment"))))
 
 (defun render/issue (issue)
-  (check-type issue issue)
-  (let ((issue-id (get-id issue))
+  (check-type issue model:issue)
+  (let ((issue-id (id issue))
         (issue-status (status issue)))
     (render ()
       (:header
@@ -397,7 +407,7 @@ updated issue"
                          " at "
                          (who:esc (format-dottime (created-at comment)))))))))
            (when *user*
-             (render/new-comment (get-id issue))))))))))
+             (render/new-comment (id issue))))))))))
 
 (defun render/not-found (entity-type)
   (render ()
@@ -420,6 +430,22 @@ updated issue"
               (hunchentoot:request-uri*)
               :utf-8)))))
 
+(defun @txn (next)
+  (pomo:with-transaction ()
+    (catch
+        ;; 'hunchentoot:handler-done is unexported, but is used by functions
+        ;; like hunchentoot:redirect to nonlocally abort the request handler -
+        ;; this doesn't mean an error occurred, so we need to catch it here to
+        ;; make the transaction still get committed
+        (intern "HANDLER-DONE" "HUNCHENTOOT")
+      (funcall next))))
+
+(defun @handle-issue-not-found (next)
+  (handler-case (funcall next)
+    (issue-not-found (err)
+      (render/not-found
+       (format nil "Issue #~A" (model:id err))))))
+
 (defroute login-form ("/login" :method :get)
     (original-uri)
   (if (hunchentoot:session-value 'user)
@@ -439,84 +465,69 @@ updated issue"
   (hunchentoot:redirect "/"))
 
 (defroute index ("/" :decorators (@auth-optional)) ()
-  (let ((issues (open-issues *p-system*)))
+  (let ((issues (model:list-issues :status :open)))
     (render/index :issues issues)))
 
 (defroute handle-closed-issues
     ("/issues/closed" :decorators (@auth-optional)) ()
-  (let ((issues (closed-issues *p-system*)))
+  (let ((issues (model:list-issues :status :closed)))
     (render/closed-issues :issues issues)))
 
 (defroute new-issue ("/issues/new" :decorators (@auth)) ()
   (render/new-issue))
 
 (defroute handle-create-issue
-    ("/issues" :method :post :decorators (@auth))
+    ("/issues" :method :post :decorators (@auth @txn))
     (&post subject body)
   (if (string= subject "")
       (render/new-issue "Subject is required")
       (progn
-        (cl-prevalence:execute-transaction
-         (create-issue *p-system*
-                       'subject subject
-                       'body body
-                       'author-dn (dn *user*)))
-        (cl-prevalence:snapshot *p-system*)
+        (model:create-issue :subject subject
+                                      :body body
+                                      :author-dn (dn *user*))
         (hunchentoot:redirect "/"))))
 
-(defroute show-issue ("/issues/:id" :decorators (@auth-optional))
+(defroute show-issue
+    ("/issues/:id" :decorators (@auth-optional @handle/issue-not-found))
     (&path (id 'integer))
   (handler-case
-      (let* ((issue (get-issue *p-system* id))
+      (let* ((issue (model:get-issue id))
              (*title* (format nil "~A | Panettone"
                               (subject issue))))
         (render/issue issue))
     (issue-not-found (_)
+      (declare (ignore _))
       (render/not-found "Issue"))))
 
 (defroute handle-create-comment
-    ("/issues/:id/comments" :decorators (@auth)
-                            :method :post)
+    ("/issues/:id/comments"
+     :decorators (@auth @handle-issue-not-found @txn)
+     :method :post)
     (&path (id 'integer) &post body)
   (flet ((redirect-to-issue ()
            (hunchentoot:redirect (format nil "/issues/~A" id))))
-    (if (string= body "")
-        (redirect-to-issue)
-        (handler-case
-            (progn
-              (cl-prevalence:execute-transaction
-               (add-comment *p-system* id
-                            :body body
-                            :author-dn (dn *user*)))
-              (cl-prevalence:snapshot *p-system*)
-              (redirect-to-issue))
-          (issue-not-found (_)
-            (render/not-found "Issue"))))))
+    (cond
+      ((string= body "")
+       (redirect-to-issue))
+      (:else
+       (model:create-issue-comment
+        :issue-id id
+        :body body
+        :author-dn (dn *user*))
+       (redirect-to-issue)))))
 
 (defroute close-issue
-    ("/issues/:id/close" :decorators (@auth)
+    ("/issues/:id/close" :decorators (@auth @handle-issue-not-found @txn)
                          :method :post)
     (&path (id 'integer))
-  (cl-prevalence:execute-transaction
-   (cl-prevalence:tx-change-object-slots
-    *p-system*
-    'issue
-    id
-    '((status :closed))))
-  (cl-prevalence:snapshot *p-system*)
+  (model:set-issue-status id :closed)
   (hunchentoot:redirect (format nil "/issues/~A" id)))
 
 (defroute open-issue
     ("/issues/:id/open" :decorators (@auth)
                          :method :put)
     (&path (id 'integer))
-  (cl-prevalence:execute-transaction
-   (cl-prevalence:tx-change-object-slots
-    *p-system*
-    'issue
-    id
-    '((status open))))
-  (cl-prevalence:snapshot *p-system*)
+  (model:set-issue-status id :open)
   (hunchentoot:redirect (format nil "/issues/~A" id)))
 
 (defroute styles ("/main.css") ()
@@ -526,23 +537,30 @@ updated issue"
 (defvar *acceptor* nil
   "Hunchentoot acceptor for Panettone's web server.")
 
+(defun migrate-db ()
+  "Migrate the database to the latest version of the schema
+
+In this iteration, intiialize the DDL and move all data from the prevalence
+snapshot to the DB. In future iterations, this will do things like adding new
+tables and columns"
+  (model:ddl/init)
+  (prevalence->postgresql *p-system*))
+
 (defun start-panettone (&key port data-dir
                           (ldap-host "localhost")
-                          (ldap-port 389))
+                          (ldap-port 389)
+                          postgres-params)
   (connect-ldap :host ldap-host
                 :port ldap-port)
+
   (initialize-persistence data-dir)
+  (apply #'model:connect-postgres postgres-params)
+  (migrate-db)
 
   (setq *acceptor*
         (make-instance 'easy-routes:routes-acceptor :port port))
   (hunchentoot:start *acceptor*))
 
-(defun integer-env (var &key default)
-  (or
-   (when-let ((str (uiop:getenvp var)))
-     (try-parse-integer str))
-   default))
-
 (defun main ()
   (let ((port (integer-env "PANETTONE_PORT" :default 6161))
         (ldap-port (integer-env "LDAP_PORT" :default 389))
diff --git a/web/panettone/src/util.lisp b/web/panettone/src/util.lisp
new file mode 100644
index 0000000000..9fd9ceaa79
--- /dev/null
+++ b/web/panettone/src/util.lisp
@@ -0,0 +1,7 @@
+(in-package :panettone.util)
+
+(defun integer-env (var &key default)
+  (or
+   (when-let ((str (uiop:getenvp var)))
+     (try-parse-integer str))
+   default))