USING: kernel io strings sequences namespaces math parser crypto ;
IN: crypto-internals

SYMBOL: a
SYMBOL: b
SYMBOL: c
SYMBOL: d
SYMBOL: old-a
SYMBOL: old-b
SYMBOL: old-c
SYMBOL: old-d

: calculate-sin ( int -- int )
    sin abs 4294967296 * >bignum ; inline

SYMBOL: md5-sin-table
65 [ calculate-sin ] map md5-sin-table set-global

: 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 ;

! Let [abcd k s i] denote the operation
! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s)

: 1to4 dup second get over third get pick fourth get ;

: (F) ( vars func -- vars result ) >r 1to4 r> call ; inline

: (ABCD) ( s i x vars result -- )
    #! bits to shift, input to float-sin, x, func
    swap >r w+ swap md5-sin-table get nth w+ r> dup first >r swap r> update
    dup first get rot bitroll-32 over second get w+ swap first set ;

: ABCD { a b c d } swap (F) (ABCD) ; inline
: BCDA { b c d a } swap (F) (ABCD) ; inline
: CDAB { c d a b } swap (F) (ABCD) ; inline
: DABC { d a b c } swap (F) (ABCD) ; inline

! F(X,Y,Z) = XY v not(X) Z
: F ( X Y Z -- FXYZ )
    pick bitnot bitand >r bitand r> bitor ;

! G(X,Y,Z) = XZ v Y not(Z)
: G ( X Y Z -- GXYZ )
    dup bitnot rot bitand >r bitand r> bitor ;
    
! H(X,Y,Z) = X xor Y xor Z
: H ( X Y Z -- HXYZ )
    bitxor bitxor ;
    
! I(X,Y,Z) = Y xor (X v not(Z))
: I ( X Y Z -- IXYZ )
    rot swap bitnot bitor bitxor ;
: S11 7  ; inline
: S12 12 ; inline
: S13 17 ; inline
: S14 22 ; inline
: S21 5  ; inline
: S22 9  ; inline
: S23 14 ; inline
: S24 20 ; inline
: S31 4 ;  inline
: S32 11 ; inline
: S33 16 ; inline
: S34 23 ; inline
: S41 6  ; inline
: S42 10 ; inline
: S43 15 ; inline
: S44 21 ; inline

: process-md5-block ( block -- )
    S11 1 pick 0 nth-int   [ F ] ABCD
    S12 2 pick 1 nth-int   [ F ] DABC
    S13 3 pick 2 nth-int   [ F ] CDAB
    S14 4 pick 3 nth-int   [ F ] BCDA
    S11 5 pick 4 nth-int   [ F ] ABCD
    S12 6 pick 5 nth-int   [ F ] DABC
    S13 7 pick 6 nth-int   [ F ] CDAB
    S14 8 pick 7 nth-int   [ F ] BCDA
    S11 9 pick 8 nth-int   [ F ] ABCD
    S12 10 pick 9 nth-int  [ F ] DABC
    S13 11 pick 10 nth-int [ F ] CDAB
    S14 12 pick 11 nth-int [ F ] BCDA
    S11 13 pick 12 nth-int [ F ] ABCD
    S12 14 pick 13 nth-int [ F ] DABC
    S13 15 pick 14 nth-int [ F ] CDAB
    S14 16 pick 15 nth-int [ F ] BCDA

    S21 17 pick 1 nth-int  [ G ] ABCD
    S22 18 pick 6 nth-int  [ G ] DABC
    S23 19 pick 11 nth-int [ G ] CDAB
    S24 20 pick 0 nth-int  [ G ] BCDA
    S21 21 pick 5 nth-int  [ G ] ABCD
    S22 22 pick 10 nth-int [ G ] DABC
    S23 23 pick 15 nth-int [ G ] CDAB
    S24 24 pick 4 nth-int  [ G ] BCDA
    S21 25 pick 9 nth-int  [ G ] ABCD
    S22 26 pick 14 nth-int [ G ] DABC
    S23 27 pick 3 nth-int  [ G ] CDAB
    S24 28 pick 8 nth-int  [ G ] BCDA
    S21 29 pick 13 nth-int [ G ] ABCD
    S22 30 pick 2 nth-int  [ G ] DABC
    S23 31 pick 7 nth-int  [ G ] CDAB
    S24 32 pick 12 nth-int [ G ] BCDA

    S31 33 pick 5 nth-int  [ H ] ABCD
    S32 34 pick 8 nth-int  [ H ] DABC
    S33 35 pick 11 nth-int [ H ] CDAB
    S34 36 pick 14 nth-int [ H ] BCDA
    S31 37 pick 1 nth-int  [ H ] ABCD
    S32 38 pick 4 nth-int  [ H ] DABC
    S33 39 pick 7 nth-int  [ H ] CDAB
    S34 40 pick 10 nth-int [ H ] BCDA
    S31 41 pick 13 nth-int [ H ] ABCD
    S32 42 pick 0 nth-int  [ H ] DABC
    S33 43 pick 3 nth-int  [ H ] CDAB
    S34 44 pick 6 nth-int  [ H ] BCDA
    S31 45 pick 9 nth-int  [ H ] ABCD
    S32 46 pick 12 nth-int [ H ] DABC
    S33 47 pick 15 nth-int [ H ] CDAB
    S34 48 pick 2 nth-int  [ H ] BCDA

    S41 49 pick 0 nth-int  [ I ] ABCD
    S42 50 pick 7 nth-int  [ I ] DABC
    S43 51 pick 14 nth-int [ I ] CDAB
    S44 52 pick 5 nth-int  [ I ] BCDA
    S41 53 pick 12 nth-int [ I ] ABCD
    S42 54 pick 3 nth-int  [ I ] DABC
    S43 55 pick 10 nth-int [ I ] CDAB
    S44 56 pick 1 nth-int  [ I ] BCDA
    S41 57 pick 8 nth-int  [ I ] ABCD
    S42 58 pick 15 nth-int [ I ] DABC
    S43 59 pick 6 nth-int  [ I ] CDAB
    S44 60 pick 13 nth-int [ I ] BCDA
    S41 61 pick 4 nth-int  [ I ] ABCD
    S42 62 pick 11 nth-int [ I ] DABC
    S43 63 pick 2 nth-int  [ I ] CDAB
    S44 64 rot 9 nth-int  [ I ] BCDA
    update-md ;

: get-md5 ( -- str )
    [ [ a b c d ] [ get 4 >le % ] each ] "" make ;

: (stream>md5) ( -- )
    64 read dup length dup bytes-read [ + ] change 64 = [
        process-md5-block (stream>md5)
    ] [
        f bytes-read get pad-last-block [ process-md5-block ] each
    ] if ;

IN: crypto

: stream>md5 ( stream -- md5 )
    [ [ initialize-md5 (stream>md5) get-md5 ] with-stream ] with-scope ;

: string>md5 ( string -- md5 ) <string-reader> stream>md5 ;
: string>md5str ( string -- str ) string>md5 hex-string ;
: file>md5 ( file -- md5 ) <file-reader> stream>md5 ;