From 0766bcf418b4ad9c456566237d78aa950aa96281 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Tue, 20 Aug 2024 19:28:44 +0200
Subject: [PATCH] auth: minor simplifications - get rid of login / login-name
 slot

---
 lib/auth/auth.lisp           | 34 +++++++++++++++++++---------------
 lib/auth/scopes-auth.asd     |  3 ++-
 lib/auth/test/test-auth.lisp |  3 ++-
 3 files changed, 23 insertions(+), 17 deletions(-)

diff --git a/lib/auth/auth.lisp b/lib/auth/auth.lisp
index 0b9a4e9..37ac06b 100644
--- a/lib/auth/auth.lisp
+++ b/lib/auth/auth.lisp
@@ -23,35 +23,41 @@
   (let* ((auth (make-instance 'simple-authenticator))
          (ctx (core:default-setup cfg 'context :authenticator auth))
          (cred (setup-credentials (admin-credentials cfg)))
-         (admin (make-principal :system :admin cred)))
-    (setf (gethash (list :system (login-name cred)) (principals auth)) admin)
+         (admin (make-principal :system cred)))
+    (setf (gethash (list :system (name cred)) (principals auth)) admin)
     ctx))
 
 (defun setup-credentials (inp)
-  (let ((pw (digest (cadr inp))))
-    (make-instance 'simple-credentials :login (car inp) :password pw)))
+  (make-credentials (car inp) (cadr inp)))
 
 ;;;; simple / basic auth service implementation
 
 (defclass simple-authenticator () 
   ((principals :reader principals :initform (make-hash-table :test 'equal))))
 
+;;; credentials
+
 (defclass base-credentials ()
-  ((login :reader login-name :initarg :login)))
+  ((name :reader name :initarg :name)))
 
 (defclass simple-credentials (base-credentials) 
    ((password :reader password :initarg :password)))
 
+(defun make-credentials (name pw &optional (cls 'simple-credentials))
+  (make-instance cls :name (util:to-keyword name) :password (digest pw)))
+
 (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))))
+    (format stream "~s ~s" (name cred) (password cred))))
+
+;;; principal (abstract / generic user object)
 
 (defclass principal (shape:record) 
-  ((shape:head-fields :initform '(:organization :name :login))
+  ((shape:head-fields :initform '(:organization :name))
    (shape:data-fields :initform '(:credentials :full-name :email :role))))
 
-(defun make-principal (org name cred &optional (cls 'principal))
-  (make-instance cls :head (list org name (login-name cred)) 
+(defun make-principal (org cred &optional (cls 'principal))
+  (make-instance cls :head (list org (name cred)) 
                      :data (list :credentials cred)))
 
 ;;;; login entry point
@@ -59,10 +65,8 @@
 (defun login (inp)
   (let* ((srv (core:find-service :auth))
          (auth (authenticator srv))
-         (cred (make-instance 'simple-credentials 
-                 :login (getf inp :login)
-                 :password (digest (getf inp :password))))
-         (prc (gethash (list :system (login-name cred)) (principals auth)))
+         (cred (make-credentials (getf inp :name) (getf inp :password)))
+         (prc (gethash (list :system (name cred)) (principals auth)))
          (prc-cred (shape:data-value prc :credentials)))
     (util:lgi inp cred)
     (when (equalp (password cred) (password prc-cred))
@@ -71,8 +75,8 @@
 
 ;;;; auxiliary functions
 
-(defun digest (pw)
+(defun digest (pw &key (scheme :original))
   (b64:encode-bytes
     (ironclad:digest-sequence 
       :sha3/256 (flexi-streams:string-to-octets pw :external-format :utf8))
-    :scheme :uri))
+    :scheme scheme))
diff --git a/lib/auth/scopes-auth.asd b/lib/auth/scopes-auth.asd
index d6bdbfb..1b579ac 100644
--- a/lib/auth/scopes-auth.asd
+++ b/lib/auth/scopes-auth.asd
@@ -8,7 +8,8 @@
   :description "Authentication services"
   :depends-on (:scopes
                :flexi-streams :ironclad :qbase64)
-  :components ((:file "auth"))
+  :components ((:file "auth")
+               (:file "web" :depends-on ("auth")))
   :long-description "scopes framework: authentication services."
   ;;#.(uiop:read-file-string
   ;;   (uiop:subpathname *load-pathname* "README.md")))
diff --git a/lib/auth/test/test-auth.lisp b/lib/auth/test/test-auth.lisp
index 2e1ea7a..80b5808 100644
--- a/lib/auth/test/test-auth.lisp
+++ b/lib/auth/test/test-auth.lisp
@@ -3,6 +3,7 @@
 (defpackage :scopes-auth/test
   (:use :common-lisp)
   (:local-nicknames (:auth :scopes-auth)
+                    (:web :scopes-auth/web)
                     (:client :scopes/web/client)
                     (:config :scopes/config)
                     (:core :scopes/core)
@@ -32,7 +33,7 @@
       (t:show-result))))
 
 (deftest test-login ()
-  (let ((cred '(:login "admin" :password "secret"))
+  (let ((cred '(:name "admin" :password "secret"))
         pr1)
     (== (auth:login cred) nil)
     (setf (getf cred :password) "sc0pes")