support sha-224, add constants for all sha2

basis/checksums/sha2/sha2-tests.factor

@@ -1,7 +1,36 @@
-USING: arrays kernel math namespaces sequences tools.test checksums.sha2 checksums ;
-[ "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" ] [ "" sha-256 checksum-bytes hex-string ] unit-test
-[ "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" ] [ "abc" sha-256 checksum-bytes hex-string ] unit-test
-[ "f7846f55cf23e14eebeab5b4e1550cad5b509e3348fbc4efa3a1413d393cb650" ] [ "message digest" sha-256 checksum-bytes hex-string ] unit-test
-[ "71c480df93d6ae2f1efad1447c66c9525e316218cf51fc8d9ed832f2daf18b73" ] [ "abcdefghijklmnopqrstuvwxyz" sha-256 checksum-bytes hex-string ] unit-test
-[ "db4bfcbd4da0cd85a60c3c37d3fbd8805c77f15fc6b1fdfe614ee0a7c8fdb4c0" ] [ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" sha-256 checksum-bytes hex-string ] unit-test
-[ "f371bc4a311f2b009eef952dd83ca80e2b60026c8e935592d0f9c308453c813e" ] [ "12345678901234567890123456789012345678901234567890123456789012345678901234567890" sha-256 checksum-bytes hex-string ] unit-test
+USING: arrays kernel math namespaces sequences tools.test
+checksums.sha2 checksums ;
+IN: checksums.sha2.tests
+
+: test-checksum ( text identifier -- checksum )
+    checksum-bytes hex-string ;
+
+[ "75388b16512776cc5dba5da1fd890150b0c6455cb4f58b1952522525" ]
+[
+    "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
+    sha-224 test-checksum
+] unit-test
+
+[ "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" ]
+[ "" sha-256 test-checksum ] unit-test
+
+[ "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" ]
+[ "abc" sha-256 test-checksum ] unit-test
+
+[ "f7846f55cf23e14eebeab5b4e1550cad5b509e3348fbc4efa3a1413d393cb650" ]
+[ "message digest" sha-256 test-checksum ] unit-test
+
+[ "71c480df93d6ae2f1efad1447c66c9525e316218cf51fc8d9ed832f2daf18b73" ]
+[ "abcdefghijklmnopqrstuvwxyz" sha-256 test-checksum ] unit-test
+
+[ "db4bfcbd4da0cd85a60c3c37d3fbd8805c77f15fc6b1fdfe614ee0a7c8fdb4c0" ]
+[
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
+    sha-256 test-checksum
+] unit-test
+
+[ "f371bc4a311f2b009eef952dd83ca80e2b60026c8e935592d0f9c308453c813e" ]
+[
+    "12345678901234567890123456789012345678901234567890123456789012345678901234567890"
+    sha-256 test-checksum
+] unit-test

basis/checksums/sha2/sha2.factor

@@ -19,12 +19,42 @@ CONSTANT: f 5
 CONSTANT: g 6
 CONSTANT: h 7
 
+CONSTANT: initial-H-224
+    {
+        HEX: c1059ed8 HEX: 367cd507 HEX: 3070dd17 HEX: f70e5939
+        HEX: ffc00b31 HEX: 68581511 HEX: 64f98fa7 HEX: befa4fa4
+    }
+
 CONSTANT: initial-H-256
     {
         HEX: 6a09e667 HEX: bb67ae85 HEX: 3c6ef372 HEX: a54ff53a
         HEX: 510e527f HEX: 9b05688c HEX: 1f83d9ab HEX: 5be0cd19
     }
 
+CONSTANT: initial-H-384
+    {
+        HEX: cbbb9d5dc1059ed8
+        HEX: 629a292a367cd507
+        HEX: 9159015a3070dd17
+        HEX: 152fecd8f70e5939
+        HEX: 67332667ffc00b31
+        HEX: 8eb44a8768581511
+        HEX: db0c2e0d64f98fa7
+        HEX: 47b5481dbefa4fa4
+    }
+
+CONSTANT: initial-H-512
+    {
+        HEX: 6a09e667f3bcc908
+        HEX: bb67ae8584caa73b
+        HEX: 3c6ef372fe94f82b
+        HEX: a54ff53a5f1d36f1
+        HEX: 510e527fade682d1
+        HEX: 9b05688c2b3e6c1f
+        HEX: 1f83d9abfb41bd6b
+        HEX: 5be0cd19137e2179
+    }
+
 CONSTANT: K-256
     {
         HEX: 428a2f98 HEX: 71374491 HEX: b5c0fbcf HEX: e9b5dba5
@@ -45,6 +75,29 @@ CONSTANT: K-256
         HEX: 90befffa HEX: a4506ceb HEX: bef9a3f7 HEX: c67178f2
     }
 
+CONSTANT: K-384
+    {
+        HEX: 72be5d74f27b896f HEX: 80deb1fe3b1696b1 HEX: 9bdc06a725c71235 HEX: c19bf174cf692694 
+        HEX: e49b69c19ef14ad2 HEX: efbe4786384f25e3 HEX: 0fc19dc68b8cd5b5 HEX: 240ca1cc77ac9c65 
+        HEX: 2de92c6f592b0275 HEX: 4a7484aa6ea6e483 HEX: 5cb0a9dcbd41fbd4 HEX: 76f988da831153b5 
+        HEX: 983e5152ee66dfab HEX: a831c66d2db43210 HEX: b00327c898fb213f HEX: bf597fc7beef0ee4 
+        HEX: c6e00bf33da88fc2 HEX: d5a79147930aa725 HEX: 06ca6351e003826f HEX: 142929670a0e6e70 
+        HEX: 27b70a8546d22ffc HEX: 2e1b21385c26c926 HEX: 4d2c6dfc5ac42aed HEX: 53380d139d95b3df 
+        HEX: 650a73548baf63de HEX: 766a0abb3c77b2a8 HEX: 81c2c92e47edaee6 HEX: 92722c851482353b 
+        HEX: a2bfe8a14cf10364 HEX: a81a664bbc423001 HEX: c24b8b70d0f89791 HEX: c76c51a30654be30 
+        HEX: d192e819d6ef5218 HEX: d69906245565a910 HEX: f40e35855771202a HEX: 106aa07032bbd1b8 
+        HEX: 19a4c116b8d2d0c8 HEX: 1e376c085141ab53 HEX: 2748774cdf8eeb99 HEX: 34b0bcb5e19b48a8 
+        HEX: 391c0cb3c5c95a63 HEX: 4ed8aa4ae3418acb HEX: 5b9cca4f7763e373 HEX: 682e6ff3d6b2b8a3 
+        HEX: 748f82ee5defb2fc HEX: 78a5636f43172f60 HEX: 84c87814a1f0ab72 HEX: 8cc702081a6439ec 
+        HEX: 90befffa23631e28 HEX: a4506cebde82bde9 HEX: bef9a3f7b2c67915 HEX: c67178f2e372532b 
+        HEX: ca273eceea26619c HEX: d186b8c721c0c207 HEX: eada7dd6cde0eb1e HEX: f57d4f7fee6ed178 
+        HEX: 06f067aa72176fba HEX: 0a637dc5a2c898a6 HEX: 113f9804bef90dae HEX: 1b710b35131c471b 
+        HEX: 28db77f523047d84 HEX: 32caab7b40c72493 HEX: 3c9ebe0a15c9bebc HEX: 431d67c49c100d4c 
+        HEX: 4cc5d4becb3e42b6 HEX: 597f299cfc657e2a HEX: 5fcb6fab3ad6faec HEX: 6c44198c4a475817
+    }
+
+ALIAS: K-512 K-384
+
 : s0-256 ( x -- x' )
     [
         [ -7 bitroll-32 ]
@@ -107,11 +160,11 @@ CONSTANT: K-256
     n sha2 K>> nth +
     e H slice3 ch w+
     e H nth S1-256 w+
-    h H nth w+ ;
+    h H nth w+ ; inline
 
 : T2 ( H -- T2 )
     [ a swap nth S0-256 ]
-    [ a swap slice3 maj w+ ] bi ;
+    [ a swap slice3 maj w+ ] bi ; inline
 
 : update-H ( T1 T2 H -- )
     h g pick exchange
@@ -125,33 +178,53 @@ CONSTANT: K-256
 
 : prepare-message-schedule ( seq sha2 -- w-seq )
     [ word-size>> <sliced-groups> [ be> ] map ]
-    [ block-size>> 0 pad-tail 16 64 [a,b) over '[ _ process-M-256 ] each ] bi ;
+    [
+        block-size>> 0 pad-tail 16 64 [a,b) over
+        '[ _ process-M-256 ] each
+    ] bi ; inline
 
 :: process-chunk ( M block-size cloned-H sha2 -- )
     block-size [
         M cloned-H sha2 T1
         cloned-H T2
-        cloned-H update-H 
+        cloned-H update-H
     ] each
-    cloned-H sha2 H>> [ w+ ] 2map sha2 (>>H) ;
+    cloned-H sha2 H>> [ w+ ] 2map sha2 (>>H) ; inline
 
-:: byte-array>sha2 ( bytes state -- string )
-    bytes pad-initial-bytes
-    state block-size>> <sliced-groups>
-    [
-        state prepare-message-schedule
-        state [ block-size>> ] [ H>> clone ] bi state process-chunk
-    ] each
-    state H>> 4 seq>byte-array ;
+: sha2-steps ( sliced-groups state -- )
+    '[
+        _
+        [ prepare-message-schedule ]
+        [ [ block-size>> ] [ H>> clone ] [ ] tri process-chunk ] bi
+    ] each ;
+
+: byte-array>sha2 ( bytes state -- )
+    [ [ pad-initial-bytes ] [ block-size>> ] bi* <sliced-groups> ]
+    [ sha2-steps ] bi ;
 
 PRIVATE>
 
+SINGLETON: sha-224
 SINGLETON: sha-256
+SINGLETON: sha-384
+SINGLETON: sha-512
 
+INSTANCE: sha-224 checksum
 INSTANCE: sha-256 checksum
+INSTANCE: sha-384 checksum
+INSTANCE: sha-512 checksum
 
 TUPLE: sha2-state K H word-size block-size ;
 
+TUPLE: sha-224-state < sha2-state ;
+
+: <sha-224-state> ( -- sha2-state )
+    sha-224-state new
+        K-256 >>K
+        initial-H-224 >>H
+        4 >>word-size
+        64 >>block-size ;
+
 TUPLE: sha-256-state < sha2-state ;
 
 : <sha-256-state> ( -- sha2-state )
@@ -161,5 +234,12 @@ TUPLE: sha-256-state < sha2-state ;
         4 >>word-size
         64 >>block-size ;
 
+M: sha-224 checksum-bytes
+    drop <sha-224-state>
+    [ byte-array>sha2 ]
+    [ H>> 7 head 4 seq>byte-array ] bi ;
+
 M: sha-256 checksum-bytes
-    drop <sha-256-state> byte-array>sha2 ;
+    drop <sha-256-state>
+    [ byte-array>sha2 ]
+    [ H>> 4 seq>byte-array ] bi ;