sha2 now uses the incremental checksum protocol

basis/checksums/md5/md5-tests.factor

@@ -1,4 +1,6 @@
-USING: kernel math namespaces checksums checksums.md5 tools.test byte-arrays ;
+USING: byte-arrays checksums checksums.md5 io.encodings.binary
+io.streams.byte-array kernel math namespaces tools.test ;
+
 
 [ "d41d8cd98f00b204e9800998ecf8427e" ] [ "" >byte-array md5 checksum-bytes hex-string ] unit-test
 [ "0cc175b9c0f1b6a831c399e269772661" ] [ "a" >byte-array md5 checksum-bytes hex-string ] unit-test

basis/checksums/sha2/sha2.factor

@@ -3,16 +3,16 @@
 USING: kernel splitting grouping math sequences namespaces make
 io.binary math.bitwise checksums checksums.common
 sbufs strings combinators.smart math.ranges fry combinators
-accessors locals ;
+accessors locals checksums.stream multiline ;
 IN: checksums.sha2
 
 SINGLETON: sha-224
 SINGLETON: sha-256
 
-INSTANCE: sha-224 checksum
+INSTANCE: sha-224 stream-checksum
-INSTANCE: sha-256 checksum
+INSTANCE: sha-256 stream-checksum
 
-TUPLE: sha2-state K H word-size block-size ;
+TUPLE: sha2-state < checksum-state K H word-size ;
 
 TUPLE: sha2-short < sha2-state ;
 
@@ -22,6 +22,11 @@ TUPLE: sha-224-state < sha2-short ;
 
 TUPLE: sha-256-state < sha2-short ;
 
+M: sha2-state clone
+    call-next-method
+    [ clone ] change-H
+    [ clone ] change-K ;
+
 <PRIVATE
 
 CONSTANT: a 0
@@ -116,6 +121,18 @@ CONSTANT: K-384
 
 ALIAS: K-512 K-384
 
+: <sha-224-state> ( -- sha2-state )
+    64 sha-224-state new-checksum-state
+        K-256 >>K
+        initial-H-224 >>H
+        4 >>word-size ;
+
+: <sha-256-state> ( -- sha2-state )
+    64 sha-256-state new-checksum-state
+        K-256 >>K
+        initial-H-256 >>H
+        4 >>word-size ;
+
 : s0-256 ( x -- x' )
     [
         [ -7 bitroll-32 ]
@@ -172,7 +189,7 @@ ALIAS: K-512 K-384
         [ -41 bitroll-64 ] tri
     ] [ bitxor ] reduce-outputs ; inline
 
-: process-M-256 ( n seq -- )
+: prepare-M-256 ( n seq -- )
     {
         [ [ 16 - ] dip nth ]
         [ [ 15 - ] dip nth s0-256 ]
@@ -181,7 +198,7 @@ ALIAS: K-512 K-384
         [ ]
     } 2cleave set-nth ; inline
 
-: process-M-512 ( n seq -- )
+: prepare-M-512 ( n seq -- )
     {
         [ [ 16 - ] dip nth ]
         [ [ 15 - ] dip nth s0-512 ]
@@ -201,23 +218,6 @@ ALIAS: K-512 K-384
 
 GENERIC: pad-initial-bytes ( string sha2 -- padded-string )
 
-M: sha2-short pad-initial-bytes ( string sha2 -- padded-string )
-    drop
-    dup [
-        HEX: 80 ,
-        length
-        [ 64 mod calculate-pad-length 0 <string> % ]
-        [ 3 shift 8 >be % ] bi
-    ] "" make append ;
-
-M: sha2-long pad-initial-bytes ( string sha2 -- padded-string )
-    drop dup [
-        HEX: 80 ,
-        length
-        [ 128 mod calculate-pad-length-long 0 <string> % ]
-        [ 3 shift 8 >be % ] bi
-    ] "" make append ;
-
 : seq>byte-array ( seq n -- string )
     '[ _ >be ] map B{ } join ;
 
@@ -257,7 +257,7 @@ M: sha2-long pad-initial-bytes ( string sha2 -- padded-string )
     [ word-size>> <sliced-groups> [ be> ] map ]
     [
         block-size>> [ 0 pad-tail 16 ] keep [a,b) over
-        '[ _ process-M-256 ] each
+        '[ _ prepare-M-256 ] each
     ] bi ; inline
 
 :: process-chunk ( M block-size cloned-H sha2 -- )
@@ -268,39 +268,34 @@ M: sha2-long pad-initial-bytes ( string sha2 -- padded-string )
     ] each
     cloned-H sha2 H>> [ w+ ] 2map sha2 (>>H) ; inline
 
-: sha2-steps ( sliced-groups state -- )
+M: sha2-short checksum-block
-    '[
+    [ prepare-message-schedule ]
-        _
+    [ [ block-size>> ] [ H>> clone ] [ ] tri process-chunk ] bi ;
-        [ prepare-message-schedule ]
-        [ [ block-size>> ] [ H>> clone ] [ ] tri process-chunk ] bi
-    ] each ;
 
-: byte-array>sha2 ( bytes state -- )
+: sha-224>checksum ( sha2 -- bytes )
-    [ [ pad-initial-bytes ] [ nip block-size>> ] 2bi <sliced-groups> ]
+    H>> 7 head 4 seq>byte-array ;
-    [ sha2-steps ] bi ;
 
-: <sha-224-state> ( -- sha2-state )
+: sha-256>checksum ( sha2 -- bytes )
-    sha-224-state new
+    H>> 4 seq>byte-array ;
-        K-256 >>K
-        initial-H-224 >>H
-        4 >>word-size
-        64 >>block-size ;
 
-: <sha-256-state> ( -- sha2-state )
+: pad-last-short-block ( state -- )
-    sha-256-state new
+    [ bytes>> t ] [ bytes-read>> pad-last-block ] [ ] tri
-        K-256 >>K
+    [ checksum-block ] curry each ;
-        initial-H-256 >>H
-        4 >>word-size
-        64 >>block-size ;
 
 PRIVATE>
 
-M: sha-224 checksum-bytes
+M: sha-224-state get-checksum
-    drop <sha-224-state>
+    clone
-    [ byte-array>sha2 ]
+    [ pad-last-short-block ] [ sha-224>checksum ] bi ;
-    [ H>> 7 head 4 seq>byte-array ] bi ;
 
-M: sha-256 checksum-bytes
+M: sha-256-state get-checksum
-    drop <sha-256-state>
+    clone
-    [ byte-array>sha2 ]
+    [ pad-last-short-block ] [ sha-256>checksum ] bi ;
-    [ H>> 4 seq>byte-array ] bi ;
+
+M: sha-224 checksum-stream ( stream checksum -- byte-array )
+    drop
+    [ <sha-224-state> ] dip add-checksum-stream get-checksum ;
+
+M: sha-256 checksum-stream ( stream checksum -- byte-array )
+    drop
+    [ <sha-256-state> ] dip add-checksum-stream get-checksum ;