Wednesday, 5 December 2007

Weblocks: Doing first-time setup for a web-app

After you read this, there is an update here!

So one of the things you want to do when you start an application is configure it. Ideally you wouldn't configure anything, but sometimes, at the very least you need an administrator login to be set up. I will talk about how to do just that using Weblocks. I assume you have already installed Weblocks and have created an application using weblocks:make-application.

First, I figured I wanted to store application configuration somewhere. To start with, I decided to just use the simple associative-container that comes with cl-containers (use ASDF to install it.) Then I added a bunch of configuration-related functions that would encapsulate the storage somewhat:


(in-package #:myapp)

(defparameter *config*
(make-container 'associative-container))

#|
Configuration variables:
config-first-config-complete-p: Whether the first configuration has been completed or not
|#

(defun load-config-from-file (filename)
(declare (ignore filename))
;; just set some defaults for now
(set-config-value 'config-first-config-complete-p nil))

(defun config-value (name)
(item-at *config* name))

(defun set-config-value (name value)
(setf (item-at *config* name) value))

When you called weblocks:make-application, that created the file myapp.lisp which contained the code that starts and stops your application. Insert a call to the function load-config-from-file there with some dummy argument for the filename for now (you will have to fill that in later - hint: use cl-store).

So now you can get and set arbitrary configuration values. The configuration key that I named above, namely config-first-config-complete-p is initially set to nil when the application starts for obvious reasons (hint: it is the topic of this post!)

Another file generated by make-application is init-session.lisp. If you are at all familiar with Weblocks, what this function does is initialize the session for the user connecting. You are supposed to set up a bunch of widgets and let the client have at them.

This is where using continuations comes in really handy:

(defun init-user-session (comp)
(with-flow (composite-widgets comp)
(unless (config-value 'config-first-config-complete-p)
(yield (list (first-time-setup))))
(yield (list (homepage)))))

So unless the first-time configuration has been completed (which is determined by checking the configuration value at runtime,) we return the result of first-time-setup which is obviously where the real magic happens.

I created another file, login.lisp, that I used to keep all the login logic. Right now, it only has the logic for creating a login but you can use your imagination. Anyway, the first-time-setup function looks like this:

(defun first-time-setup ()
(let ((tree-comp (make-instance 'composite)))
(with-flow (composite-widgets tree-comp)
(yield #'setup-admin-password)
(yield #'setup-done))
tree-comp))

When yielding continuations in Weblocks, the continuation is stored in a widget. That is why we need to create the composite widget and use it with the with-flow macro.

When you create a login, the minimum pieces of information you need are usually the user name and the password. Typically, you also need to verify the password. We need to create a widget that will let us do this.

Weblocks comes with a widget called the dataform which nicely wraps up editing server-side data structures on the client. All you need to pass it is an instance of your class, and it generates the appropriate form. Quite nice, if you ask me.

So the data model that I used to store the login creation was unimaginatively called create-login. As you can see, it is a normal CLOS class and there is nothing suspicious about it:

(defclass create-login ()
((name
:initarg :name
:accessor name
:initform nil)
(password
:initarg :password
:type password ;; except this!
:accessor password
:initform nil)
(verify-password
:initarg :verify-password
:type password ;; and this!
:accessor verify-password
:initform nil)))

The reason that I gave an explicit type to the password slots of the class was because if we just let them be, then Weblocks renders the textbox representing the password as a text input, rather than a password input. We will need to use the type to override this behaviour.

I defined the password type using (deftype password () 'string).

When a class slot value is rendered to HTML, the function render-form-value is called. As mentioned before, we want to override this behaviour for the password type. We do this as follows:

(defslotmethod render-form-value ((obj create-login)
slot-name
(slot-type (eql 'password))
slot-value
&rest keys
&key (human-name slot-name)
&allow-other-keys)
;; Need to use attributize-name because thats what weblocks uses
;; as the key when reading the post parameters
(with-html
(:input :name (attributize-name slot-name) :type "password")))

I love CLOS. Pay special attention to the call to attributize-name. It took me a while to figure that out!

So now, we need to actually create our widget that will let us add a login to our system. Actually, we are already done. The dataform does it for us:

(make-instance 'dataform :data login )

But what if the user just presses submit without actually entering any information? We should rap their knuckles for that, or atleast give them a message. We can use the flash widget for that. Since this will be part of the adding-a-user action, we create a widget that contains a flash message:

(defwidget login-widget (dataform)
((login-message
:initarg :login-message
:accessor login-message)))

Badly named, that should be create-login-widget but c'est la vie.

Way above, in first-time-setup, we yield the setup-admin-password continuation. That code looks like this:

(defun setup-admin-password (k)
(let* ((widget (make-instance 'composite))
(message (make-instance 'flash
:name 'hi
:messages
(list "Hello! Welcome to myapp. Please create an administrator login")))
(login (make-instance 'create-login))
(get-password (make-instance 'login-widget
:name 'create-login
:data login
:ui-state :form
:allow-close-p nil
:login-message message
:on-success
(lambda (&rest args)
(declare (ignore args))
(answer k)))))
(setf (composite-widgets widget)
(list message get-password))
(render-widget widget)))

We need to call render-widget because the function becomes a widget when you yield it. A little subtlety that I only came across by trial and error (and help from the mailing list of course!) The key thing to note is that we only return from the continuation (i.e., call answer) if the form submits successfully, passing all validation.

By default, Weblocks does very limited validation of form submissions. For example, it can validate whether there are any missing slots that are required. But in this case, we need to make sure that (for example,) the password and the verify-password slot values match exactly. This validation takes place when the form is submitted, and Weblocks calls the function dataform-submit-action. If you haven't guessed, we need to override this function and add our own validation:

(defmethod dataform-submit-action ((obj login-widget)
(data create-login)
&rest args)
(multiple-value-bind (success failed-slots)
(apply #'update-object-from-request data args)
(check-login-and-flash-messages data (login-message obj))))

Quite simple. The function update-object-from-request updates the data model (i.e., the create-login instance) and returns t when everything succeeded, or (nil failed-slots) if something failed. For some reason, I ignored the fail case. Go figure. The check-login-and-flash-messages function then does the actual validation, adds a bunch of messages to the flash object (referenced via (login-message obj)), and returns t if everything was ok, nil otherwise.

If this function returns t, then Weblocks considers that the submission has succeeded and calls the on-success function, which we neatly set up to return from the continuation.

In real life, you would obviously add the actual user to some database, but that is essentially the meat of what I did. In the end, you get something like the following:



Let me know what you think.

No comments: