Add parallel decoder.

1 files changed, 31 insertions, 24 deletions

diff --git a/src/eris-decode.lisp b/src/eris-decode.lisp
index fe2dcbe..351da72 100644
--- a/src/eris-decode.lisp
+++ b/src/eris-decode.lisp
@@ -26,6 +26,10 @@ fetched from a trusted party.")
        (unless (equalp ,hash hash)
          (error 'hash-mismatch :reference ,hash :hash hash )))))
 
+(defmacro execute-fetch-function (fetch-function &rest args)
+  `(restart-case (funcall ,fetch-function ,@args)
+     (use-value (value) value)))
+
 (defun key-reference-null? (kr)
   (and (equalp (reference kr) null-secret)
        (equalp (key kr) null-secret)))
@@ -222,7 +226,7 @@ cache."
                                       :capacity cache-capacity
                                       :table (make-hash-table :size (1+ cache-capacity) :test #'equalp))
                           (reference key &optional nonce)
-                        (let* ((block (funcall fetch-function reference)))
+                        (let* ((block (execute-fetch-function fetch-function reference)))
                           (unless block (error 'missing-block :reference reference))
                           (hash-check block reference)
                           (decrypt-block block key nonce))))
@@ -262,34 +266,17 @@ cache."
                           :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-file-position ((stream eris-decode-stream))
+  "Provides the file position of the stream. This method is setf-able in order to
+change the position."
+  (pos stream))
 
-(defmethod stream-read-sequence ((stream eris-decode-stream) seq &optional (start 0) (end (length seq)))
+(defmethod stream-read-sequence ((stream eris-decode-stream) seq start end &key)
   (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)))
+    (read-to-seq seq buffer :start start :end end :stream stream)))
 
 (defmethod stream-read-byte ((stream eris-decode-stream))
   (when (minusp (pos (buffer stream)))
@@ -313,3 +300,23 @@ the new position is beyond the end of file.."
 (defun eris-file-length (stream)
   "This is the equivalent of \"file-length\" for eris-decode-stream."
   (eof stream))
+
+(defmethod (setf stream-file-position) (set-position (stream eris-decode-stream))
+  (with-slots (position block-size buffer eof) stream
+    (when set-position
+      (case set-position
+        (:end (setf set-position eof))
+        (:start (setf set-position 0)))
+      (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))))
+    set-position))