{En,de}coder refactoring

Removes the pointless reference-pair object in favor of passing reference-key
pairs as a 64-byte octet-vector.

Also removes :hash-output.

3 files changed, 74 insertions, 119 deletions

diff --git a/src/backend.lisp b/src/backend.lisp
index 5568132..8d1405b 100644
--- a/src/backend.lisp
+++ b/src/backend.lisp
@@ -41,7 +41,7 @@ protect the data from attacks against convergent encryption."))
   (with-slots (fetch-function) backend
     (eris-decode read-capability fetch-function)))
 
-(defmethod store-data (input (backend encoding-backend) &key (secret null-secret) (hash-output nil) &allow-other-keys)
+(defmethod store-data (input (backend encoding-backend) &key (secret null-secret) &allow-other-keys)
   (declare (type octet-vector secret))
   (with-slots (output-function) backend
     (eris-encode input ;; According to ERIS spec recommendation.
@@ -52,5 +52,4 @@ protect the data from attacks against convergent encryption."))
                      32kib
                      1kib)
                  output-function
-                 :hash-output hash-output
                  :secret secret)))
diff --git a/src/eris-decode.lisp b/src/eris-decode.lisp
index b3629a2..df64913 100644
--- a/src/eris-decode.lisp
+++ b/src/eris-decode.lisp
@@ -20,19 +20,19 @@
 fetched blocks are what they claim to be. Only disable this if the blocks are
 fetched from a trusted party.")
 
-(defmacro hash-check (block hash)
+(defmacro hash-check (block rk &optional key)
   `(when *decode-safety-checks*
      (let ((hash (ironclad:digest-sequence :blake2/256 ,block)))
-       (unless (equalp ,hash hash)
-         (error 'hash-mismatch :reference ,hash :hash hash )))))
+       (unless (octet-vector= ,rk hash ,(if key :start1 :end1) 32)
+         (error 'hash-mismatch :reference ,rk :hash hash )))))
 
+;; This is quite pointless.
 (defmacro execute-fetch-function (fetch-function &rest args)
-  `(restart-case (funcall ,fetch-function ,@args)
+  `(restart-case (funcall ,fetch-function (subseq ,@args 0 32))
      (use-value (value) value)))
 
 (defun key-reference-null? (kr)
-  (and (equalp (reference kr) null-secret)
-       (equalp (key kr) null-secret)))
+  (octet-vector= kr #.(make-array 64 :element-type 'octet :initial-element 0)))
 
 (defclass high-block ()
   ((data :initarg :data :accessor data :type octet-vector)
@@ -89,15 +89,16 @@ represents."
   ;; The standard states that:
   ;; "If 64 bytes of zeroes are encountered the rest of the node MUST be checked to be all zeroes"
   ;; This procedure processes the block from right to left so it's not really applicable here
+  ;; A maliciously crafted ERIS block which contains 0 ... kr ... 0 ... kr could fool this.
 
   (flet ((find-last-reference (block)
            (loop for i from (1- (/ block-size 64)) downto 0
-                 for key-reference = (octets-to-reference-pair block (* 64 i))
+                 for key-reference = (subseq block (* 64 i) (+ 64 (* 64 i)))
                  unless (key-reference-null? key-reference)
                    return (values key-reference i))))
     (loop with position = 0
           for local-level = level then (1- local-level)
-          for block = root then (funcall get-block (reference key-reference) (key key-reference) (make-nonce local-level))
+          for block = root then (funcall get-block key-reference (make-nonce local-level))
           for (key-reference block-pos) = (multiple-value-list (find-last-reference block))
           if (eql 0 local-level)
             do (setf position (+ position (unpad-block block)))
@@ -126,11 +127,11 @@ it is necessary and sets the position in the buffer to 0."
                           (type fixnum next-pos))
                  (when (zerop next-pos) ;; if 1+ mod blocks results in a zero, then update the next block
                    (process-block (cdr blocks) mod (1+ level)))
-                 (let ((kr (octets-to-reference-pair
-                            (data (cadr blocks))
-                            (the fixnum (* next-pos 64)))))
+                 (let ((kr (let ((a (make-octet-vector 64)))
+                             (replace a (data (cadr blocks)) :start2 (the fixnum (* next-pos 64)))
+                             a)))
                    (setf (data current)
-                         (funcall get-block (reference kr) (key kr) (svref nonce-array level)))))))
+                         (funcall get-block kr (svref nonce-array level)))))))
       (process-block (reverse root) (/ block-size 64) 0) ;; process the blocks from level 0 up
       ;; setf the buffer data to the level 0 block
       (setf (data buffer) (data (car (last root)))
@@ -184,12 +185,12 @@ it is necessary and sets the position in the buffer to 0."
             do (error 'eof :eof new-pos :position (pos stream))
           until (eq nil (cdr blocks))
           when (or update-tree (not (eq block-position (pos lower-block))))
-            do (let ((rk (octets-to-reference-pair
-                          (data (car blocks))
-                          (* 64 block-position))))
+            do (let ((rk (let ((a (make-octet-vector 64)))
+                           (replace a (data (car blocks)) :start2 (* 64 block-position))
+                           a)))
                  (when (key-reference-null? rk)
                    (error 'eof :eof new-pos :position (pos stream)))
-                 (setf (data lower-block) (funcall get-block (reference rk) (key rk) (svref nonce-array (1- level)))
+                 (setf (data lower-block) (funcall get-block rk (svref nonce-array (1- level)))
                        (pos lower-block) block-position
                        update-tree t))
           finally (when update-tree ;; if anything changed
@@ -232,22 +233,22 @@ FETCH-FUNCTION is not handled."
                           (cached-lambda (:cache-class 'lru-cache 
                                                        :capacity cache-capacity
                                                        :table (make-hash-table :size (1+ cache-capacity) :test #'equalp))
-                                         (reference key nonce)
-                                         (declare (type octet-vector reference key nonce))
-                                         (let ((block (execute-fetch-function fetch-function reference)))
+                                         (rk nonce)
+                                         (declare (type octet-vector rk nonce))
+                                         (let ((block (execute-fetch-function fetch-function rk)))
                                            (declare (type octet-vector block))
-                                           (hash-check block reference)
-                                           (decrypt-block block key nonce)))
-                        (lambda (reference key nonce)
-                          (declare (type octet-vector reference key nonce)) 
-                          (let ((block (execute-fetch-function fetch-function reference)))
+                                           (hash-check block rk)
+                                           (decrypt-block block rk nonce)))
+                        (lambda (rk nonce)
+                          (declare (type octet-vector rk nonce)) 
+                          (let ((block (execute-fetch-function fetch-function rk)))
                             (declare (type octet-vector block))
-                            (hash-check block reference)
-                            (decrypt-block block key nonce)))))
-           (root (funcall get-block (reference root-reference-pair) (key root-reference-pair) (make-nonce level))))
+                            (hash-check block rk)
+                            (decrypt-block block rk nonce)))))
+           (root (funcall get-block root-reference-pair  (make-nonce level))))
       ;; "Implementations MUST verify the key appearing in the read capability
       ;; if level of encoded content is larger than 0."
-      (when (> level 0) (hash-check root (key root-reference-pair)))
+      (when (> level 0) (hash-check root root-reference-pair :key))
       (case level
         ;; Treat level 0 blocks specially, since those are just a single buffer.
         (0 (let ((stream
@@ -256,9 +257,8 @@ FETCH-FUNCTION is not handled."
                                                          :data (make-array block-size :element-type 'octet)
                                                          :pos 0
                                                          :eof -1)
-                                  :get-block (lambda (reference key)
-                                               (declare (ignore key))
-                                               (error 'missing-block :reference reference))
+                                  :get-block (lambda (rk)
+                                               (error 'missing-block :reference rk))
                                   :block-size block-size
                                   :root nil
                                   :eof (find-eof root get-block block-size level)
diff --git a/src/eris.lisp b/src/eris.lisp
index 8f836f8..7efdc73 100644
--- a/src/eris.lisp
+++ b/src/eris.lisp
@@ -21,69 +21,44 @@
 (defconstant 32kib 32768)
 (defconstant 1kib 1024)
 
-(defclass reference-pair ()
-  ((reference :initarg :reference :accessor reference :type (octet-vector 32))
-   (key :initarg :key :accessor key :type (octet-vector 32))))
-
 (define-constant null-secret (make-array 32 :element-type 'octet :initial-element 0)
   :test #'equalp
   :documentation
   "32-byte null vector.")
 
-(defun reference-pair-to-octets (pair buf &optional (start 0))
-  "Convert a reference-pair object PAIR into the standard binary representation by
-filling the buffer BUF from the START keyword argument. "
-  (declare (type vector buf))
-  (replace buf (reference pair) :start1 start)
-    (replace buf (key pair) :start1 (+ 32 start)))
-
-(defun octets-to-reference-pair (octets &optional (start 0))
-  "Convert the standard reference-pair binary representation into a reference-pair
-object, using the bytes from the OCTETS vector from at START."
-  (declare (type vector octets))
-  (make-instance 'reference-pair :key (subseq octets (+ 32 start) (+ 64 start))
-                                 :reference (subseq octets start (+ 32 start))))
-
-
-(defun compute-reference (block)
-  (declare (type octet-vector block))
-  (let ((reference (make-array 32 :element-type 'octet)))
-    (ironclad:digest-sequence :blake2/256 block :digest reference)
-    reference))
-
 (defun make-nonce (level)
   (let ((nonce (make-array 12 :element-type 'octet :initial-element 0)))
     (setf (aref nonce 0) level)
     nonce))
 
-(defun encrypt-block (input secret reference)
-  (declare (type octet-vector input secret reference))
+
+(defun encrypt-block (input secret)
+  (declare (type octet-vector input secret))
   (let ((mac (ironclad:make-mac :blake2-mac secret :digest-length 32))
-        (key (make-array 32 :element-type 'octet)))
+        (rk (make-array 64 :element-type 'octet))) ;; reference-key pair
     (ironclad:update-mac mac input)
-    (ironclad:produce-mac mac :digest key)
-    ;; NOT the IETF chacha. Need to fix this by patching ironclad. Maybe.
-    (ironclad:encrypt-in-place (ironclad:make-cipher :chacha :mode :stream :key key
+    (ironclad:produce-mac mac :digest rk :digest-start 32) ;; get key
+    (ironclad:encrypt-in-place (ironclad:make-cipher :chacha :mode :stream :key (subseq rk 32 64)
                                                              :initialization-vector null-secret)
-                               input)
-    (ironclad:digest-sequence :blake2/256 input :digest reference)
-    (make-instance 'reference-pair :key key :reference reference)))
-
-(defun encrypt-internal-block (input reference nonce)
-  (declare (type octet-vector input reference))
-  (let ((key (make-array 32 :element-type 'octet)))
-    (ironclad:digest-sequence :blake2/256 input :digest key)
-    ;; NOT the IETF chacha. Need to fix this by patching ironclad. Maybe.
-    (ironclad:encrypt-in-place (ironclad:make-cipher :chacha :mode :stream :key key
+                               input) ;; encrypt block
+    (ironclad:digest-sequence :blake2/256 input :digest rk) ;; get reference
+    rk))
+
+
+(defun encrypt-internal-block (input nonce)
+  (declare (type octet-vector input))
+  (let ((rk (make-array 64 :element-type 'octet))) ;; reference-key pair
+    (ironclad:digest-sequence :blake2/256 input :digest rk :digest-start 32);; get key
+    (ironclad:encrypt-in-place (ironclad:make-cipher :chacha :mode :stream :key (subseq rk 32 64)
                                                              :initialization-vector nonce)
-                               input)
-    (ironclad:digest-sequence :blake2/256 input :digest reference)
-    (make-instance 'reference-pair :key key :reference reference)))
+                               input) ;; encrypt block
+    (ironclad:digest-sequence :blake2/256 input :digest rk) ;; get reference
+    rk))
 
-(defun decrypt-block (input key &optional (nonce null-secret))
-  (declare (type octet-vector input key nonce))
+(defun decrypt-block (input rk &optional (nonce null-secret))
+  (declare (type octet-vector input rk nonce))
   (ironclad:decrypt-in-place
-   (ironclad:make-cipher :chacha :mode :stream :key key :initialization-vector nonce)
+   (ironclad:make-cipher :chacha :mode :stream :key (subseq rk 32 64) :initialization-vector nonce)
    input)
   input)
 
@@ -107,7 +82,8 @@ a (simple-array (unsigned-byte 8)) object."
       (1024 (setf (aref cap 0) #x0a))
       (32768 (setf (aref cap 0) #x0f)))
     (setf (aref cap 1) (level read-capability))
-    (reference-pair-to-octets (reference-pair read-capability) cap 2)))
+    (replace cap (reference-pair read-capability) :start1 2)
+    cap))
 
 (-> octets-to-read-capability ((octet-vector 66)) (values read-capability &optional))
 (defun octets-to-read-capability (octets)
@@ -126,7 +102,9 @@ versioning bytes are not supported by eris-cl."
     (setf (level capability)
           (aref octets 1))
     (setf (reference-pair capability)
-          (octets-to-reference-pair octets 2))
+          (let ((kr (make-array 64 :element-type 'octet)))
+            (replace kr octets :start2 2)
+            kr)) ;; TODO CHECK CORRECTNESS
     capability))
 
 (-> read-capability-to-urn (read-capability) string)
@@ -165,34 +143,17 @@ versioning bytes are not supported by eris-cl."
     (setf (aref padded-input (length input)) #x80)
     padded-input))
 
-(defvar *output-hashmap* nil)
-
 (defmacro output-block (ref-vector)
-  `(let ((reference (compute-reference block)))
-     (if hash-output
-         (if (gethash reference *output-hashmap*)
-             block
-             (let ((rk (encrypt-block block secret reference)))
-               (vector-push-extend rk ,ref-vector)
-               (setf (gethash reference *output-hashmap*) t)
-               (funcall output-function block (reference rk))))
-         (let ((rk (encrypt-block block secret reference)))
-           (vector-push-extend rk ,ref-vector)
-           (funcall output-function block (reference rk))))))
+  `(let ((rk (encrypt-block block secret)))
+     (vector-push-extend rk ,ref-vector)
+     (funcall output-function block (subseq rk 0 32))))
 
 (defmacro output-internal-block (ref-vector nonce)
-  `(let ((reference (compute-reference block)))
-     (if hash-output
-         (unless (gethash reference *output-hashmap*)
-           (let ((rk (encrypt-internal-block block reference ,nonce)))
-             (vector-push-extend rk ,ref-vector)
-             (setf (gethash reference *output-hashmap*) t)
-             (funcall output-function block (reference rk))))
-         (let ((rk (encrypt-internal-block block reference ,nonce)))
-           (vector-push-extend rk ,ref-vector)
-           (funcall output-function block (reference rk))))))
-
-(defgeneric eris-encode (input block-size output-function &key secret hash-output)
+  `(let ((rk (encrypt-internal-block block ,nonce)))
+     (vector-push-extend rk ,ref-vector)
+     (funcall output-function block (subseq rk 0 32))))
+
+(defgeneric eris-encode (input block-size output-function &key secret)
   (:documentation
    "Encode an INPUT into BLOCK-SIZE (32kib or 1kib) blocks, that are output using
 the function OUTPUT-FUNCTION. This function wil be called with two arguments: an
@@ -201,12 +162,9 @@ a (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) of equal size to the one given, which will be
 destructively modified. Returns a read-capability object.
 
 An optional 32-byte secret can be passed for additional encryption using the
-SECRET keyword argument.
-
-The HASH-OUTPUT keyword argument controls whether a hash-table is used to
-guarantee that a reference is only output once."))
+SECRET keyword argument."))
 
-(defmethod eris-encode ((input vector) block-size output-function &key (secret null-secret) (hash-output t))
+(defmethod eris-encode ((input vector) block-size output-function &key (secret null-secret))
   (declare (type block-size block-size)
            (type function output-function)
            (type (octet-vector 32) secret))
@@ -214,7 +172,6 @@ guarantee that a reference is only output once."))
   (setf input (pad input block-size)) 
   
   (let ((reference-vector (make-array 16 :adjustable t :fill-pointer 0))
-        (*output-hashmap* (if hash-output (make-hash-table :test #'equalp) nil))
         (block (make-array block-size :element-type 'octet :initial-element 0)))
     (declare (type octet-vector block))
     (loop for i = 0 then (incf i)
@@ -224,15 +181,14 @@ guarantee that a reference is only output once."))
                     (fill block 0)))
     ;; always bzero the buffer; this is unoptimal (it only needs to be zeroed out to eliminate trailing junk)
     ;; TODO: consider removing this entire function and replacing it with an octet stream
-    (eris-create-tree reference-vector block-size output-function :hash-output hash-output)))
+    (eris-create-tree reference-vector block-size output-function)))
 
-(defmethod eris-encode ((input stream) block-size output-function &key (secret null-secret) hash-output)
+(defmethod eris-encode ((input stream) block-size output-function &key (secret null-secret))
   "This method does not handle any IO related conditions."
   (declare (type block-size block-size)
            (type function output-function)
            (type (octet-vector 32) secret))
   (let ((reference-vector (make-array 16 :adjustable t :fill-pointer 0))
-        (*output-hashmap* (if hash-output (make-hash-table :test #'equalp) nil))
         (block (make-array block-size :element-type 'octet :initial-element 0)))
     (declare (type octet-vector block))
     (loop for bytes-read = (read-sequence block input)
@@ -242,9 +198,9 @@ guarantee that a reference is only output once."))
                       (fill block 0 :start (1+ bytes-read))) ;; bzero the buffer here to eliminate trailing junk
           do (progn (setf block (output-block reference-vector)))
           until (< bytes-read block-size))
-    (eris-create-tree reference-vector block-size output-function :hash-output hash-output)))
+    (eris-create-tree reference-vector block-size output-function)))
 
-(defun eris-create-tree (reference-vector block-size output-function &key hash-output)
+(defun eris-create-tree (reference-vector block-size output-function)
   (declare (type block-size block-size)
            (type function output-function))
   (loop with block-keys = (/ block-size 64)
@@ -266,7 +222,7 @@ guarantee that a reference is only output once."))
                      do (progn (setf block (output-internal-block reference-vector-l nonce))
                                (setf i 0)
                                (fill block 0))
-                   do (progn (reference-pair-to-octets rk block (* 64 i))
+                   do (progn (replace block rk :start1 (* 64 i))
                              (incf i))
                    finally (unless (zerop i)
                              ;; If i is zero, then the amount of blocks is just