From 83a7592a863d0ede241d591e0de1d792050acdf3 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Sat, 30 Jul 2016 09:31:10 -0700
Subject: [PATCH] checksums: making "checksum-state" a universal concept.

I'm not super happy with the design yet, partly because OpenSSL doesn't
subclass ``checksum-state`` so all ``initialize-checksum-state`` will not
return a ``checksum-state`` instance.  That could maybe be changed by making
``checksum-state`` a mixin, or perhaps some other way.
---
 basis/checksums/common/common.factor   | 55 ++++++++++----------------
 basis/checksums/md5/md5.factor         |  2 +-
 basis/checksums/openssl/openssl.factor | 32 +++++----------
 basis/checksums/sha/sha.factor         |  4 +-
 core/checksums/checksums-docs.factor   | 13 ++++--
 core/checksums/checksums.factor        | 38 ++++++++++++++++--
 6 files changed, 77 insertions(+), 67 deletions(-)

diff --git a/basis/checksums/common/common.factor b/basis/checksums/common/common.factor
index 2f24b3a54a..104dadcf1d 100644
--- a/basis/checksums/common/common.factor
+++ b/basis/checksums/common/common.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2006, 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors byte-arrays byte-vectors checksums grouping io
-io.backend io.binary io.encodings.binary io.files kernel make
-math sequences locals ;
+USING: accessors byte-arrays byte-vectors checksums destructors
+grouping io io.backend io.binary io.encodings.binary io.files
+kernel make math sequences locals ;
 IN: checksums.common
 
 : calculate-pad-length ( length -- length' )
@@ -19,55 +19,40 @@ MIXIN: block-checksum
 
 INSTANCE: block-checksum checksum
 
-TUPLE: checksum-state
-{ bytes-read integer }
-{ block-size integer }
-{ bytes byte-vector } ;
+TUPLE: block-checksum-state < checksum-state
+    { bytes-read integer }
+    { block-size integer } ;
 
-: new-checksum-state ( class -- checksum-state )
-    new
-        BV{ } clone >>bytes ; inline
-
-M: checksum-state clone
-    call-next-method
-    [ clone ] change-bytes ;
-
-GENERIC: initialize-checksum-state ( checksum -- checksum-state )
+M: block-checksum-state dispose drop ;
 
 GENERIC: checksum-block ( bytes checksum-state -- )
 
-GENERIC: get-checksum ( checksum-state -- value )
-
 ! Update the bytes-read before calculating checksum in case
 ! checksum uses this in the calculation.
-:: add-checksum-bytes ( checksum-state data -- checksum-state' )
-    checksum-state block-size>> :> block-size
-    checksum-state bytes>> length :> initial-len
+M:: block-checksum-state add-checksum-bytes ( state data -- state )
+    state block-size>> :> block-size
+    state bytes>> length :> initial-len
     initial-len data length + block-size /mod :> ( n extra )
-    data checksum-state bytes>> [ push-all ] keep :> all-bytes
+    data state bytes>> [ push-all ] keep :> all-bytes
     all-bytes block-size <groups>
     extra zero? [ f ] [ unclip-last-slice ] if :> ( blocks remain )
 
-    checksum-state [ initial-len - ] change-bytes-read drop
+    state [ initial-len - ] change-bytes-read drop
 
     blocks [
-        checksum-state [ block-size + ] change-bytes-read
+        state [ block-size + ] change-bytes-read
         checksum-block
     ] each
 
-    checksum-state [ extra + ] change-bytes-read
+    state [ extra + ] change-bytes-read
     remain [ >byte-vector ] [ BV{ } clone ] if* >>bytes ;
 
-: add-checksum-stream ( checksum-state stream -- checksum-state )
-    [ [ add-checksum-bytes ] each-block ] with-input-stream ;
-
-: add-checksum-file ( checksum-state path -- checksum-state )
-    binary <file-reader> add-checksum-stream ;
-
 M: block-checksum checksum-bytes
-    initialize-checksum-state
-    swap add-checksum-bytes get-checksum ;
+    initialize-checksum-state [
+        swap add-checksum-bytes get-checksum
+    ] with-disposal ;
 
 M: block-checksum checksum-stream
-    initialize-checksum-state
-    swap add-checksum-stream get-checksum ;
+    initialize-checksum-state [
+        swap add-checksum-stream get-checksum
+    ] with-disposal ;
diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor
index e8c890ddb0..80c136b207 100644
--- a/basis/checksums/md5/md5.factor
+++ b/basis/checksums/md5/md5.factor
@@ -11,7 +11,7 @@ SINGLETON: md5
 
 INSTANCE: md5 block-checksum
 
-TUPLE: md5-state < checksum-state
+TUPLE: md5-state < block-checksum-state
 { state uint-array }
 { old-state uint-array } ;
 
diff --git a/basis/checksums/openssl/openssl.factor b/basis/checksums/openssl/openssl.factor
index d6a5be2f17..9b45d813cd 100644
--- a/basis/checksums/openssl/openssl.factor
+++ b/basis/checksums/openssl/openssl.factor
@@ -1,14 +1,15 @@
 ! Copyright (C) 2008, 2010, 2016 Slava Pestov, Alexander Ilin
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.data checksums destructors
-io kernel openssl openssl.libcrypto sequences ;
+USING: accessors alien.c-types alien.data checksums
+checksums.common destructors kernel openssl openssl.libcrypto
+sequences ;
 IN: checksums.openssl
 
 ERROR: unknown-digest name ;
 
 TUPLE: openssl-checksum name ;
 
-INSTANCE: openssl-checksum checksum
+INSTANCE: openssl-checksum block-checksum
 
 CONSTANT: openssl-md5 T{ openssl-checksum f "md5" }
 
@@ -33,29 +34,16 @@ M: evp-md-context dispose*
 : set-digest ( name ctx -- )
     handle>> swap digest-named f EVP_DigestInit_ex ssl-error ;
 
-: with-evp-md-context ( ... checksum quot: ( ... ctx -- ... ) -- ... )
-    [
-        maybe-init-ssl name>> <evp-md-context>
-        [ set-digest ] keep
-    ] dip with-disposal ; inline
+M: openssl-checksum initialize-checksum-state ( checksum -- evp-md-context )
+    maybe-init-ssl name>> <evp-md-context> [ set-digest ] keep ;
 
-: digest-value ( ctx -- value )
+M: evp-md-context add-checksum-bytes ( ctx bytes -- ctx' )
+    [ dup handle>> ] dip dup length EVP_DigestUpdate ssl-error ;
+
+M: evp-md-context get-checksum ( ctx -- value )
     handle>>
     { { int EVP_MAX_MD_SIZE } int }
     [ EVP_DigestFinal_ex ssl-error ] with-out-parameters
     memory>byte-array ;
 
-: digest-update ( ctx bytes -- ctx )
-    [ dup handle>> ] dip dup length EVP_DigestUpdate ssl-error ;
-
 PRIVATE>
-
-M: openssl-checksum checksum-bytes
-    [ swap digest-update digest-value ] with-evp-md-context ;
-
-M: openssl-checksum checksum-stream
-    [
-        swap
-        [ [ digest-update ] each-block ] with-input-stream
-        digest-value
-    ] with-evp-md-context ;
diff --git a/basis/checksums/sha/sha.factor b/basis/checksums/sha/sha.factor
index 47594b12dc..cf0d374b65 100644
--- a/basis/checksums/sha/sha.factor
+++ b/basis/checksums/sha/sha.factor
@@ -23,7 +23,7 @@ INSTANCE: sha-256 sha
 
 <PRIVATE
 
-TUPLE: sha1-state < checksum-state
+TUPLE: sha1-state < block-checksum-state
 { K uint-array }
 { H uint-array }
 { W uint-array }
@@ -47,7 +47,7 @@ CONSTANT: K-sha1
         4 uint-array{ } nappend-as
     ]
 
-TUPLE: sha2-state < checksum-state
+TUPLE: sha2-state < block-checksum-state
 { K uint-array }
 { H uint-array }
 { word-size fixnum } ;
diff --git a/core/checksums/checksums-docs.factor b/core/checksums/checksums-docs.factor
index fd9e5ed26a..b7335b3aed 100644
--- a/core/checksums/checksums-docs.factor
+++ b/core/checksums/checksums-docs.factor
@@ -55,15 +55,22 @@ $nl
     checksum-bytes
     checksum-stream
     checksum-lines
+    checksum-file
 }
 "Checksums should implement at least one of " { $link checksum-bytes } " and " { $link checksum-stream } ". Implementing " { $link checksum-lines } " is optional."
 $nl
-"Utilities:"
+"Checksums can also implement a stateful checksum protocol that allows users to push bytes when needed and then at a later point request the checksum value. The default implementation is not very efficient, storing all of the bytes and then calling " { $link checksum-bytes } " when " { $link get-checksum } " is requested."
+$nl
 { $subsections
-    checksum-file
+    initialize-checksum-state
+    add-checksum-bytes
+    add-checksum-stream
+    add-checksum-lines
+    add-checksum-file
+    get-checksum
 }
 "Checksum implementations:"
-{ $subsections "checksums.crc32" }
+{ $vocab-subsection "CRC32 checksum" "checksums.crc32" }
 { $vocab-subsection "MD5 checksum" "checksums.md5" }
 { $vocab-subsection "SHA checksums" "checksums.sha" }
 { $vocab-subsection "Adler-32 checksum" "checksums.adler-32" }
diff --git a/core/checksums/checksums.factor b/core/checksums/checksums.factor
index f81e4b9807..9030f50e6a 100644
--- a/core/checksums/checksums.factor
+++ b/core/checksums/checksums.factor
@@ -1,15 +1,13 @@
 ! Copyright (c) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io io.backend io.encodings.binary io.files
-io.streams.byte-array kernel sequences ;
+USING: accessors byte-vectors io io.backend io.encodings.binary
+io.files io.streams.byte-array kernel sequences ;
 IN: checksums
 
 MIXIN: checksum
 
 GENERIC: checksum-bytes ( bytes checksum -- value )
-
 GENERIC: checksum-stream ( stream checksum -- value )
-
 GENERIC: checksum-lines ( lines checksum -- value )
 
 M: checksum checksum-bytes
@@ -23,3 +21,35 @@ M: checksum checksum-lines
 
 : checksum-file ( path checksum -- value )
     [ binary <file-reader> ] dip checksum-stream ;
+
+TUPLE: checksum-state checksum { bytes byte-vector } ;
+
+M: checksum-state clone
+    call-next-method
+    [ clone ] change-bytes ;
+
+: new-checksum-state ( class -- checksum-state )
+    new BV{ } clone >>bytes ;
+
+GENERIC: initialize-checksum-state ( checksum -- checksum-state )
+GENERIC# add-checksum-bytes 1 ( checksum-state data -- checksum-state )
+GENERIC: get-checksum ( checksum-state -- value )
+
+: add-checksum-stream ( checksum-state stream -- checksum-state )
+    [ [ add-checksum-bytes ] each-block ] with-input-stream ;
+
+: add-checksum-lines ( checksum-state lines -- checksum-state )
+    [ B{ CHAR: \n } add-checksum-bytes ]
+    [ add-checksum-bytes ] interleave ;
+
+: add-checksum-file ( checksum-state path -- checksum-state )
+    binary <file-reader> add-checksum-stream ;
+
+M: checksum initialize-checksum-state
+    checksum-state new-checksum-state swap >>checksum ;
+
+M: checksum-state add-checksum-bytes
+    over bytes>> push-all ;
+
+M: checksum-state get-checksum
+    [ bytes>> ] [ checksum>> ] bi checksum-bytes ;