moving md5 state to a tuple, redoing hmac

basis/checksums/hmac/hmac-tests.factor

@@ -1,38 +1,42 @@
 USING: kernel io strings byte-arrays sequences namespaces math
-parser crypto.hmac tools.test ;
+parser checksums.hmac tools.test checksums.md5 checksums.sha1
-IN: crypto.hmac.tests
+checksums.sha2 ;
+IN: checksums.hmac.tests
 
 [
     "\u000092\u000094rz68\u0000bb\u00001c\u000013\u0000f4\u00008e\u0000f8\u000015\u00008b\u0000fc\u00009d"
 ] [
-    16 11 <string> "Hi There" sequence>md5-hmac >string ] unit-test
+    16 11 <string> "Hi There" md5 hmac-bytes >string ] unit-test
 
 [ "u\u00000cx>j\u0000b0\u0000b5\u000003\u0000ea\u0000a8n1\n]\u0000b78" ]
-[ "Jefe" "what do ya want for nothing?" sequence>md5-hmac >string ] unit-test
+[ "Jefe" "what do ya want for nothing?" md5 hmac-bytes >string ] unit-test
 
 [
     "V\u0000be4R\u00001d\u000014L\u000088\u0000db\u0000b8\u0000c73\u0000f0\u0000e8\u0000b3\u0000f6"
 ]
 [
     16 HEX: aa <string>
-    50 HEX: dd <repetition> sequence>md5-hmac >string
+    50 HEX: dd <repetition> md5 hmac-bytes >string
 ] unit-test
 
 [
     "g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9"
 ] [
-    16 11 <string> "Hi There" sequence>sha1-hmac >string
+    16 11 <string> "Hi There" sha1 hmac-bytes >string
 ] unit-test
 
 [
     "\u0000ef\u0000fc\u0000dfj\u0000e5\u0000eb/\u0000a2\u0000d2t\u000016\u0000d5\u0000f1\u000084\u0000df\u00009c%\u00009a|y"
 ] [
-    "Jefe" "what do ya want for nothing?" sequence>sha1-hmac >string
+    "Jefe" "what do ya want for nothing?" sha1 hmac-bytes >string
 ] unit-test
 
 [
     "\u0000d70YM\u000016~5\u0000d5\u000095o\u0000d8\0=\r\u0000b3\u0000d3\u0000f4m\u0000c7\u0000bb"
 ] [
     16 HEX: aa <string>
-    50 HEX: dd <repetition> sequence>sha1-hmac >string
+    50 HEX: dd <repetition> sha1 hmac-bytes >string
 ] unit-test
+
+[ "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" ]
+[ HEX: b 20 <string> sha-256 hmac-bytes >string ] unit-test

basis/checksums/hmac/hmac.factor

@@ -0,0 +1,49 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays checksums checksums.md5 checksums.md5.private
+checksums.sha1 combinators fry io io.binary io.encodings.binary
+io.files io.streams.byte-array kernel math math.vectors memoize
+sequences ;
+IN: checksums.hmac
+
+<PRIVATE
+
+: sha1-hmac ( Ko Ki stream -- hmac )
+    initialize-sha1 process-sha1-block
+    stream>sha1 get-sha1
+    initialize-sha1
+    [ process-sha1-block ]
+    [ process-sha1-block ] bi* get-sha1 ;
+
+: md5-hmac ( Ko Ki stream -- hmac )
+    initialize-md5 process-md5-block
+    stream>md5 get-md5
+    initialize-md5
+    [ process-md5-block ]
+    [ process-md5-block ] bi* get-md5 ;
+
+: seq-bitxor ( seq seq -- seq ) [ bitxor ] 2map ;
+
+MEMO: opad ( -- seq ) 64 HEX: 5c <array> ;
+
+MEMO: ipad ( -- seq ) 64 HEX: 36 <array> ;
+
+: init-K ( K -- o i )
+    64 0 pad-tail 
+    [ opad seq-bitxor ]
+    [ ipad seq-bitxor ] bi ;
+
+PRIVATE>
+
+: hmac ( K stream checksum -- value )
+    ;
+
+:: hmac-stream ( K stream checksum -- value )
+    K init-K :> i :> o
+    stream checksum checksum-stream ;
+
+: hmac-file ( K path checksum -- value )
+    [ binary <file-reader> ] dip hmac-stream ;
+
+: hmac-bytes ( K path checksum -- value )
+    [ binary <byte-reader> ] dip hmac-stream ;

basis/checksums/md5/md5.factor

@@ -3,57 +3,53 @@
 USING: kernel io io.binary io.files io.streams.byte-array math
 math.functions math.parser namespaces splitting grouping strings
 sequences byte-arrays locals sequences.private macros fry
-io.encodings.binary math.bitwise checksums
+io.encodings.binary math.bitwise checksums accessors
-checksums.common checksums.stream combinators ;
+checksums.common checksums.stream combinators combinators.smart ;
 IN: checksums.md5
 
-! See http://www.faqs.org/rfcs/rfc1321.html
+TUPLE: md5-state bytes-read a b c d old-a old-b old-c old-d ;
+
+: <md5-state> ( -- md5-state )
+    md5-state new
+        0 >>bytes-read
+        HEX: 67452301 [ >>a ] [ >>old-a ] bi
+        HEX: efcdab89 [ >>b ] [ >>old-b ] bi
+        HEX: 98badcfe [ >>c ] [ >>old-c ] bi
+        HEX: 10325476 [ >>d ] [ >>old-d ] bi ;
 
 <PRIVATE
 
-SYMBOLS: a b c d old-a old-b old-c old-d ;
+: update-md5-state ( md5-state -- md5-state )
+    {
+        [ [ a>> ] [ ] [ old-a>> ] tri [ w+ ] change-a (>>old-a) ]
+        [ [ b>> ] [ ] [ old-b>> ] tri [ w+ ] change-b (>>old-b) ]
+        [ [ c>> ] [ ] [ old-c>> ] tri [ w+ ] change-c (>>old-c) ]
+        [ [ d>> ] [ ] [ old-d>> ] tri [ w+ ] change-d (>>old-d) ]
+        [ ]
+    } cleave ;
+
+: md5-state>bytes ( md5-state -- str )
+    [ { [ a>> ] [ b>> ] [ c>> ] [ d>> ] } cleave ] output>array
+    [ 4 >le ] map B{ } concat-as ;
 
 : T ( N -- Y )
     sin abs 32 2^ * >integer ; foldable
 
-: initialize-md5 ( -- )
+:: F ( X Y Z -- FXYZ )
-    0 bytes-read set
-    HEX: 67452301 dup a set old-a set
-    HEX: efcdab89 dup b set old-b set
-    HEX: 98badcfe dup c set old-c set
-    HEX: 10325476 dup d set old-d set ;
-
-: update-md ( -- )
-    old-a a update-old-new
-    old-b b update-old-new
-    old-c c update-old-new
-    old-d d update-old-new ;
-
-:: (ABCD) ( x a b c d k s i func -- )
-    #! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s)
-    a [
-        b get c get d get func call w+
-        k x nth-unsafe w+
-        i T w+
-        s bitroll-32
-        b get w+
-    ] change ; inline
-
-: F ( X Y Z -- FXYZ )
     #! F(X,Y,Z) = XY v not(X) Z
-    pick bitnot bitand [ bitand ] [ bitor ] bi* ;
+    X Y bitand X bitnot Z bitand bitor ;
 
-: G ( X Y Z -- GXYZ )
+:: G ( X Y Z -- GXYZ )
     #! G(X,Y,Z) = XZ v Y not(Z)
-    dup bitnot rot bitand [ bitand ] [ bitor ] bi* ;
+    X Z bitand Y Z bitnot bitand bitor ;
 
 : H ( X Y Z -- HXYZ )
     #! H(X,Y,Z) = X xor Y xor Z
     bitxor bitxor ;
 
-: I ( X Y Z -- IXYZ )
+:: I ( X Y Z -- IXYZ )
     #! I(X,Y,Z) = Y xor (X v not(Z))
-    rot swap bitnot bitor bitxor ;
+    Z bitnot X bitor Y bitxor ;
 
 CONSTANT: S11 7
 CONSTANT: S12 12
@@ -72,6 +68,35 @@ CONSTANT: S42 10
 CONSTANT: S43 15
 CONSTANT: S44 21
 
+
+
+
+SYMBOLS: a b c d old-a old-b old-c old-d ;
+
+: initialize-md5 ( -- )
+    0 bytes-read set
+    HEX: 67452301 dup a set old-a set
+    HEX: efcdab89 dup b set old-b set
+    HEX: 98badcfe dup c set old-c set
+    HEX: 10325476 dup d set old-d set ;
+
+: update-md ( -- )
+    old-a a update-old-new
+    old-b b update-old-new
+    old-c c update-old-new
+    old-d d update-old-new ;
+
+
+:: (ABCD) ( x a b c d k s i func -- )
+    #! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s)
+    a [
+        b get c get d get func call w+
+        k x nth-unsafe w+
+        i T w+
+        s bitroll-32
+        b get w+
+    ] change ; inline
+
 MACRO: with-md5-round ( ops func -- )
     '[ [ _ (ABCD) ] compose ] map '[ _ cleave ] ;
 
@@ -173,9 +198,10 @@ MACRO: with-md5-round ( ops func -- )
         [ (process-md5-block) ] each
     ] if ;
     
-: stream>md5 ( -- )
+: stream>md5 ( stream -- )
-    64 read [ process-md5-block ] keep
+    64 over stream-read
-    length 64 = [ stream>md5 ] when ;
+    [ process-md5-block ] [ length 64 = ] bi
+    [ stream>md5 ] [ drop ] if ;
 
 : get-md5 ( -- str )
     [ a b c d ] [ get 4 >le ] map concat >byte-array ;
@@ -186,5 +212,5 @@ SINGLETON: md5
 
 INSTANCE: md5 stream-checksum
 
-M: md5 checksum-stream ( stream -- byte-array )
+M: md5 checksum-stream
-    drop [ initialize-md5 stream>md5 get-md5 ] with-input-stream ;
+    drop initialize-md5 stream>md5 get-md5 ;

extra/crypto/hmac/hmac.factor

@@ -1,55 +0,0 @@
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: arrays combinators checksums checksums.md5
-checksums.sha1 checksums.md5.private io io.binary io.files
-io.streams.byte-array kernel math math.vectors memoize sequences
-io.encodings.binary ;
-IN: crypto.hmac
-
-<PRIVATE
-
-: sha1-hmac ( Ko Ki -- hmac )
-    initialize-sha1 process-sha1-block
-    stream>sha1 get-sha1
-    initialize-sha1
-    [ process-sha1-block ]
-    [ process-sha1-block ] bi* get-sha1 ;
-
-: md5-hmac ( Ko Ki -- hmac )
-    initialize-md5 process-md5-block
-    stream>md5 get-md5
-    initialize-md5
-    [ process-md5-block ]
-    [ process-md5-block ] bi* get-md5 ;
-
-: seq-bitxor ( seq seq -- seq )
-    [ bitxor ] 2map ;
-
-MEMO: ipad ( -- seq ) 64 HEX: 36 <array> ;
-
-MEMO: opad ( -- seq ) 64 HEX: 5c <array> ;
-
-: init-hmac ( K -- o i )
-    64 0 pad-tail 
-    [ opad seq-bitxor ]
-    [ ipad seq-bitxor ] bi ;
-
-PRIVATE>
-
-: stream>sha1-hmac ( K stream -- hmac )
-    [ init-hmac sha1-hmac ] with-input-stream ;
-
-: file>sha1-hmac ( K path -- hmac )
-    binary <file-reader> stream>sha1-hmac ;
-
-: sequence>sha1-hmac ( K sequence -- hmac )
-    binary <byte-reader> stream>sha1-hmac ;
-
-: stream>md5-hmac ( K stream -- hmac )
-    [ init-hmac md5-hmac ] with-input-stream ;
-
-: file>md5-hmac ( K path -- hmac )
-    binary <file-reader> stream>md5-hmac ;
-
-: sequence>md5-hmac ( K sequence -- hmac )
-    binary <byte-reader> stream>md5-hmac ;