36 lines
1.3 KiB
Common Lisp
36 lines
1.3 KiB
Common Lisp
|
(in-package #:cl-deck-builder2.web)
|
||
|
|
|
||
|
|
;;
|
||
|
|
;; Application
|
||
|
|
|
||
|
|
(defclass <web> (<app>) ())
|
||
|
|
(defvar *web* (make-instance '<web>))
|
||
|
|
(clear-routing-rules *web*)
|
||
|
|
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;; Aha,, figured it out. Hermetic Setup!
|
||
|
|
(setup
|
||
|
|
;; str->bool, t if a username exists, nil otherwise
|
||
|
|
:user-p (lambda (str)
|
||
|
|
(ignore-errors
|
||
|
|
(find-dao 'user :email str)))
|
||
|
|
;; str->str, maps a username to a password (hash, hopefully)
|
||
|
|
:user-pass (lambda (arg)
|
||
|
|
(ignore-errors
|
||
|
|
(mito-auth:password-hash
|
||
|
|
(find-dao 'user :email arg))))
|
||
|
|
;; str->(list sym), maps a username to a list of roles,
|
||
|
|
;; for example: (:user) (:user :tester :staff) (:user :admin)
|
||
|
|
:user-roles (lambda (arg)
|
||
|
|
(ignore-errors
|
||
|
|
(mapcar #'name-of
|
||
|
|
(user-roles-of
|
||
|
|
(find-dao 'user :email arg)))))
|
||
|
|
;; the /expression/ for the session object. ningle:*session* on
|
||
|
|
;; Ningle <https://github.com/fukamachi/ningle>.
|
||
|
|
:session caveman2:*session*
|
||
|
|
;; A function that displays an "access denied" message
|
||
|
|
:denied (lambda (&optional params)
|
||
|
|
(declare (ignore params))
|
||
|
|
(cl-markup:html5 (:h1 "Generic auth denied page"))))
|