diff --git a/prototype.lisp b/prototype.lisp index 3f0ec28..5088d30 100644 --- a/prototype.lisp +++ b/prototype.lisp @@ -92,11 +92,11 @@ (defmethod generate-blind-key ((bl ec-bl)) (random-scalar (ec bl))) (defmethod derive-blind-key ((bl ec-bl) ikm) - (let ((h2c (make-instance 'h2c :ec (ec bl) :h (h bl) :dst (id bl)))) + (let ((h2c (make-instance 'h2c :ec (ec bl) :h (hash 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))) + (hash-to-field h2c (i2osp bk 32) '(#x00) ctx))) (defmethod combine ((bl ec-bl-mul) bf1 bf2) (mod (* bf1 bf2) (order (ec bl)))) (defmethod blind-public-key ((bl ec-bl-mul) pk-s bk ctx) @@ -163,7 +163,7 @@ (defconstant +sha256+ (make-instance 'h :id :sha256)) (defconstant +p256+ - (make-instance 'ec :n +secp256r1-l+ :g +secp256r1-g+ :id :secp256r1)) + (make-instance 'ec-kg :n +secp256r1-l+ :g +secp256r1-g+ :id :secp256r1)) (defconstant +ecdh-p256+ (make-instance 'ec-dh :n-dh 32 :ec +p256+)) (defconstant +bl-ecdh-p256+ @@ -189,18 +189,23 @@ :kem +dhkem-p256-hkdf-sha256+ :n-s 32)) -(defmethod fold ((hdk hdk) salt path &optional bf) - (cond ((null path) (values bf salt)) +(defmethod fold ((hdk hdk) pk salt path &optional bf seed) + (cond ((null path) (values pk bf salt)) ((typep (car path) 'number) - (let ((ctx (create-context hdk (car path)))) - (fold (derive-salt hdk salt ctx) + (let ((ctx (create-context hdk (car path))) + (bk (derive-blind-key (bl hdk) salt))) + (fold (blind-public-key (bl hdk) pk bk ctx) + (derive-salt hdk salt ctx) (cdr path) - (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)) + (let ((bf2 (derive-blinding-factor (bl hdk) bk ctx))) + (if (null bf) bf2 (combine (bl hdk) bf bf2))) + (or seed salt)))) + (t (fold pk + (let ((sk-r (derive-key-pair (kem hdk) (concat (seed salt))))) + (decap (kem hdk) (car path) sk-r)) (cdr path) - bf)))) + bf + (or seed salt))))) (defclass document () ((pk :reader pk :initarg :pk))) (defun make-document (hdk doc salt index) @@ -215,41 +220,36 @@ (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)))) + (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)))) + (let ((pk (fold (hdk app) (pk-device app) (seed app) hdk))) (values pk '(:agree-key) (make-instance 'document :pk pk)))) -(defun create-shared-secret (app hdk reader-pk) - (Authenticate (cadr (device app)) reader-pk (fold (seed app) hdk))) +(defmethod create-shared-secret (app hdk reader-pk) + (blind-dh (bl (hdk app)) (cadr (device app)) + (nth-value 1 (fold (hdk app) (pk-device app) (seed app) hdk)) + reader-pk)) (defun delegate-key-creation (app hdk) - (KEM-Derive-Key-Pair (nth-value 1 (fold (seed app) hdk)))) + (derive-key-pair (kem (hdk app)) + (fold (hdk app) (pk-device app) (seed app) hdk))) (defun accept-key (app hdk kh index pk-expected) - (multiple-value-bind (sk pk) (delegate-key-creation app hdk) - (declare (ignore pk)) - (let ((salt (KEM-Decap kh sk)) - (pk-bl (get-key-info app hdk))) - (assert (EC-Point-Equal - pk-expected - (BL-Blind-Public-Key pk-bl (HDK salt index)))) - (append hdk (list kh index))))) + (let ((salt (decap (kem (hdk app)) kh (delegate-key-creation app hdk))) + (pk-bl (get-key-info app hdk)) + (ctx (create-context (hdk app) index))) + (assert (crypto:ec-point-equal + pk-expected + (blind-public-key (bl (hdk app)) pk-bl salt ctx))) + (append hdk (list kh index)))) (defconstant +hdk-root+ '(0)) (defclass unit () - ((app :reader app :initform (make-app)) + ((app :reader app :initarg app) (index :reader index :initform (make-hash-table :weakness :key)))) (defmacro unit-hdk (unit doc) (list 'gethash doc (list 'index unit))) -(defun make-unit () (make-instance 'unit)) +(defun make-unit (hdk) (make-instance 'unit :app (make-app hdk))) (defun activate (unit) (multiple-value-bind (pk purposes doc) (get-key-info (app unit) +hdk-root+) (declare (ignore pk purposes)) @@ -264,12 +264,17 @@ (app (app unit))) (setf (unit-hdk unit doc) (accept-key app hdk kh index (pk doc))))) -(defclass reader () ((sk :reader sk :initform (EC-Random)))) -(defun make-reader () (make-instance 'reader)) +(defclass reader () + ((sk :reader sk :initarg sk) + (kem :reader kem :initarg kem))) +(defun make-reader (ec-dhkem) + (make-instance 'reader :sk (random-scalar (ec ec-dhkem)) + :kem ec-dhkem)) (defun verify (reader doc device-data) - (= (OS2IP device-data) - (OS2IP (ECDH-Create-Shared-Secret (sk reader) (pk doc))))) -(defmethod pk ((reader reader)) (EC-Scalar-Base-Mult (sk reader))) + (= (os2ip device-data) + (os2ip (create-shared-secret (kem reader) (sk reader) (pk doc))))) +(defmethod pk ((reader reader)) + (scalar-base-mult (ec (kem reader)) (sk reader))) (loop with vectors = `(("" @@ -289,38 +294,45 @@ "c541708d3491184472c2c29bb749d4286b004ceb5ee6b9a7fa5b646c993f0ced" ))) for (msg dst len result) in vectors - do (assert (= (OS2IP (expand_message_xmd (ASCII msg) (ASCII dst) len)) - result))) + do (assert + (= (let ((h2c (make-instance 'h2c :ec +p256+ + :h +sha256+ + :dst dst))) + (os2ip (expand-message-xmd h2c (ASCII msg) (ASCII dst) len)) + result)))) (assert (let* ((prk - (HKDF-Extract - (I2OSP #x000102030405060708090a0b0c 13) - (I2OSP #x0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b 22))) - (okm (HKDF-Expand prk (I2OSP #xf0f1f2f3f4f5f6f7f8f9 10) 42))) + (extract +hkdf-sha256+ + (i2osp #x000102030405060708090a0b0c 13) + (i2osp #x0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b 22))) + (okm (expand +hkdf-sha256+ prk (i2osp #xf0f1f2f3f4f5f6f7f8f9 10) 42))) (and - (= (OS2IP prk) + (= (os2ip prk) #x077709362c2e32df0ddc3f0dc47bba6390b6c73bb50f9c3122ec844ad7c2b3e5) - (= (OS2IP okm) + (= (os2ip okm) (read-bytes "3cb25f25faacd57a90434f64d0362f2a2d2d0a90cf1a5a4c5db02d56ecc4c5bf34" "007208d5b887185865"))))) (assert - (= (KEM-Derive-Key-Pair - (I2OSP + (= (derive-key-pair +dhkem-p256-hkdf-sha256+ + (i2osp #x4270e54ffd08d79d5928020af4686d8f6b7d35dbe470265f1f5aa22816ce860e 32)) #x4995788ef4b9d6132b249ce59a77281493eb39af373d236a1fe415cb0c2d7beb)) -(assert (multiple-value-bind (sk pk) (KEM-Derive-Key-Pair (I2OSP #x01 4)) - (multiple-value-bind (k c) (KEM-Encap pk) - (= (OS2IP k) (OS2IP (KEM-Decap c sk)))))) +(assert (let ((kem +dhkem-p256-hkdf-sha256+)) + (multiple-value-bind (sk pk) (derive-key-pair kem (i2osp #x01 4)) + (multiple-value-bind (k c) (encap kem pk) + (= (os2ip k) (os2ip (decap kem c sk))))))) -(let* ((app (make-app)) +(let* ((app (make-app +hdk-ecdh-p256+)) (pk-bl (get-key-info app +hdk-root+)) (pk-kem (nth-value 1 (delegate-key-creation app +hdk-root+)))) - (multiple-value-bind (salt kh) (KEM-Encap pk-kem) - (let ((pk-expected (BL-Blind-Public-Key pk-bl (HDK salt 0)))) + (multiple-value-bind (salt kh) (encap (kem (hdk app)) pk-kem) + (let* ((ctx (create-context (hdk app) 0)) + (salt-prime (derive-salt (hdk app) salt ctx)) + (pk-expected (blind-public-key (bl (hdk app)) pk-bl salt-prime))) (accept-key app +hdk-root+ kh 0 pk-expected)))) (let* ((unit (make-unit))