Commit d16152db authored by  Hayley Patton's avatar Hayley Patton 🐢

Signatures now use the binary format, abandon trying to sign/verify text format

parent 2b52385e
......@@ -79,7 +79,7 @@
(defun write-object-computed-values (object function)
(do-bound-sorted-slots (name computed-values object
netfarm-class-slot-table)
netfarm-class-computed-slot-table)
(l (write-integer l function))
(binary-render-to-function name function)
(let ((equivalent-list
......
......@@ -7,8 +7,8 @@
(defun hash-bytes (bytes)
(digest-sequence :sha256 (subseq bytes 0 (length bytes))))
(defun base-hash-object (object)
(hash-bytes (binary-render-object object :emit-signatures t
(defun base-hash-object (object &key (emit-signatures t))
(hash-bytes (binary-render-object object :emit-signatures emit-signatures
:emit-computed-values nil)))
(defgeneric hash-object (object)
......@@ -23,3 +23,33 @@
(defun hash-object* (object)
"Generate a hash for an object using HASH-OBJECT, but then base64-encode it. This seems common enough to deserve a function."
(bytes->base64 (hash-object object)))
(defun verify-object-hash (object hash)
"Verify a total hash as generated by HASH-OBJECT."
(let ((their-hash (alexandria:copy-array (subseq hash 0 32)
:element-type '(unsigned-byte 8)
:fill-pointer nil
:adjustable nil))
(our-hash (hash-object object)))
(ironclad:constant-time-equal their-hash our-hash)))
;;; Pronounceable verification codes.
;; Not dissimilar to https://github.com/deoxxa/proquint/blob/master/encode.js
;; Not awfully similar, either.
(defvar *vowels* "AEOU")
(defvar *consonants* "BFGLMRST")
(defun readable-verifier (digest)
"Map each byte in the byte array DIGEST (which probably should be a digest, to be fair) to words in a somewhat readable \"sentence\". This function should only be used for \"presenting\" hashes and those kind of values to users for verification, and not stored.
Each byte is written in a way where the bit pattern is mapped to CCCVVCCC or something like that. We tried to pick sounds that are hard to confuse; but you probably should just M-. this function and read the surroundings if you're curious about how this is implemented."
(format nil "~{~a ~(~a ~a ~a~)~^, ~a ~(~a ~a ~a~)~^,~%~}"
(loop for byte across digest
collect (format nil "~c~(~c~c~)"
(char *consonants*
(ldb (byte 3 5) byte))
(char *vowels*
(ldb (byte 2 3) byte))
(char *consonants*
(ldb (byte 3 0) byte))))))
......@@ -57,72 +57,25 @@
;;; Elliptic Curve Digital Signing Algorithm helpers
(declaim (inline hash-text sign-text verify-text))
(declaim (inline sign-object verify-object-signature))
(defun sign-text (key text)
(declare (string text)
(keys key))
(sign-message (keys-signature-private key)
(hash-text text)))
(defun verify-text (key signature text)
(defun verify-object-signature (key signature hash)
(declare (keys key)
((simple-array (unsigned-byte 8) (*)) signature)
(string text))
((simple-array (unsigned-byte 8) (*)) signature hash))
(verify-signature (keys-signature-public key)
(hash-text text)
signature))
(defun verify-object-hash (object hash)
"Verify a total hash as generated by HASH-OBJECT."
(let ((their-hash (alexandria:copy-array (subseq hash 0 32)
:element-type '(unsigned-byte 8)
:fill-pointer nil
:adjustable nil))
(our-hash (hash-object object)))
(ironclad:constant-time-equal their-hash our-hash)))
;;; Pronounceable verification codes.
;; Not dissimilar to https://github.com/deoxxa/proquint/blob/master/encode.js
;; Not awfully similar, either.
(defvar *vowels* "AEOU")
(defvar *consonants* "BFGLMRST")
(defun readable-verifier (digest)
"Map each byte in the byte array DIGEST (which probably should be a digest, to be fair) to words in a somewhat readable \"sentence\". This function should only be used for \"presenting\" hashes and those kind of values to users for verification, and not stored.
Each byte is written in a way where the bit pattern is mapped to CCCVVCCC or something like that. We tried to pick sounds that are hard to confuse; but you probably should just M-. this function and read the surroundings if you're curious about how this is implemented."
(format nil "~{~a ~(~a ~a ~a~)~^, ~a ~(~a ~a ~a~)~^,~%~}"
(loop for byte across digest
collect (format nil "~c~(~c~c~)"
(char *consonants*
(ldb (byte 3 5) byte))
(char *vowels*
(ldb (byte 2 3) byte))
(char *consonants*
(ldb (byte 3 0) byte))))))
hash signature))
(defun sign-object (object key)
(sign-text key
(render-object object
:emit-computed-values nil
:emit-signatures nil)))
(sign-message (keys-signature-private key)
(base-hash-object object :emit-signatures nil)))
(defun verify-object-signatures (object)
(let ((text (render-object object
:emit-computed-values nil
:emit-signatures nil)))
(dolist (signature-pair (object-signatures object))
(destructuring-bind (user . signature) signature-pair
(unless (verify-text (object->keys user)
signature text)
(return-from verify-object-signatures nil))))
t))
(loop with hash = (base-hash-object object :emit-signatures nil)
for (user . signature) in (object-signatures object)
always (verify-object-signature (object->keys user)
signature hash)))
(defun add-signature (object key user)
(push (cons user
(sign-object object key))
(push (cons user (sign-object object key))
(object-signatures object))
object)
......@@ -36,8 +36,16 @@
(write-string " (" *trace-output*)
(the-cost-of-nothing:write-si-unit time "seconds" *trace-output*)
(write-string ")" *trace-output*))))))
(defmacro named-bench/bytes (name object form)
`(progn
(format *trace-output* "~&| ~24a" ,(string-downcase name))
(let* ((byte-length (length (netfarm:binary-render-object ,object)))
(time (the-cost-of-nothing:benchmark ,form)))
(the-cost-of-nothing:write-si-unit (float (/ byte-length time))
"bytes/second"
*trace-output*))))
(define-test object-value-benchmark
:parent benchmark
(let ((instance (make-instance 'benchmark-class
......@@ -107,3 +115,21 @@
(named-bench/mips "fib(28)" *fib* 28)
(named-bench/mips "loop" *loop* 2000000)
(named-bench/mips "cons-loop" *cons-loop* '() 1000000))
(defvar *words* #("a" "administrators" "an" "and" "at" "attempt" "bubble" "client" "creating" "decentralisation" "develop" "devise" "distributed" "do" "fault" "fill" "greater" "hash" "hierarchical" "in" "is" "language's" "leave" "less" "meta" "moderation" "netfarm" "not" "object" "of" "operators" "perceived" "programming" "protocol" "rapidly-expanding" "servers'" "simplify" "system" "table" "techniques" "that" "the" "their" "them" "to" "tolerance" "trustless" "utilise" "via" "void" "we" "whim"))
(define-test crypto-benchmark
:parent benchmark
(announce-bench-group cryptographic-operations)
(let* ((keys (generate-keys))
(user (keys->object keys))
(small-object (make-instance 'song :lyrics "Burn a bridge and burn a boat, stake a lizard by the throat"))
(large-object (make-instance 'song
:lyrics (loop repeat 100000
collect (alexandria:random-elt *words*)))))
(named-bench/bytes hash-small small-object (hash-object small-object))
(named-bench/bytes hash-large large-object (hash-object large-object))
(named-bench/bytes sign-small small-object
(add-signature small-object keys user))
(named-bench/bytes sign-large large-object
(add-signature large-object keys user))))
(in-package :netfarm-tests)
(defvar *song-about-stuff* "Photographers snip snap
(defclass song ()
((lyrics :initarg :lyrics :reader song-lyrics))
(:metaclass netfarm-class))
(defvar *song-about-stuff* (make-instance 'song :lyrics "Photographers snip snap
Take your time she's only burning
This kind of experience
Is necessary for her learning")
Is necessary for her learning"))
(define-test key-tests)
(define-test sign
:parent key-tests
(let* ((key (generate-keys))
(signature (sign-text key *song-about-stuff*)))
(of-type keys key "MAKE-KEYS did not return a NETFARM-KEYS struct")
(of-type (simple-array (unsigned-byte 8) (64)) signature
"SIGN-TEXT did not return a 64-byte hash")
(true (verify-text key signature *song-about-stuff*) "SIGNATURE could not be verified")))
(define-test symmetric
:parent key-tests
(let* ((key1 (generate-keys))
......@@ -26,25 +21,33 @@ Is necessary for her learning")
(cipher1 (symmetric-cipher ecdh1))
(cipher2 (symmetric-cipher ecdh2)))
(true (every #'= ecdh1 ecdh2) "A common ECDH key was not created.")
(is string= *song-about-stuff*
(is string= (song-lyrics *song-about-stuff*)
(symmetric-decrypt cipher1
(symmetric-encrypt cipher2 *song-about-stuff*))
(symmetric-encrypt cipher2
(song-lyrics *song-about-stuff*)))
"A string could not be reliably encrypted and decrypted")))
(define-test verifier
:parent key-tests
(let* ((digest (hash-text *song-about-stuff*))
(let* ((digest (hash-object *song-about-stuff*))
(verifier (readable-verifier digest))
(bad-digest (hash-text (substitute #\o #\e *song-about-stuff*)))
(bad-digest (hash-object
(make-instance 'song
:lyrics (substitute #\o #\e
(song-lyrics *song-about-stuff*)))))
(bad-verifier (readable-verifier bad-digest)))
(is string/= verifier bad-verifier
"The mutated string and the original string created the same verifier")))
(defclass random-object ()
()
(:metaclass netfarm-class))
(define-test sign-object
:parent key-tests
(let* ((object (class->schema (find-class 'schema)))
(keys (generate-keys))
(public-key (keys-from-public (keys-signature-public keys) nil))
(let* ((object (make-instance 'song
:lyrics (song-lyrics *song-about-stuff*)))
(keys (generate-keys))
(user (keys->object keys)))
(add-signature object keys user)
(true (verify-object-signatures object)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment