From 2fe0577a02e2b85ebc15bdb9930cfcd642582742 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Sun, 18 Aug 2024 15:18:11 +0200
Subject: [PATCH] auth: set-up credentials and example (admin) principal
 basically OK

---
 lib/auth/auth.lisp            | 38 +++++++++++++++++++++--------------
 lib/auth/test/etc/config.lisp |  4 ++--
 lib/auth/test/test-auth.lisp  |  2 +-
 3 files changed, 26 insertions(+), 18 deletions(-)

diff --git a/lib/auth/auth.lisp b/lib/auth/auth.lisp
index b6cdff0..ed9dc56 100644
--- a/lib/auth/auth.lisp
+++ b/lib/auth/auth.lisp
@@ -21,36 +21,44 @@
 (defun setup (cfg)
   (let* ((auth (make-instance 'simple-authenticator))
          (ctx (core:default-setup cfg 'context :authenticator auth))
-         (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)
+         (cred (setup-credentials (admin-credentials cfg)))
+         (admin (make-principal :system :admin cred)))
+    (setf (gethash (list :system (login-name cred)) (principals auth)) admin)
     ctx))
 
+(defun setup-credentials (inp)
+  (let ((pw (digest (cadr inp))))
+    (make-instance 'simple-credentials :login (car inp) :password pw)))
+
 ;;;; simple / basic auth service implementation
 
 (defclass simple-authenticator () 
-  ((principals :reader principals :initform (make-hash-table))))
+  ((principals :reader principals :initform (make-hash-table :test 'equal))))
 
-(defclass simple-credentials () 
-  ((login-name)
-   (password)))
+(defclass base-credentials ()
+  ((login :reader login-name :initarg :login)))
+
+(defclass simple-credentials (base-credentials) 
+   ((password :reader password :initarg :password)))
 
 (defclass principal (shape:record) 
-  ((shape:head-fields :initform '(:organization :short-name))
+  ((shape:head-fields :initform '(:organization :name :login))
    (shape:data-fields :initform '(:credentials :full-name :email :role))))
 
-(defun authenticate (cred)
-  (make-instance 'principal))
+(defun make-principal (org name cred &optional (cls 'principal))
+  (make-instance cls :head (list org name (login-name cred)) 
+                     :data (list :credentials cred)))
 
 ;;;; login entry point
 
-(defun login (cred)
+(defun login (inp)
   (let* ((srv (core:find-service :auth))
          (auth (authenticator srv))
-         (admin (gethash :admin (principals auth))))
-    (util:lgi cred admin)
+         (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))
 
 ;;;; auxiliary functions
diff --git a/lib/auth/test/etc/config.lisp b/lib/auth/test/etc/config.lisp
index 2cbf9e8..b0494bc 100644
--- a/lib/auth/test/etc/config.lisp
+++ b/lib/auth/test/etc/config.lisp
@@ -17,8 +17,8 @@
 
 (config:add :auth :class 'auth:config
   :setup #'auth:setup
-  :admin-credentials `(:login ,(config:from-env :admin-login "admin")
-                       :password ,(config:from-env :admin-password "secret")))
+  :admin-credentials `(,(config:from-env :admin-login "admin")
+                       ,(config:from-env :admin-password "secret")))
 
 (config:add :server :class 'server:config
   :port "8899"
diff --git a/lib/auth/test/test-auth.lisp b/lib/auth/test/test-auth.lisp
index 93518bd..eb670ad 100644
--- a/lib/auth/test/test-auth.lisp
+++ b/lib/auth/test/test-auth.lisp
@@ -35,5 +35,5 @@
   (let ((cred '(:login "admin" :password "secret"))
         pr1)
     (setf pr1 (auth:login cred))
-    (== (shape:head-value pr1 :short-name) :admin)
+    (== (shape:head-value pr1 :name) :admin)
     ))