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

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

View file

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

View file

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