Form builder example

gistfile1.lisp

(defclass account-name-field (email-field required-field) ())
(defmethod validate-field :after ((field account-name-field) account-name)
  (check-field (not (find-account-by-email account-name))
               "Account already exists."))

(defclass account-password-field (password-field required-field) ())
(defmethod validate-field :after ((field account-password-field) password)
  (check-field (and (>= (length password) 6)
                    (every #'standard-char-p password))
               "Password must be at least 6 characters long and can't contain funky characters."))


(defclass display-name-field (text-field required-field) ())
(defparameter *display-name-regex* (create-scanner "^[A-Z0-9._.-]+$"
                                                   :case-insensitive-mode t))
(defmethod validate-field :after ((field display-name-field) display-name)
  (check-field (not (display-name-exists-p display-name)) "Display name is already in use.")
  (check-field (scan *display-name-regex* display-name) "Invalid characters in display name.")
  (check-field (and (>= (length display-name) 4)
                    (<= (length display-name) 32))
               "Display name must be between 4 and 32 alphanumeric characters."))

(deform signup
  ((:email 'account-name-field)
   (:display-name 'display-name-field)
   (:password 'account-password-field)
   (:confirmation 'account-password-field))
  ((string= (field-raw signup :password)
            (field-raw signup :confirmation))
   "Password confirmation does not match."
   :confirmation))

(defun create-account (signup-form)
  (with-db ()
    (with-transaction ()
      (assert (form-valid-p signup-form) (signup-form) "Form is not valid: ~A" signup-form)
      (let ((salt (gensalt)))
        (make-dao 'account
                  :email (field-value signup-form :email)
                  :display-name (field-value signup-form :display-name)
                  :password (hash-password (field-value signup-form :password) salt)
                  :salt salt)))))