52 lines
1.4 KiB
Common Lisp
52 lines
1.4 KiB
Common Lisp
;;;; cl-scopes/lib/auth - authentication services
|
|
|
|
(defpackage :scopes-auth
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:config :scopes/config)
|
|
(:core :scopes/core)
|
|
(:shape :scopes/shape)
|
|
(:util :scopes/util))
|
|
(:export #:config #:setup
|
|
#:simple-credentials
|
|
#:login))
|
|
|
|
(in-package :scopes-auth)
|
|
|
|
(defclass config (config:base)
|
|
((admin-credentials :reader admin-credentials :initarg :admin-credentials)))
|
|
|
|
(defclass context (core:context)
|
|
((authenticator :initarg :authenticator)))
|
|
|
|
(defun setup (cfg)
|
|
(let* ((auth (make-instance 'simple-authenticator))
|
|
(ctx (core:default-setup cfg 'context :authenticator auth)))
|
|
ctx))
|
|
|
|
;;;; simple / basic auth service implementation
|
|
|
|
(defclass simple-authenticator ()
|
|
((principals)))
|
|
|
|
(defclass simple-credentials ()
|
|
((login-name)
|
|
(password)))
|
|
|
|
(defclass principal (shape:record)
|
|
((shape:head-fields :initform '(:organization :short-name))
|
|
(shape:data-fields :initform '(:credentials :full-name :email :role))))
|
|
|
|
(defun authenticate (cred)
|
|
(make-instance 'principal))
|
|
|
|
;;;; login entry point
|
|
|
|
(defun login (cred)
|
|
(let ((srv (core:find-service :auth)))
|
|
(util:lgi cred (admin-credentials (core:config srv)))))
|
|
|
|
;;;; auxiliary functions
|
|
|
|
(defun digest (pw)
|
|
(ironclad:digest-sequence
|
|
:sha3/256 (flexi-streams:string-to-octets pw :external-format :utf8)))
|