Update: Thanks to some comments from readers, I've made an updated version. Please see the code here. Specifically, the concept of the auth-provider and the auth-login-fields have gone the way of the dodo and been merged into a singular auth-method.
In this earlier post, I abused the Weblocks dataform object to implement a widget for creating a new user.
I have since been heads down coding but last night, I teased the login/authentication logic apart from the rest of my app and I have created a login widget that should be usable as a component. The main concept is the concept of an authentication provider, called the auth-provider. This is the part that the application writer fills in. Here is a sample:
;;; Not always just user/login :-)
:type string ; Weblocks types
;;; In this instance, only a tag but could have state.
(defclass my-auth-provider ()
;;; Helper function
(defun make-my-auth-provider ()
;;; The meat of it - return a generalized boolean. The result of this method is returned
;;; to the user
(defmethod auth-provider-authenticate ((map my-auth-provider) (fields my-auth-login-fields))
(user-find-match (site-find (my-auth-login-fields-site fields))
;;; The auth-provider and auth-login-fields are intimately connected.
(defmethod auth-provider-make-fields ((map my-auth-provider))
(make-instance 'my-auth-login-fields :auth-provider map))
To use the login widget:
(defmacro current-user ()
(defun init-user-session (comp)
(with-flow (composite-widgets comp)
;; The value returned here is whatever was returned by
;; auth-provider-authenticate. The widget does not return
;; until auth-provider-authenticate returns not nil.
(yield (make-instance 'login
(error "Um... User wasn't returned? This world is crazy. Atleast I still have my Lisp."))
Here is some code you should be able to copy-and-paste (you still need to write an auth-provider.) Let me know if you think there are improvements to be made. I'd like to submit this to Slava when I get a round tuit.
(defwidget login (weblocks:composite)
(defwidget login-form (weblocks:dataform)
(defmethod initialize-instance :after ((self login)
(declare (ignore args))
(let ((fields (auth-provider-make-fields auth-provider)))
(setf (widget-name self) "login-composite")
(setf (composite-widgets self)
(list (lambda () (with-html (:h1 (str login-title))))
(lambda (&rest args)
(declare (ignore args))
(answer self (slot-value fields 'result))))))))
(defclass auth-login-fields ()
(defun authenticate (provider fields)
(let ((result (auth-provider-authenticate provider fields)))
(tbnl:log-message* "Successful authentication")
(setf (slot-value fields 'result) result)
(values t nil))
(tbnl:log-message* "Failed authentication: ~A" fields)
(values nil '((foo "Authentication failed")))))))
;;; Weblocks hooks
(defmethod weblocks:update-object-from-request :around ((fields auth-login-fields)
(multiple-value-bind (success failed-slots)
(authenticate (auth-login-fields-auth-provider fields) fields)
(values success failed-slots))))
(defmethod weblocks:render-form-controls ((obj auth-login-fields)
(:div :class "submit"
(render-button *submit-control-name* :value "Login"))))
(defmethod weblocks:dataform-submit-action ((obj login-form) data &rest args)
(apply #'weblocks:update-object-from-request data :persist-object-p nil args))
;;; AUTH-PROVIDER GENERIC
(defgeneric auth-provider-authenticate (auth-provider fields)
(:documentation "Return a generalized boolean to indicate
whether the fields provided authenticate a user."))
(defgeneric auth-provider-make-fields (auth-provider)
(:documentation "Return the fields that auth-provider needs
to authenticate users. This is in the form of a new CLOS object instance.
The types of the fields should be specified to be one of the weblocks
types (see weblocks/src/types/*.lisp)"))
(defmacro def-auth-login-fields (name &body body)
"A macro used to define login fields."
`(defclass ,name (auth-login-fields)