diff --git a/prototype.lisp b/prototype.lisp index db76b44..3f0ec28 100644 --- a/prototype.lisp +++ b/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,7 +148,7 @@ (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) @@ -153,7 +156,7 @@ (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,20 +186,18 @@ (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)))) @@ -204,33 +205,29 @@ (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)