 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-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 checksums.stream multiline literals
-generalizations ;
+USING: accessors checksums checksums.common checksums.stream
+combinators combinators.smart fry generalizations grouping
+io.binary kernel literals locals make math math.bitwise
+math.ranges multiline namespaces sbufs sequences
+sequences.private splitting strings ;
 IN: checksums.sha
 
 SINGLETON: sha1

GENERIC: pad-initial-bytes ( string sha2 -- padded-string )

:: T1-256 ( n M H sha2 -- T1 )
    n M nth
    n sha2 K>> nth +
    e H slice3 ch w+
    e H nth S1-256 w+
    h H nth w+ ; inline

: T2-256 ( H -- T2 )
    [ a swap nth S0-256 ]
    [ a swap slice3 maj w+ ] bi ; inline

:: T1-512 ( n M H sha2 -- T1 )
    n M nth
    n sha2 K>> nth +
    e H slice3 ch w+
    e H nth S1-512 w+
    h H nth w+ ; inline

: T2-512 ( H -- T2 )
    [ a swap nth S0-512 ]
    [ a swap slice3 maj w+ ] bi ; inline

: update-H ( T1 T2 H -- )
    h g pick exchange
    g f pick exchange
    f e pick exchange
    pick d pick nth w+ e pick set-nth
    d c pick exchange
    c b pick exchange
    b a pick exchange
    [ w+ a ] dip set-nth ; inline

: prepare-message-schedule ( seq sha2 -- w-seq )
    [ word-size>> <sliced-groups> [ be> ] map ]

    drop
    [ <sha-256-state> ] dip add-checksum-stream get-checksum ;

: sha1-W ( t seq -- )
    {
        [ [ 3 - ] dip nth-unsafe ]
        [ [ 8 - ] dip nth-unsafe bitxor ]
        [ [ 14 - ] dip nth-unsafe bitxor ]
        [ [ 16 - ] dip nth-unsafe bitxor 1 bitroll-32 ]
        [ ]
    } 2cleave set-nth-unsafe ;

: prepare-sha1-message-schedule ( seq -- w-seq )
    4 <sliced-groups> [ be> ] map
