core/core.lisp

@@ -53,8 +53,8 @@
     (default-actions :reader default-actions :initform nil)
     (services :reader services :initform (make-hash-table))))
 
-(defun default-setup (cfg &optional (cls 'context) &rest args &key &allow-other-keys)
+(defun default-setup (cfg &optional (cls 'context))
-  (apply #'make-instance cls :config cfg :name (config:name cfg) args))
+  (make-instance cls :config cfg :name (config:name cfg)))
 
 (defun find-service (name &optional (parent *root*))
   (with-slots (services) parent

lib/auth/auth.lisp

@@ -4,7 +4,6 @@
   (:use :common-lisp)
   (:local-nicknames (:config :scopes/config)
                     (:core :scopes/core)
-                    (:shape :scopes/shape)
                     (:util :scopes/util))
   (:export #:config #:setup
            #:simple-credentials
@@ -16,27 +15,27 @@
   ((admin-credentials :reader admin-credentials :initarg :admin-credentials)))
 
 (defclass context (core:context)
-  ((authenticator :reader authenticator :initarg :authenticator)))
+  ((authenticator :initform (make-instance 'simple-authenticator))))
 
 (defun setup (cfg)
-  (let* ((auth (make-instance 'simple-authenticator))
+  (let* ((ctx (core:default-setup cfg 'context)))
-         (ctx (core:default-setup cfg 'context :authenticator auth))
-         (cred (admin-credentials cfg)))
-    (setf (gethash :admin (principals auth)) cred)
     ctx))
 
 ;;;; simple / basic auth service implementation
 
 (defclass simple-authenticator () 
-  ((principals :reader principals :initform (make-hash-table))))
+  ((principals)))
 
 (defclass simple-credentials () 
   ((login-name)
    (password)))
 
-(defclass principal (shape:record) 
+(defclass principal () 
-  ((shape:head-fields :initform '(:organization :short-name))
+  ((identifier)
-   (shape:data-fields :initform '(:credentials :full-name :email :role))))
+   (credentials)
+   (full-name)
+   (primary-address)
+   (primary-role)))
 
 (defun authenticate (cred)
   (make-instance 'principal))
@@ -44,10 +43,8 @@
 ;;;; login entry point
 
 (defun login (cred)
-  (let* ((srv (core:find-service :auth))
+  (let ((srv (core:find-service :auth)))
-         (auth (authenticator srv))
+    (util:lgi cred (admin-credentials (core:config srv)))))
-         (admin (gethash :admin (principals auth))))
-    (util:lgi cred admin)))
 
 ;;;; auxiliary functions
 

shape/shape.lisp

@@ -3,27 +3,20 @@
 (defpackage :scopes/shape
   (:use :common-lisp)
   (:local-nicknames (:util :scopes/util))
-  (:export #:record 
+  (:export #:record #:head-fields #:head #:head-value #:data
-           #:head-fields #:head #:head-value #:head-plist
+           #:head-plist))
-           #:data-fields #:data #:data-value))
 
 (in-package :scopes/shape)
 
 (defclass record ()
   ((head-fields :reader head-fields :initarg :head-fields 
                 :initform '(:taskid :username) :allocation :class)
-   (data-fields :reader data-fields :initarg :data-fields 
-                :initform nil :allocation :class)
    (head :reader head :initarg :head)
    (data :accessor data :initarg :data :initform nil)))
 
 (defmethod initialize-instance :after ((rec record) &key head &allow-other-keys)
   (setf (slot-value rec 'head) (util:rfill (head-fields rec) head)))
 
-(defmethod print-object ((rec record) stream)
-  (print-unreadable-object (rec stream :type t :identity t)
-    (format stream "~s <data ~s>" (head rec) (data rec))))
-
 (defun head-value (rec key)
   (elt (head rec) (position key (head-fields rec))))
 
@@ -35,9 +28,3 @@
     (dolist (hf (head-fields rec))
       (setf pl (cons hf (cons (util:keyword-to-string (pop hv)) pl))))
     pl))
-
-(defun data-value (rec key)
-  (getf (data rec) key))
-
-(defun (setf data-value) (val rec key)
-  (setf (getf (data rec) key) val))

web/server.lisp

@@ -29,7 +29,7 @@
   ((listener :accessor listener)))
 
 (defun setup (cfg)
-  (let ((ctx (core:default-setup cfg 'context)))
+  (let ((ctx (make-instance 'context :config cfg :name (config:name cfg))))
     (start ctx)))
 
 ;;;; listener = server process