Further simplify model, WIP

prototype.lisp

@@ -44,7 +44,8 @@
 
 (defclass hdk () ((id :reader id :initarg :id)
                   (bl :reader bl :initarg :bl)
-                  (kem :reader kem :initarg :kem)))
+                  (kem :reader kem :initarg :kem)
+                  (n-s :reader seed-length :initarg :n-s)))
 
 (defclass kem () ((n-secret :reader secret-length :initarg :n-secret)
                   (n-sk :reader private-key-length :initarg :n-sk)
@@ -90,9 +91,9 @@
          (output-length dh)))
 
 (defmethod generate-blind-key ((bl ec-bl)) (random-scalar (ec bl)))
-;;;(defmethod derive-blind-key ((bl ec-kb) ikm)
-;;;  (let ((h2c (make-instance 'h2c :ec (ec kb) :h +sha256+ :dst (id kb))))
-;;;    (hash-to-field h2c ikm)))
+(defmethod derive-blind-key ((bl ec-bl) ikm)
+  (let ((h2c (make-instance 'h2c :ec (ec bl) :h (h bl) :dst (id bl))))
+    (hash-to-field h2c ikm)))
 (defmethod derive-blinding-factor ((bl ec-bl) bk ctx)
   (let ((h2c (make-instance 'h2c :ec (ec bl) :h (hash bl) :dst (id bl))))
     (hash-to-field h2c bk '(#x00) ctx)))
@@ -103,8 +104,8 @@
 (defmethod blind-dh ((bl ec-bl-mul-dh) sk-x bf pk-y)
   (create-shared-secret (ec-dh bl) sk-x (scalar-mult (ec bl) pk-y bf)))
 
-(defmethod select ((hdk hdk) index) (concat (id hdk) (i2osp index 4)))
-(defmethod descend ((hdk hdk) bk ctx) (h (id hdk) bk ctx))
+(defmethod create-context ((hdk hdk) index) (concat (id hdk) (i2osp index 4)))
+(defmethod derive-salt ((hdk hdk) salt ctx) (h (id hdk) salt ctx))
 
 (defmethod mac ((hmac hmac) key &rest bs)
   (loop with mac = (crypto:make-mac :hmac key (id hmac))
@@ -115,17 +116,19 @@
 (defmethod expand ((hkdf hkdf) prk info len)
   (loop with tb = (make-array len :fill-pointer 0)
         for i from 1 upto (ceiling (/ len 32))
-        for ti = (mac (hmac hkdf) prk (|| info (i2osp i 1)))
-          then (mac (hmac hkdf) prk (|| ti info (i2osp i 1)))
+        for ti = (mac (hmac hkdf) prk (concat info (i2osp i 1)))
+          then (mac (hmac hkdf) prk (concat ti info (i2osp i 1)))
         do (loop for j across ti do (vector-push j tb))
         finally (return (coerce tb '(vector (unsigned-byte 8))))))
 
 (defmethod labeled-extract ((kem dhkem) salt label ikm)
-  (extract (hkdf kem) salt (|| (ascii "HPKE-v1") (id kem) (ascii label) ikm)))
+  (extract (hkdf kem) salt (concat (ascii "HPKE-v1") (id kem)
+                                   (ascii label) ikm)))
 (defmethod labeled-expand ((kem dhkem) prk label info length)
   (expand (hkdf kem)
           prk
-          (|| (i2osp length 2) (ascii "HPKE-v1") (id kem) (ascii label) info)
+          (concat (i2osp length 2) (ascii "HPKE-v1") (id kem)
+                  (ascii label) info)
           length))
 (defmethod extract-and-expand ((kem kem) dh kem-context)
   (let ((eae-prk (labeled-extract kem (ascii "") "eae_prk" dh)))
@@ -145,15 +148,15 @@
     (let* ((dh (create-shared-secret (dh kem) sk-e pk-r))
            (enc (serialize-public-key (ec kem) pk-e))
            (pk-rm (serialize-public-key (ec kem) pk-r))
-           (kem-context (|| enc pk-rm))
+           (kem-context (concat enc pk-rm))
            (shared-secret (extract-and-expand kem dh kem-context)))
       (values shared-secret enc))))
 (defmethod decap ((kem ec-dhkem) enc sk-r)
   (let* ((pk-e (deserialize-public-key (ec kem) enc))
          (dh (create-shared-secret (dh kem) sk-r pk-e))
          (pk-rm (serialize-public-key (ec kem)
                                       (scalar-base-mult (ec kem) sk-r)))
-         (kem-context (|| enc pk-rm))
+         (kem-context (concat enc pk-rm))
          (shared-secret (extract-and-expand kem dh kem-context)))
     shared-secret))
 
@@ -173,7 +176,7 @@
 (defconstant +hkdf-sha256+
   (make-instance 'hkdf :hmac +hmac-sha256+))
 (defconstant +dhkem-p256-hkdf-sha256+
-  (make-instance 'ec-dhkem :id (|| (ascii "KEM") (i2osp #x0010 2))
+  (make-instance 'ec-dhkem :id (concat (ascii "KEM") (i2osp #x0010 2))
                            :n-secret 32
                            :n-sk 32
                            :bitmask #xff
@@ -183,54 +186,48 @@
 (defconstant +hdk-ecdh-p256+
   (make-instance 'hdk :id (ascii "HDK-ECDH-P256-v1")
                       :bl +bl-ecdh-p256+
-                      :kem +dhkem-p256-hkdf-sha256+))
-
-(defmethod derive-blinding-factor ((hdk (eql +hdk-ecdh-p256+)) ciphertext)
-  ciphertext)
+                      :kem +dhkem-p256-hkdf-sha256+
+                      :n-s 32))
 
 (defmethod fold ((hdk hdk) salt path &optional bf)
   (cond ((null path) (values bf salt))
 	((typep (car path) 'number)
-         (let ((bk (derive-blind-key (kb hdk) salt))
-               (ctx (select hdk (car path))))
-           (fold (descend hdk bk ctx)
+         (let ((ctx (create-context hdk (car path))))
+           (fold (derive-salt hdk salt ctx)
                  (cdr path)
-                 (let ((bf2 (derive-blinding-factor (kb hdk) bk ctx)))
-                   (if (null bf) bf2 (combine (kb hdk) bf bf2))))))
+                 (let* ((bk (derive-blind-key (bl hdk) salt))
+                        (bf2 (derive-blinding-factor (bl hdk) bk ctx)))
+                   (if (null bf) bf2 (combine (bl hdk) bf bf2))))))
 	(t (fold (decap (kem hdk) (car path) (derive-key-pair (kem hdk) salt))
                  (cdr path)
                  bf))))
 
 (defclass document () ((pk :reader pk :initarg :pk)))
 (defun make-document (hdk doc salt index)
   (make-instance 'document
-                 :pk (blind-public-key (kb hdk)
+                 :pk (blind-public-key (bl hdk)
                                        (pk doc)
-                                       (derive-blind-key (kb hdk) salt)
-                                       (select hdk index))))
-;;; TODO instead consider keeping bk as hdk state instead of salt; just have
-;;; concept of salt/ikm when going from KEM output to bk
-
-(defmethod fold2 ((hdk hdk) bk path &optional bf)
-  (cond ((null path) (values bf bk))
-        ((typep (car path 'number))
-         (let ((ctx (select hdk (car path))))
-           (fold (descend hdk bk ctx)
-                 (cdr path)
-                 (let ((bf2 (derive-blinding-factor (kb hdk) bk ctx)))
-                   (if (null bf) bf2 (combine (kb hdk) bf bf2))))))
-        (t (fold (derive-blind-key (decap (kem hdk) (car path)
-                                          (derive-key-pair (kem hdk) bk)))
-                 (cdr path)
-                 bf)))) ;; TODO strange to derive KEM sk from KB bk
+                                       (derive-blind-key (bl hdk) salt)
+                                       (create-context hdk index))))
 
 (defclass app ()
-  ((device :reader device
-           :initform (multiple-value-list (BL-Generate-Blinding-Key-Pair)))
-   (seed :reader seed :initform (crypto:random-data *Ns*))))
-(defun make-app () (make-instance 'app))
+  ((hdk :reader hdk :initarg :hdk)
+   (device :reader device :initarg :device)
+   (seed :reader seed :initarg :seed)))
+(defun make-app (hdk)
+  (make-instance
+   'app
+   :hdk hdk
+   :device (multiple-value-list (generate-key-pair (ec (bl hdk))))
+   :seed (crypto:random-data (seed-length hdk))))
 (defun pk-device (app) (car (device app)))
 (defun get-key-info (app hdk)
+  (multiple-value-bind (bf salt) (fold (hdk app) (seed app) hdk)
+    (let ((pk (blind-public-key (bl (hdk app))
+                                (pk-device app)
+                                (derive-blind-key (bl (hdk app))
+                                                  (fold (seed app) hdk))
+                              ;; TODO include pk folding in fold
   (let ((pk (BL-Blind-Public-Key (pk-device app) (fold (seed app) hdk))))
     (values pk '(:agree-key) (make-instance 'document :pk pk))))
 (defun create-shared-secret (app hdk reader-pk)