diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/common.lisp | 6 | ||||
| -rw-r--r-- | src/eris-decode.lisp | 16 | ||||
| -rw-r--r-- | src/eris.lisp | 64 | ||||
| -rw-r--r-- | src/package.lisp | 2 | ||||
| -rw-r--r-- | src/parallel-decoder.lisp | 6 |
5 files changed, 42 insertions, 52 deletions
diff --git a/src/common.lisp b/src/common.lisp index 3f078ff..23cafec 100644 --- a/src/common.lisp +++ b/src/common.lisp @@ -1,10 +1,4 @@ (in-package :eris) -(defun subseq-shared (array start) - (make-array (- (length array) start) - :element-type (array-element-type array) - :displaced-to array - :displaced-index-offset start)) - (defmacro make-octets (len &key (element 0)) `(make-array ,len :element-type '(unsigned-byte 8) :initial-element ,element)) diff --git a/src/eris-decode.lisp b/src/eris-decode.lisp index 508dc67..afbb818 100644 --- a/src/eris-decode.lisp +++ b/src/eris-decode.lisp @@ -35,13 +35,13 @@ fetched from a trusted party.") (equalp (key kr) null-secret))) (defclass high-block () - ((data :initarg :data :accessor data :type (simple-array (unsigned-byte 8))) + ((data :initarg :data :accessor data :type octet-vector) (position :initarg :position :accessor pos :type integer :documentation "Position relative to the higher block.") - (level :initarg :level :accessor level :type (unsigned-byte 8)))) + (level :initarg :level :accessor level :type octet))) (defclass buffer () - ((data :initarg :data :accessor data :type (simple-array (unsigned-byte 8))) + ((data :initarg :data :accessor data :type octet-vector) (pos :initarg :pos :accessor pos :type fixnum) (eof :initarg :eof :accessor eof :type fixnum :documentation "Either the position of the EOF in the buffer, or the length of the buffer."))) @@ -66,7 +66,7 @@ fetched from a trusted party.") (let ((padding (position #x80 block :from-end t))) (unless padding (error 'padding-error)) - (unless (loop for i across (subseq-shared block (1+ padding)) + (unless (loop for i across (nsubseq block (1+ padding)) always (zerop i)) (error 'padding-error)) padding)) @@ -144,7 +144,7 @@ it is necessary and sets the position in the buffer to 0." #+sbcl (sb-ext:muffle-conditions sb-ext:compiler-note)) (with-slots (data pos eof) buf (declare (type (integer 0 32768) pos eof) - (type (simple-array (unsigned-byte 8)) data)) + (type octet-vector data)) (let ((buffer-bytes (- eof pos)) (seq-bytes (- end start))) (declare (dynamic-extent buffer-bytes seq-bytes) @@ -202,7 +202,7 @@ it is necessary and sets the position in the buffer to 0." (defun initialize-high-blocks (level) (case level (-1 nil) - (t (cons (make-instance 'high-block :level level :position -1 :data (make-array 0 :element-type '(unsigned-byte 8))) + (t (cons (make-instance 'high-block :level level :position -1 :data (make-array 0 :element-type 'octet)) (initialize-high-blocks (1- level)))))) @@ -240,7 +240,7 @@ cache." (0 (let ((stream (make-instance 'eris-decode-stream :buffer (make-instance 'buffer - :data (make-array block-size :element-type '(unsigned-byte 8)) + :data (make-array block-size :element-type 'octet) :pos 0 :eof -1) :get-block (lambda (reference key) @@ -255,7 +255,7 @@ cache." stream)) (t (make-instance 'eris-decode-stream :buffer (make-instance 'buffer - :data (make-array block-size :element-type '(unsigned-byte 8)) + :data (make-array block-size :element-type 'octet) :pos -1 :eof block-size) :get-block get-block diff --git a/src/eris.lisp b/src/eris.lisp index 0509ecb..a585e46 100644 --- a/src/eris.lisp +++ b/src/eris.lisp @@ -21,13 +21,11 @@ (defconstant 32kib 32768) (defconstant 1kib 1024) -(eval-when - (:execute :load-toplevel :compile-toplevel) - (defclass reference-pair () - ((reference :initarg :reference :accessor reference :type (simple-array (unsigned-byte 8) 32)) - (key :initarg :key :accessor key :type (simple-array (unsigned-byte 8) 32))))) +(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 '(unsigned-byte 8) :initial-element 0) +(define-constant null-secret (make-array 32 :element-type 'octet :initial-element 0) :test #'equalp :documentation "32-byte null vector.") @@ -48,20 +46,20 @@ object, using the bytes from the OCTETS vector from at START." (defun compute-reference (block) - (declare (type (simple-array (unsigned-byte 8)) block)) - (let ((reference (make-array 32 :element-type '(unsigned-byte 8)))) + (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 '(unsigned-byte 8) :initial-element 0))) + (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 (simple-array (unsigned-byte 8)) input secret reference)) + (declare (type octet-vector input secret reference)) (let ((mac (ironclad:make-mac :blake2-mac secret :digest-length 32)) - (key (make-array 32 :element-type '(unsigned-byte 8)))) + (key (make-array 32 :element-type 'octet))) (ironclad:update-mac mac input) (ironclad:produce-mac mac :digest key) ;; NOT the IETF chacha. Need to fix this by patching ironclad. Maybe. @@ -72,8 +70,8 @@ object, using the bytes from the OCTETS vector from at START." (make-instance 'reference-pair :key key :reference reference))) (defun encrypt-internal-block (input reference nonce) - (declare (type (simple-array (unsigned-byte 8)) input secret reference)) - (let ((key (make-array 32 :element-type '(unsigned-byte 8)))) + (declare (type octet-vector input secret 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 @@ -94,33 +92,27 @@ object, using the bytes from the OCTETS vector from at START." :accessor block-size :type block-size :documentation "A value of either 1024 or 1kb blocks.") - (level :initarg :level :accessor level :type (unsigned-byte 8)) + (level :initarg :level :accessor level :type octet) (root-reference-pair :initarg :reference-pair :accessor reference-pair)) (:documentation "Class representing the concept of an ERIS read capability.")) -(declaim - (ftype (function (read-capability) (values (simple-array (unsigned-byte 8) (66)) &optional)) read-capability-to-octets) - (ftype (function ((simple-array (unsigned-byte 8) (66))) read-capability) octets-to-read-capability) - (ftype (function (read-capability) string) read-capability-to-urn) - (ftype (function (string) read-capability) urn-to-read-capability) - (ftype (function ((simple-array (unsigned-byte 8) (32))) string) reference-to-block-urn) - (ftype (function (string) (values (simple-array (unsigned-byte 8) (32)) &optional)) block-urn-to-reference)) - +(-> read-capability-to-octets (read-capability) (octet-vector 66)) (defun read-capability-to-octets (read-capability) "Convert a read-capability object to its standard binary representation. Returns a (simple-array (unsigned-byte 8)) object." (declare (type read-capability read-capability)) - (let ((cap (make-array 66 :element-type '(unsigned-byte 8)))) + (let ((cap (make-array 66 :element-type 'octet))) (case (block-size read-capability) ;; This depends on the version of the standard (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))) +(-> octets-to-read-capability ((octet-vector 66)) read-capability) (defun octets-to-read-capability (octets) "Convert the standard binary representation for ERIS read capabilities into a read-capability object. Returns the read-capability." - (declare (type (simple-array (unsigned-byte 8) (66)) octets)) + (declare (type (octet-vector 66) octets)) (let ((capability (make-instance 'read-capability))) (setf (block-size capability) (case (aref octets 0) @@ -133,6 +125,7 @@ read-capability object. Returns the read-capability." (octets-to-reference-pair octets 2)) capability)) +(-> read-capability-to-urn (read-capability) string) (defun read-capability-to-urn (capability) "Convert a read-capability object into a URN string." (declare (type read-capability capability)) @@ -140,23 +133,26 @@ read-capability object. Returns the read-capability." "urn:eris:" (bytes-to-base32-unpadded (read-capability-to-octets capability)))) +(-> urn-to-read-capability (string) read-capability) (defun urn-to-read-capability (urn) "Convert a urn:eris URN string into a read-capability object." (declare (type string urn)) (octets-to-read-capability (base32-to-bytes-unpadded (subseq urn (1+ (position #\: urn :from-end t)))))) +(-> reference-to-block-urn ((octet-vector 32)) string) (defun reference-to-block-urn (reference) "Convert a 32-byte block reference into a URN string." - (declare (type (simple-array (unsigned-byte 8) (32)) reference)) + (declare (type (octet-vector 32) reference)) (concatenate 'string "urn:blake2b:" (bytes-to-base32-unpadded reference))) +(-> block-urn-to-reference (string) (octet-vector 32)) (defun block-urn-to-reference (urn) "Convert a urn:blake2b URN string into a 32-byte block reference vector." (declare (type string urn)) (base32-to-bytes-unpadded (subseq urn (1+ (position #\: urn :from-end t))))) (defun pad (input block-size) - (declare (type (simple-array (unsigned-byte 8)) input) + (declare (type octet-vector input) (type integer block-size)) (let* ((pad-size (- block-size (mod (length input) block-size))) (padded-input (adjust-array input (+ pad-size (length input)) :initial-element 0))) @@ -205,16 +201,16 @@ SECRET keyword argument. The HASH-OUTPUT keyword argument controls whether a hash-table is used to guarantee that a reference is only output once.")) -(defmethod eris-encode ((input simple-array) block-size output-function &key (secret null-secret) (hash-output t)) +(defmethod eris-encode ((input vector) block-size output-function &key (secret null-secret) (hash-output t)) (declare (type block-size block-size) (type function output-function) - (type (simple-array (unsigned-byte 8) (32)) secret)) + (type (octet-vector 32) secret)) (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))) - (loop for block = (make-array block-size :element-type '(unsigned-byte 8) :initial-element 0) + (loop for block = (make-array block-size :element-type 'octet :initial-element 0) for i = 0 then (incf i) until (= (length input) (* i block-size)) do (progn @@ -225,10 +221,10 @@ guarantee that a reference is only output once.")) (defmethod eris-encode ((input stream) block-size output-function &key (secret null-secret) hash-output) (declare (type block-size block-size) (type function output-function) - (type (simple-array (unsigned-byte 8) (32)) secret)) + (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))) - (loop for block = (make-array block-size :element-type '(unsigned-byte 8) :initial-element 0) + (loop for block = (make-array block-size :element-type 'octet :initial-element 0) for bytes-read = (read-sequence block input) for i = 0 then (incf i) if (< bytes-read block-size) @@ -240,7 +236,7 @@ guarantee that a reference is only output once.")) (defun eris-create-tree (reference-vector block-size output-function &key hash-output) (declare (type block-size block-size) (type function output-function) - (type (simple-array (unsigned-byte 8) (32)) secret)) + (type (octet-vector 32) secret)) (loop with block-keys = (/ block-size 64) with level = 0 with reference-vector-l = (make-array 16 :adjustable t :fill-pointer 0) @@ -253,12 +249,12 @@ guarantee that a reference is only output once.")) do (progn (incf level) ;; loop across the key-reference vector and build the tree - (loop with block = (make-array block-size :element-type '(unsigned-byte 8) :initial-element 0) + (loop with block = (make-array block-size :element-type 'octet :initial-element 0) for rk across reference-vector with i = 0 when (eql i block-keys) do (output-internal-block reference-vector-l nonce - (setf block (make-array block-size :element-type '(unsigned-byte 8) :initial-element 0) + (setf block (make-array block-size :element-type 'octet :initial-element 0) i 0)) do (progn (reference-pair-to-octets rk block (* 64 i)) (incf i)) diff --git a/src/package.lisp b/src/package.lisp index 31c4c56..d386990 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -15,7 +15,7 @@ (defpackage eris - (:use common-lisp trivial-gray-streams alexandria function-cache) + (:use common-lisp trivial-gray-streams alexandria serapeum function-cache) (:export #:eris-encode #:eris-decode diff --git a/src/parallel-decoder.lisp b/src/parallel-decoder.lisp index 8b4f568..7d35157 100644 --- a/src/parallel-decoder.lisp +++ b/src/parallel-decoder.lisp @@ -31,7 +31,7 @@ (setf pos (+ pos base 1)))))))) (defun mem-write-vector (vector ptr &optional (offset 0) (count (length vector))) - (declare (type (simple-array (unsigned-byte 8)) vector) + (declare (type octet-vector vector) (type fixnum offset count)) (declare (optimize ;; (speed 3) (safety 0) (space 0) (debug 3))) @@ -44,7 +44,7 @@ (defun map-over-key-references (function block) (loop for i from 0 to (1- (/ (length block) 64)) - for key-ref = (octets-to-reference-pair (subseq-shared block (* 64 i))) + for key-ref = (octets-to-reference-pair (nsubseq block (* 64 i))) until (key-reference-null? key-ref) do (funcall function key-ref i))) @@ -105,7 +105,7 @@ locally binding a special variable to some value." (write-sequence root file :end (unpad-block root)))) (t (let* ((initial-list (loop for i from 0 to (/ block-size 64) - for key-ref = (octets-to-reference-pair (subseq-shared root (* 64 i))) + for key-ref = (octets-to-reference-pair (nsubseq root (* 64 i))) until (key-reference-null? key-ref) collect key-ref)) (list (split-list-equally |