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

auth: more steps toward setting up default (admin) principal, + test login

Browse source
This commit is contained in:
Helmut Merz 2024-08-18 11:31:37 +02:00
parent 792a8c4c09
commit 6e7aadf3af
2 changed files with 12 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
lib/auth/auth.lisp
View file

@ -21,8 +21,11 @@
(defun setup (cfg) (defun setup (cfg)
(let* ((auth (make-instance 'simple-authenticator)) (let* ((auth (make-instance 'simple-authenticator))
(ctx (core:default-setup cfg 'context :authenticator auth)) (ctx (core:default-setup cfg 'context :authenticator auth))
(cred (admin-credentials cfg))) (cred (admin-credentials cfg))
(setf (gethash :admin (principals auth)) cred) (head '(:system :admin))
(data (list :credentials cred))
(admin (make-instance 'principal :head head :data data)))
(setf (gethash :admin (principals auth)) admin)
ctx)) ctx))
;;;; simple / basic auth service implementation ;;;; simple / basic auth service implementation
@ -47,7 +50,8 @@
(let* ((srv (core:find-service :auth)) (let* ((srv (core:find-service :auth))
(auth (authenticator srv)) (auth (authenticator srv))
(admin (gethash :admin (principals auth)))) (admin (gethash :admin (principals auth))))
(util:lgi cred admin))) (util:lgi cred admin)
admin))
;;;; auxiliary functions ;;;; auxiliary functions

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

@ -9,6 +9,7 @@
(:cs-hx :scopes/frontend/cs-hx) (:cs-hx :scopes/frontend/cs-hx)
(:logging :scopes/logging) (:logging :scopes/logging)
(:server :scopes/web/server) (:server :scopes/web/server)
(:shape :scopes/shape)
(:t :scopes/testing)) (:t :scopes/testing))
(:import-from :scopes/testing #:deftest #:==) (:import-from :scopes/testing #:deftest #:==)
(:export #:run)) (:export #:run))
@ -31,6 +32,8 @@
(t:show-result)))) (t:show-result))))
(deftest test-login () (deftest test-login ()
(let ((cred '(:login "admin" :password "secret"))) (let ((cred '(:login "admin" :password "secret"))
(auth:login cred) pr1)
(setf pr1 (auth:login cred))
(== (shape:head-value pr1 :short-name) :admin)
)) ))