Initial commit.

7 files changed, 879 insertions, 0 deletions

diff --git a/src/base32.lisp b/src/base32.lisp
new file mode 100644
index 0000000..0ed4624
--- /dev/null
+++ b/src/base32.lisp
@@ -0,0 +1,191 @@
+;; Copyright (c) 2011 Phil Hargett
+
+;; Permission is hereby granted, free of charge, to any person obtaining a copy
+;; of this software and associated documentation files (the "Software"), to deal
+;; in the Software without restriction, including without limitation the rights
+;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+;; copies of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+;; THE SOFTWARE.
+
+;;
+;; Base32 encoding - http://tools.ietf.org/html/rfc4648
+;;
+
+;; Adapted for eris-cl
+
+(in-package :eris)
+(define-constant +base32-alphabet+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567" :test #'equalp)
+
+(defun encode-word (a-word)
+  "Return the digit in the base32 alphabet corresponding to a word"
+  (char +base32-alphabet+ a-word))
+
+(defun decode-word (a-digit)
+  "Return the word encoded as a digit in the base32 alphabet"
+  (let ((code (char-code a-digit)))
+    (or (and (char<= #\a a-digit #\z)
+             (- code (char-code #\a)))
+        (and (char<= #\2 a-digit #\7)
+             (+ 26 (- code (char-code #\2))))
+        ;; upper case
+        (and (char<= #\A a-digit #\Z)
+             (- code (char-code #\A))))))
+
+(defun read-word (some-bytes word-index)
+  "Return the word (a 5-bit integer) found in some-bytes located at word-index"
+  (let* ((bytes-length (length some-bytes))
+	 ;; don't be confused : bit indexes aren't really pointing to
+	 ;; the bit as understood by Lisp--they are more virtual in nature,
+	 ;; which assumes that bit 0 is the MSB rather than bit 8 being MSB
+         (start-bit-index (* 5 word-index) )
+         (end-bit-index (+ 4 start-bit-index) )
+         (part1-byte-index (floor start-bit-index 8)) 
+         (part2-byte-index (floor end-bit-index 8))
+         (part1-size (min 5 (- 8 (mod start-bit-index 8))))
+         (part2-size (- 5 part1-size))
+	 ;; here we translate the bit indexes so that the MSB is bit 8
+	 ;; and the LSB is bit 0
+         (source-part1 (byte part1-size 
+                             (- (- 8 (mod start-bit-index 8)) part1-size)
+                             )
+	   )
+         (source-part2 (byte part2-size 
+                             (- (- 8 (mod end-bit-index 8)) 1) )
+	   )
+	 ;; becomes the upper bits in value
+         (dest-part1 (byte part1-size part2-size)) 
+	 ;; becomes the lower bits in value
+         (dest-part2 (byte part2-size 0)) 
+         (value 0))
+    
+    (setf (ldb dest-part1 value)
+          (ldb source-part1 (aref some-bytes part1-byte-index)))
+    (if (< part1-byte-index bytes-length)
+        (if (> part2-byte-index part1-byte-index)
+            (if (< part2-byte-index (length some-bytes))
+                (setf (ldb dest-part2 value)
+                      (ldb source-part2 (aref some-bytes part2-byte-index)))
+                (setf (ldb dest-part2 value) 0 )))
+        (setq value 0))
+    value))
+
+(defun write-word (some-bytes word-index word)
+  "Write the word into the bits located at word-index in some-bytes"
+  (let* ( 
+         (bytes-length (length some-bytes))
+         ;; don't be confused : bit indexes aren't really pointing to
+         ;; the bit as understood by Lisp--they are more virtual in nature,
+         ;; which assumes that bit 0 is the MSB rather than bit 8 being MSB
+         (start-bit-index (* 5 word-index) )
+         (end-bit-index (+ 4 start-bit-index) )
+         (part1-byte-index (floor start-bit-index 8)) 
+         (part2-byte-index (floor end-bit-index 8))
+         (part1-size (min 5 (- 8 (mod start-bit-index 8))))
+         (part2-size (- 5 part1-size))
+	 ;; here we translate the bit indexes so that the MSB is bit 8
+	 ;; and the LSB is bit 0
+         (dest-part1 (byte part1-size 
+                           (- (- 8 (mod start-bit-index 8)) part1-size)))
+         (dest-part2 (byte part2-size 
+                           (- (- 8 (mod end-bit-index 8)) 1) ))
+	 ;; becomes the upper bits in value
+         (source-part1 (byte part1-size part2-size)) 
+	 ;; becomes the lower bits in value
+         (source-part2 (byte part2-size 0))   
+         (part1-byte (aref some-bytes part1-byte-index))
+         (part2-byte (if (and (< part2-byte-index bytes-length)
+                              (> part2-size 0)) 
+                         (aref some-bytes part2-byte-index))))
+    (setf (ldb dest-part1 part1-byte)
+          (ldb source-part1 word))
+    (if part2-byte
+        (setf (ldb dest-part2 part2-byte)
+              (ldb source-part2 word)))    
+    (setf (aref some-bytes part1-byte-index) part1-byte)
+    (if part2-byte
+        (setf (aref some-bytes part2-byte-index) part2-byte))))
+
+(defun unpadded-base32-length (base32-string)
+  "Given a base32 string, compute the size of the raw base32 string,
+   without any = padding
+  "
+  (let* ((padded-length (length base32-string))
+         (unpadded-length padded-length))
+    (dotimes (i padded-length)
+        (if (eql #\= (aref base32-string (- padded-length i)))
+            (decf unpadded-length)
+            (return unpadded-length)))))
+
+(defun byte-length-from-base32 (base32-string)
+  "Given a base32 string, compute the number of bytes in the 
+   decoded data
+  "
+  (let* ((padded-length (length base32-string))
+         (unpadded-length padded-length)
+         (padding 0)
+         (block-count (ceiling padded-length 8)))
+    (if (<= padded-length 0)
+        0
+        (progn
+          (dotimes (i padded-length)
+            (if (eql #\= (aref base32-string (- padded-length i 1)))
+                (progn
+                  (decf unpadded-length)
+                  (incf padding))))
+          (- (* 5 block-count)
+             (ecase padding
+	       (0 0)
+	       (6 4)
+	       (4 3)
+	       (3 2)
+	       (1 1)))))))
+
+(defun base32-length-from-bytes (some-bytes)
+  "Given bytes of unencoded data, determine the length of the
+   corresponding base32-encoded string
+  "
+  (let* ((word-count (ceiling (* 8 (length some-bytes)) 5) )
+         (digit-count (* 8 (ceiling word-count 8))))
+    (values digit-count word-count)))
+
+(defun bytes-to-base32 (some-bytes)
+  "Return a base32 string encoding of the provided vector of bytes"
+  (let* ((word-count (ceiling (* 8 (length some-bytes)) 5) )
+         (digit-count (* 8 (ceiling word-count 8)))
+         (base32-string (make-string digit-count :initial-element #\=)))
+    (dotimes (i word-count)
+      (setf (aref base32-string i)
+            (encode-word (read-word some-bytes i))))
+    base32-string))
+
+(defun base32-to-bytes (base32-string)
+  "Return the bytes decoded from the supplied base32 string"
+  (let* ((byte-count (byte-length-from-base32 base32-string) )
+         (base32-bytes (make-array `(,byte-count) 
+                                   :element-type '(unsigned-byte 8) 
+                                   :initial-element 0)))
+    (dotimes (i (length base32-string))
+      (let ((word (decode-word (aref base32-string i))))
+        (if word
+            (write-word base32-bytes i word)
+            (return nil))))
+    base32-bytes))
+
+(defun base32-to-bytes-unpadded (base32-string)
+  (let ((padding (make-array (- 8 (mod (length base32-string) 8)) :element-type 'character :initial-element #\=)))
+    (base32-to-bytes (concatenate 'string base32-string padding))))
+
+(defun bytes-to-base32-unpadded (bytes)
+  (let ((string (bytes-to-base32 bytes)))
+    (subseq string 0 (position #\= string))))
diff --git a/src/cache.lisp b/src/cache.lisp
new file mode 100644
index 0000000..ad6a0fa
--- /dev/null
+++ b/src/cache.lisp
@@ -0,0 +1,45 @@
+;; This is a patch for function-cache, enabling a per-stream cache for
+;; eris-decode-stream.
+
+(in-package :function-cache)
+
+(defmacro cached-lambda (cache-list lambda-list &body body)
+  "Creates a cached lambda function with the cache-list
+   cache-list is a list (&rest CACHE-INIT-ARGS
+                           &key CACHE-CLASS TABLE TIMEOUT SHARED-RESULTS?)
+
+   TABLE - a shared cache-store to use, usually a hash-table, a function that returns
+     a hashtable, or a symbol whose value is a hash-table
+   TIMEOUT - how long entries in the cache should be considered valid for
+   CACHE-CLASS - controls what cache class will be instantiated (uses
+     default-cache-class if not provided)
+   SHARED-RESULTS? - do we expect that we are sharing cache space with other things
+     defaults to t if TABLE is provided
+   CACHE-INIT-ARGS - any other args that should be passed to the cache
+  "
+  (destructuring-bind (&rest cache-args
+                       &key table (shared-results? nil shared-result-input?)
+                         cache-class
+                       &allow-other-keys)
+      (ensure-list cache-list)
+    (declare (ignore cache-class)) ;; handled in default-cache-class
+    (remf cache-args :cache-class)
+    (remf cache-args :table)
+    (remf cache-args :shared-results?)
+    (when (and table (not shared-result-input?))  (setf shared-results? t))
+    (let* ((cache-class (default-cache-class (cons nil cache-list) lambda-list))
+           (call-list (%call-list-for-lambda-list lambda-list))
+           (cache (gensym)))
+      `(let ((,cache
+               (make-instance ',cache-class
+                              :body-fn (lambda ,lambda-list
+                                         ,@body)
+                              :name nil
+                              :lambda-list ',lambda-list
+                              :shared-results? ,shared-results?
+                              :cached-results ,table
+                              ,@cache-args)))
+         (lambda ,lambda-list
+           (cacher ,cache ,call-list))))))
+
+(export cached-lambda)
diff --git a/src/common.lisp b/src/common.lisp
new file mode 100644
index 0000000..3f078ff
--- /dev/null
+++ b/src/common.lisp
@@ -0,0 +1,10 @@
+(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/conditions.lisp b/src/conditions.lisp
new file mode 100644
index 0000000..5b57fbf
--- /dev/null
+++ b/src/conditions.lisp
@@ -0,0 +1,53 @@
+;; This file is part of eris-cl.
+;; Copyright (C) 2022 Piotr Szarmański
+
+;; eris-cl is free software: you can redistribute it and/or modify it under the
+;; terms of the GNU Lesser General Public License as published by the Free
+;; Software Foundation, either version 3 of the License, or (at your option) any
+;; later versqion.
+
+;; eris-cl is distributed in the hope that it will be useful, but WITHOUT ANY
+;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+;; A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License along with
+;; eris-cl. If not, see <https://www.gnu.org/licenses/>.
+
+(in-package :eris)
+
+(define-constant +eris-revision+ "0.3" :test #'equalp)
+
+(define-condition eris-condition () ())
+
+(define-condition missing-block (eris-condition error)
+  ((reference :initarg :reference :reader reference))
+  (:report (lambda (condition stream)
+             (format stream "Missing block: ~a" (reference condition)))))
+
+(define-condition padding-error (eris-condition error)
+  ()
+  (:report "Corrupted padding."))
+
+(define-condition version-mismatch (eris-condition error)
+  ()
+  (:report (lambda (condition stream)
+             (declare (ignore condition))
+             (format stream "Provided object has been encoded with a different version of the ERIS standard than ~a." +eris-revision+))))
+
+(define-condition eof (eris-condition error)
+  ((eof :initarg :eof :reader eof)
+   (pos :initarg :position :reader pos))
+  (:report (lambda (condition stream)
+             (with-slots (eof pos) condition
+               (format stream "End of file (~d) reached at ~d." eof pos)))))
+
+(define-condition hash-mismatch (eris-condition error)
+  ((reference :initarg :reference :reader reference)
+   (hash :initarg :hash :reader hash))
+  (:report (lambda (condition stream)
+             (format stream "The hash ~a does not match the reference ~a." (hash condition) (reference condition)))))
+
+(define-condition invalid-internal-block (eris-condition error)
+  ((reference :initarg :reference :reader reference))
+  (:report (lambda (condition stream)
+             (format stream "The internal block ~a is invalid." (reference condition)))))
diff --git a/src/eris-decode.lisp b/src/eris-decode.lisp
new file mode 100644
index 0000000..b7575ab
--- /dev/null
+++ b/src/eris-decode.lisp
@@ -0,0 +1,291 @@
+;; This file is part of eris-cl.
+;; Copyright (C) 2022 Piotr Szarmański
+
+;; eris-cl is free software: you can redistribute it and/or modify it under the
+;; terms of the GNU Lesser General Public License as published by the Free
+;; Software Foundation, either version 3 of the License, or (at your option) any
+;; later versqion.
+
+;; eris-cl is distributed in the hope that it will be useful, but WITHOUT ANY
+;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+;; A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License along with
+;; eris-cl. If not, see <https://www.gnu.org/licenses/>.
+
+(in-package :eris)
+
+(defvar *decode-safety-checks* t
+  "If set to nil, disable computationally expensive safety checks that ensure the
+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)
+  `(when *decode-safety-checks*
+     (let ((hash (ironclad:digest-sequence :blake2/256 ,block)))
+       (unless (equalp ,hash hash)
+         (error 'hash-mismatch :reference ,hash :hash hash )))))
+
+(defun key-reference-null? (kr)
+  (and (equalp (reference kr) null-secret)
+       (equalp (key kr) null-secret)))
+
+(defclass high-block ()
+  ((data :initarg :data :accessor data :type (simple-array (unsigned-byte 8)))
+   (position :initarg :position :accessor pos :type integer
+             :documentation "Position relative to the higher block.")
+   (level :initarg :level :accessor level :type (unsigned-byte 8))))
+
+(defclass buffer ()
+  ((data :initarg :data :accessor data :type (simple-array (unsigned-byte 8)))
+   (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.")))
+
+(defclass eris-decode-stream (fundamental-binary-input-stream)
+  ((position :initform 0 :accessor pos :initarg :position :type integer)
+   (get-block :accessor get-block :initarg :get-block :type function)
+   (block-size :accessor block-size :type block-size :initarg :block-size)
+   (root :accessor root :type high-block :initarg :root :documentation "A list of blocks, starting from the root to the level 1 block.")
+   (buffer :accessor buffer :initarg :buffer :type buffer)
+   (eof :accessor eof :initarg :eof :type integer)
+   (nonce-array :accessor nonce-array :initarg :nonce-array :type simple-array)))
+
+(defun initialize-nonce-array (level)
+  (let ((array (make-array (1+ level))))
+    (loop for i from 0 to level
+          do (setf (aref array i) (make-nonce i)))
+    array))
+
+(defun unpad-block (block)
+  (let ((padding (position #x80 block :from-end t)))
+    (unless padding
+      (error 'padding-error))
+    (unless (loop for i across (subseq-shared block (1+ padding))
+                  always (zerop i))
+      (error 'padding-error))
+    padding))
+
+(defun unpad-buffer (buffer)
+  (with-slots (eof data) buffer
+    (setf eof
+          (unpad-block data))))
+
+(defun ls (level block-size)
+  (declare ;; (type (unsigned-byte 8) level)
+           (type block-size block-size))
+  (ecase block-size
+    (1024 (expt 2 (+ 10 (* level 4))))
+    (32768 (expt 2 (+ 15 (* level 9))))))
+
+(defun find-eof (root get-block block-size level)
+  "Find the end of file in a given tree."
+  ;; 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
+
+  (flet ((find-last-reference (block)
+           (loop for i from (1- (/ block-size 64)) downto 0
+                 for key-reference = (octets-to-reference-pair (subseq-shared block (* 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 (key-reference block-pos) = (multiple-value-list (find-last-reference block))
+          if (eql 0 local-level)
+            do (setf position (+ position (unpad-block block)))
+            and return position
+          else
+            do (setf position (+ position (* block-pos (ls (1- local-level) block-size)))))))
+
+(defun advance-next-block (stream)
+  "Advance to the next block. This function is called by update-buffer."
+  (declare (optimize (speed 3) (debug 0))) 
+  (with-slots (buffer position eof block-size root get-block nonce-array) stream
+    (declare (type integer position eof)
+             (type block-size block-size)
+             #+sbcl (sb-ext:muffle-conditions sb-ext:compiler-note))
+    (labels ((process-block (blocks mod level) ;; A recursive function that 1+'s each block until the 
+               (declare (type fixnum mod))
+               (let* ((current (car blocks))
+                      (next-pos (setf (pos current)
+                                      (mod (the fixnum (1+ (the fixnum (pos current)))) mod))))
+                 (declare (type high-block current)
+                          (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
+                            (subseq-shared (data (cadr blocks))
+                                           (the fixnum (* next-pos 64))))))
+                   (setf (data current)
+                         (funcall get-block (reference kr) (key 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))))
+      ;; if the EOF block is reached, unpad it.
+      (when (= (- eof (mod eof block-size)) position)
+        (unpad-buffer buffer)))))
+
+(defun read-to-seq (sequence buf &key (start 0) (end (length sequence)) stream)
+  (declare (optimize (speed 3) (debug 0))
+           (type integer end start sum)
+           #+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))
+    (let ((buffer-bytes (- eof pos))
+          (seq-bytes (- end start)))
+      (declare (dynamic-extent buffer-bytes seq-bytes)
+               (type integer seq-bytes)
+               (type (integer 0 32768) buffer-bytes))
+      (cond
+        ((> buffer-bytes seq-bytes) ;; seq is smaller than buffer case
+         (replace sequence data :start1 start :end1 end :start2 pos)
+         (setf pos (+ pos seq-bytes)
+               (pos stream) (+ (pos stream) seq-bytes))
+         (+ start seq-bytes))
+        ((eql eof (length data)) ;; seq is larger or equal than buffer case
+         (replace sequence data :start1 start :end1 end :start2 pos)
+         (setf pos 0
+               (pos stream) (+ (pos stream) buffer-bytes))
+         (advance-next-block stream) 
+         (read-to-seq sequence buf :start (+ start buffer-bytes) :end end :stream stream))
+        (t ;; if there is an eof in the buffer
+         (replace sequence data :start1 start :end1 end :start2 pos :end2 eof)
+         (setf pos (+ pos buffer-bytes)
+               (pos stream) (+ (pos stream) buffer-bytes))
+         (+ start buffer-bytes))))))
+
+
+(defun reupdate-block (stream new-pos)
+  "Update the blocks of the stream according to new-pos. Used for random access and initialization."
+  (unless (root stream)
+    (error 'eof :eof new-pos :position (pos stream)))
+  (with-slots (block-size root get-block buffer nonce-array eof) stream
+    (loop with update-tree = nil
+          for blocks = root then (cdr blocks)
+          for level = (level (car blocks)) ;; then (decf level)
+          for position = new-pos then (mod position (ls (1- level) block-size)) ;; local position
+          for block-position = (floor (/ position (ls (1- level) block-size))) ;; the position of the block
+          for lower-block = (second blocks)
+          when (> block-position (/ block-size 64))
+            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
+                          (subseq-shared (data (car blocks))
+                                         (* 64 block-position)))))
+                 (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)))
+                       (pos lower-block) block-position
+                       update-tree t))
+          finally (when update-tree ;; if anything changed
+                    (setf (pos stream) new-pos
+                          (data buffer) (data (car (last root)))
+                          (pos buffer) (mod new-pos block-size))
+                    (if (= (- eof (mod eof block-size)) new-pos)
+                        (unpad-buffer buffer)
+                        (setf (eof buffer) block-size))))))
+
+(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)))
+             (initialize-high-blocks (1- level))))))
+
+
+
+(defun eris-decode (read-capability fetch-function &key (cache-capacity 2048))
+  "With a given fetch-function, return a stream that decodes the read-capability.
+
+Fetch-function must be a function with one argument, the reference octet, which
+returns a (simple-array (unsigned-byte 8)) containing the block. The block will
+be destructively modified, so you MUST provide a fresh array every time. If a
+hash-table is used, a (copy-seq) needs to be done on the return value of
+gethash. "
+  (with-slots (level block-size root-reference-pair) read-capability
+    (let* ((get-block (cached-lambda (:cache-class 'lru-cache 
+                                     :capacity cache-capacity
+                                     :table (make-hash-table :size (1+ cache-capacity) :test #'equalp))
+                         (reference key &optional nonce)
+                        (let* ((block (funcall fetch-function reference)))
+                          (hash-check block reference)
+                          (if block
+                              (decrypt-block block key nonce)
+                              (error 'missing-block :reference reference)))))
+           (root (funcall get-block (reference root-reference-pair) (key 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)))
+      (case level
+        ;; Treat level 0 blocks specially, since those are just a single buffer.
+        (0 (let ((stream
+                   (make-instance 'eris-decode-stream
+                                  :buffer (make-instance 'buffer
+                                                         :data (make-array block-size :element-type '(unsigned-byte 8))
+                                                         :pos 0
+                                                         :eof -1)
+                                  :get-block (lambda (reference key)
+                                               (declare (ignore key))
+                                               (error 'missing-block :reference reference))
+                                  :block-size block-size
+                                  :root nil
+                                  :eof (find-eof root get-block block-size level)
+                                  :nonce-array (initialize-nonce-array 0))))
+             (replace (data (buffer stream)) root)
+             (unpad-buffer (buffer stream))
+             stream))
+        (t (make-instance 'eris-decode-stream
+                          :buffer (make-instance 'buffer
+                                                 :data (make-array block-size :element-type '(unsigned-byte 8))
+                                                 :pos -1
+                                                 :eof block-size)
+                          :get-block get-block
+                          :block-size block-size
+                          :root (cons (make-instance 'high-block :level level
+                                                                 :data root
+                                                                 :position 0)
+                                      (initialize-high-blocks (1- level)))
+                          :eof (find-eof root get-block block-size level)
+                          :nonce-array (initialize-nonce-array level)))))))
+
+(defmethod stream-file-position ((stream eris-decode-stream) &optional (set-position nil))
+  "Provides the file position of the stream. If the optional second argument is
+set, try to move the stream to that position. It may signal an EOF condition if
+the new position is beyond the end of file.."
+  ;; NOTE: this should accept a "file-spec", which I believe is either an int, a
+  ;; :start or an :end. This only accepts a number.
+  (with-slots (position block-size buffer eof) stream
+    (when set-position 
+      (let ((buffer-pos (mod set-position block-size)))
+        (if (< set-position eof)
+            (cond
+              ;; If the pos is within the buffer (and initialized): 
+              ((and (<= 0 (- set-position (- position (pos buffer))) (1- block-size))
+                    (not (minusp (pos buffer))))
+               (setf (pos buffer) buffer-pos
+                     position set-position))
+              
+              (t (reupdate-block stream set-position)
+                 (setf (pos buffer) buffer-pos)))
+            (error 'eof :eof eof :position position))))
+    position))
+
+(defmethod stream-read-sequence ((stream eris-decode-stream) seq &optional (start 0) (end (length seq)))
+  (when (minusp (pos (buffer stream)))
+    ;; initializes the buffer
+    (reupdate-block stream (pos stream)))
+  (with-slots (buffer position) stream
+    (read-to-seq seq buffer :start start :end (if end end (length seq)) :stream stream)))
+
+(defmethod stream-read-byte ((stream eris-decode-stream))
+  nil)
+
+(defmethod stream-element-type ((stream eris-decode-stream))
+  '(unsigned-byte 8))
+
+(defun eris-file-length (stream)
+  (eof stream))
diff --git a/src/eris.lisp b/src/eris.lisp
new file mode 100644
index 0000000..c3bbe5f
--- /dev/null
+++ b/src/eris.lisp
@@ -0,0 +1,244 @@
+;; This file is part of eris-cl.
+;; Copyright (C) 2022 Piotr Szarmański
+
+;; eris-cl is free software: you can redistribute it and/or modify it under the
+;; terms of the GNU Lesser General Public License as published by the Free
+;; Software Foundation, either version 3 of the License, or (at your option) any
+;; later versqion.
+
+;; eris-cl is distributed in the hope that it will be useful, but WITHOUT ANY
+;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+;; A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License along with
+;; eris-cl. If not, see <https://www.gnu.org/licenses/>.
+
+(in-package :eris)
+
+(defun pad (input block-size)
+  (declare (type (simple-array (unsigned-byte 8)) 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)))
+    (replace padded-input input)
+    (setf (aref padded-input (length input)) #x80)
+    padded-input))
+
+(deftype block-size ()
+        `(member 1024 32768))
+
+(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)))))
+
+(define-constant null-secret (make-array 32 :element-type '(unsigned-byte 8) :initial-element 0) :test #'equalp)
+
+(defun reference-pair-to-octets (pair buf &optional (start 0))
+    (replace buf (reference pair) :start1 start)
+    (replace buf (key pair) :start1 (+ 32 start)))
+
+(defun octets-to-reference-pair (octets)
+  (let ((key (make-array 32 :element-type '(unsigned-byte 8)))
+        (reference (make-array 32 :element-type '(unsigned-byte 8))))
+    (replace reference octets)
+    (replace key octets :start2 32)
+    (make-instance 'reference-pair :key key :reference reference)))
+
+
+(defun compute-reference (block)
+  (declare (type (simple-array (unsigned-byte 8)) block))
+  (let ((reference (make-array 32 :element-type '(unsigned-byte 8))))
+    (ironclad:digest-sequence :blake2/256 block :digest reference)
+    reference))
+
+(declaim (inline make-nonce))
+
+(defun make-nonce (level)
+  (let ((nonce (make-array 12 :element-type '(unsigned-byte 8) :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))
+  (let ((mac (ironclad:make-mac :blake2-mac secret :digest-length 32))
+        (key (make-array 32 :element-type '(unsigned-byte 8))))
+    (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
+                                                             :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 (simple-array (unsigned-byte 8)) input secret reference))
+  (let ((key (make-array 32 :element-type '(unsigned-byte 8))))
+    (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
+                                                             :initialization-vector nonce)
+                               input)
+    (ironclad:digest-sequence :blake2/256 input :digest reference)
+    (make-instance 'reference-pair :key key :reference reference)))
+
+(defun decrypt-block (input key &optional (nonce null-secret))
+  (ironclad:decrypt-in-place
+   (ironclad:make-cipher :chacha :mode :stream :key key :initialization-vector nonce)
+   input)
+  input)
+
+
+(defclass read-capability ()
+  ((block-size :initarg :block-size
+               :accessor block-size
+               :type block-size
+               :documentation "A value of either 1024 or 1kb blocks.") 
+   (level :initarg :level :accessor level :type (unsigned-byte 8))
+   (root-reference-pair :initarg :reference-pair :accessor reference-pair)))
+
+
+
+(defun read-capability-to-octets (read-capability)
+  (declare (type read-capability read-capability))
+  (let ((cap (make-array 66 :element-type '(unsigned-byte 8))))
+    (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)))
+
+(defun octets-to-read-capability (octets)
+  (declare (type (simple-array (unsigned-byte 8) (66)) octets))
+  (let ((capability (make-instance 'read-capability)))
+    (setf (block-size capability)
+          (case (aref octets 0)
+            (#x0a 1kib)
+            (#x0f 32kib)
+            (t (error 'version-mismatch))))
+    (setf (level capability)
+          (aref octets 1))
+    (setf (reference-pair capability)
+          (octets-to-reference-pair (subseq-shared octets 2)))
+    capability))
+
+(defun read-capability-to-urn (capability)
+  (concatenate 'string
+               "urn:eris:"
+               (bytes-to-base32-unpadded (read-capability-to-octets capability))))
+
+(defun urn-to-read-capability (urn)
+  (octets-to-read-capability (base32-to-bytes-unpadded (subseq urn (1+ (position #\: urn :from-end t))))))
+
+(defun reference-to-block-urn (reference)
+  (declare (type (simple-array (unsigned-byte 8) (32)) reference))
+  (concatenate 'string "urn:blake2b:" (bytes-to-base32-unpadded reference)))
+
+(defun block-urn-to-reference (urn)
+  (declare (type string urn))
+  (base32-to-bytes-unpadded (subseq urn (1+ (position #\: urn :from-end t)))))
+
+(defvar *output-hashmap* nil)
+
+(defmacro output-block (ref-vector &rest expr)
+  `(let ((reference (compute-reference block)))
+     (if hash-output
+         (unless (gethash reference *output-hashmap*)
+           (let ((rk (encrypt-block block secret reference)))
+             (vector-push-extend rk ,ref-vector)
+             (funcall output-function block (reference rk))
+             (setf (gethash reference *output-hashmap*) t)))
+         (let ((rk (encrypt-block block secret reference)))
+           (vector-push-extend rk ,ref-vector)
+           (funcall output-function block (reference rk))))
+     ,@expr))
+
+(defmacro output-internal-block (ref-vector nonce &rest expr)
+  `(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)
+             (funcall output-function block (reference rk))
+             (setf (gethash reference *output-hashmap*) t)))
+         (let ((rk (encrypt-internal-block block reference ,nonce)))
+           (vector-push-extend rk ,ref-vector)
+           (funcall output-function block (reference rk))))
+     ,@expr))
+
+(defgeneric eris-encode (input block-size output-function &key secret hash-output)
+  (: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
+encoded block and a 32-byte reference octet vector.
+
+An optional 32-byte secret can be passed for additional encryption using the
+:secret keyword."))
+
+(defmethod eris-encode ((input simple-array) 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))
+
+  (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)
+          for i = 0 then (incf i)
+          until (= (length input) (* i block-size)) 
+          do (progn
+               (replace block input :start2 (* i block-size))
+               (output-block reference-vector nil)))
+    (eris-create-tree reference-vector block-size output-function :hash-output hash-output)))
+
+(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))
+  (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)
+          for bytes-read = (read-sequence block input)
+          for i = 0 then (incf i)
+          if (< bytes-read block-size)
+            do (setf (aref block bytes-read) #x80)
+          do (output-block reference-vector nil)
+          until (< bytes-read block-size))
+    (eris-create-tree reference-vector block-size output-function :hash-output hash-output)))
+
+(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))
+  (loop with block-keys = (/ block-size 64)
+        with level = 0
+        with reference-vector-l = (make-array 16 :adjustable t :fill-pointer 0)
+        for nonce = (make-nonce (1+ level))
+        when (eql (length reference-vector) 1)
+        do (return (make-instance 'read-capability
+                                  :reference-pair (aref reference-vector 0)
+                                  :level level
+                                  :block-size block-size)) 
+        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)
+                   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)
+                                          i 0))
+                   do (progn (reference-pair-to-octets rk block (* 64 i))
+                             (incf i))
+                   finally (unless (zerop i)
+                             ;; If i is zero, then the amount of blocks is just right. Otherwise add a final unfinished block.
+                             (output-internal-block reference-vector-l nonce)))
+             (setf reference-vector reference-vector-l)
+             (setf reference-vector-l (make-array 16 :adjustable t :fill-pointer 0)))))
diff --git a/src/package.lisp b/src/package.lisp
new file mode 100644
index 0000000..b97799c
--- /dev/null
+++ b/src/package.lisp
@@ -0,0 +1,45 @@
+;; This file is part of eris-cl.
+;; Copyright (C) 2022 Piotr Szarmański
+
+;; eris-cl is free software: you can redistribute it and/or modify it under the
+;; terms of the GNU Lesser General Public License as published by the Free
+;; Software Foundation, either version 3 of the License, or (at your option) any
+;; later versqion.
+
+;; eris-cl is distributed in the hope that it will be useful, but WITHOUT ANY
+;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+;; A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License along with
+;; eris-cl. If not, see <https://www.gnu.org/licenses/>.
+
+
+(defpackage eris
+  (:use common-lisp sb-gray alexandria trivia function-cache)
+  (:export
+   #:eris-encode
+   #:eris-decode
+   #:32kib
+   #:1kib
+   #:null-secret
+   #:*decode-safety-checks*
+
+   #:read-capability-to-urn
+   #:urn-to-read-capability
+   #:octets-to-read-capability
+   #:read-capability-to-octets
+
+   #:reference-to-block-urn
+   #:block-urn-to-reference
+
+   #:bytes-to-base32-unpadded
+   #:base32-to-bytes-unpadded
+   #:base32-to-bytes
+   #:bytes-to-base32
+
+   #:eris-condition
+   #:eof
+   #:padding-error
+   #:version-mismatch
+   #:hash-mismatch
+   #:invalid-internal-block))