cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

auth: basic login functionality working

Browse source
This commit is contained in:
Helmut Merz 2024-08-18 18:23:21 +02:00
parent 2fe0577a02
commit 22d9e88295
2 changed files with 12 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
lib/auth/auth.lisp
View file

@ -41,6 +41,10 @@
(defclass simple-credentials (base-credentials)
((password :reader password :initarg :password)))
(defmethod print-object ((cred simple-credentials) stream)
(print-unreadable-object (cred stream :type t :identity t)
(format stream "~s ~s" (login-name cred) (password cred))))
(defclass principal (shape:record)
((shape:head-fields :initform '(:organization :name :login))
(shape:data-fields :initform '(:credentials :full-name :email :role))))
@ -57,9 +61,12 @@
(cred (make-instance 'simple-credentials
:login (getf inp :login)
:password (digest (getf inp :password))))
(admin (gethash (list :system (login-name cred)) (principals auth))))
(util:lgi inp cred admin)
admin))
(prc (gethash (list :system (login-name cred)) (principals auth)))
(prc-cred (shape:data-value prc :credentials)))
(util:lgi inp cred)
(when (equalp (password cred) (password prc-cred))
(util:lgi prc)
prc)))
;;;; auxiliary functions

2
lib/auth/test/test-auth.lisp
View file

@ -34,6 +34,8 @@
(deftest test-login ()
(let ((cred '(:login "admin" :password "secret"))
pr1)
(== (auth:login cred) nil)
(setf (getf cred :password) "sc0pes")
(setf pr1 (auth:login cred))
(== (shape:head-value pr1 :name) :admin)
))