make shape:print-object more generic

lib/auth/auth.lisp

@@ -44,10 +44,11 @@
    ((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)))
+  (make-instance cls :name (util:to-keyword name) 
+                     :password (util:digest pw)))
 
 (defmethod print-object ((cred simple-credentials) stream)
-  (print-unreadable-object (cred stream :type t :identity t)
+  (print-unreadable-object (cred stream :type t)
     (format stream "~s ~s" (name cred) (password cred))))
 
 ;;; principal (abstract / generic user object)
@@ -76,11 +77,3 @@
     (when (equalp (password cred) (password prc-cred))
       (util:lgi prc)
       prc)))
-
-;;;; auxiliary functions
-
-(defun digest (pw &key (scheme :original))
-  (b64:encode-bytes
-    (ironclad:digest-sequence 
-      :sha3/256 (flexi-streams:string-to-octets pw :external-format :utf8))
-    :scheme scheme))

shape/shape.lisp

@@ -21,8 +21,12 @@
   (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))))
+  (print-unreadable-object (rec stream :type t)
+    (format-fields rec stream 'head 'data)))
+
+(defun format-fields (item stream &rest fields)
+  (let ((fm (format nil "~{~(~a~): ~~S ~}" fields)))
+    (apply #'format stream fm (mapcar #'(lambda (x) (funcall x item)) fields))))
 
 (defun head-value (rec key)
   (elt (head rec) (position key (head-fields rec))))

util.lisp

@@ -5,7 +5,7 @@
   (:local-nicknames (:b64 :qbase64))
   #+sbcl (:import-from :sb-ext #:add-package-local-nickname)
   (:export #:lg #:lgd #:lgi
-           #:create-secret
+           #:create-secret #:digest
            #:rfill #:rtrim #:loop-plist #:filter-plist #:plist-pairs #:plist-equal
            #:flatten-str #:to-keyword #:keyword-to-string #:to-integer #:to-string
            #:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
@@ -29,6 +29,12 @@
 (defun create-secret ()
   (b64:encode-bytes (ironclad:random-data 16)))
 
+(defun digest (pw &key (scheme :original) (alg :sha256))
+  (b64:encode-bytes
+    (ironclad:digest-sequence alg 
+      (flexi-streams:string-to-octets pw :external-format :utf8))
+    :scheme scheme))
+
 ;;;; lists and loops
 
 (defun rfill (ll ls)