module Raaz.Hash.Sha.Util
( shaImplementation, portableC
, length64Write
, length128Write
, Compressor
) where
import Control.Monad.IO.Class
import Data.Monoid ( (<>) )
import Data.Word
import Foreign.Storable
import Raaz.Core
import Raaz.Core.Write
import Raaz.Hash.Internal
type Compressor = Pointer
-> Int
-> Pointer
-> IO ()
shaImplementation :: ( Primitive h
, Storable h
, Initialisable (HashMemory h) ()
)
=> String
-> String
-> Compressor
-> (BITS Word64 -> Write)
-> HashI h (HashMemory h)
shaImplementation nam des comp lenW
= HashI { hashIName = nam
, hashIDescription = des
, compress = shaCompress comp
, compressFinal = shaCompressFinal undefined lenW comp
}
portableC :: ( Primitive h
, Storable h
, Initialisable (HashMemory h) ()
)
=> Compressor
-> (BITS Word64 -> Write)
-> HashI h (HashMemory h)
portableC = shaImplementation "portable-c-ffi"
"Implementation using portable C and Haskell FFI"
shaCompress :: (Primitive h, Storable h)
=> Compressor
-> Pointer
-> BLOCKS h
-> MT (HashMemory h) ()
shaCompress comp ptr nblocks = do
liftSubMT hashCell $ withPointer $ comp ptr $ fromEnum nblocks
updateLength nblocks
shaCompressFinal :: (Primitive h, Storable h)
=> h
-> (BITS Word64 -> Write)
-> Compressor
-> Pointer
-> BYTES Int
-> MT (HashMemory h) ()
shaCompressFinal h lenW comp ptr nbytes = do
updateLength nbytes
totalBits <- extractLength
let pad = paddedMesg (lenW totalBits) h nbytes
blocks = atMost (bytesToWrite pad) `asTypeOf` blocksOf 1 h
in do liftIO $ unsafeWrite pad ptr
liftSubMT hashCell $ withPointer $ comp ptr $ fromEnum blocks
length64Write :: BITS Word64 -> Write
length64Write (BITS w) = write $ bigEndian w
length128Write :: BITS Word64 -> Write
length128Write w = writeStorable (0 :: Word64) <> length64Write w
paddedMesg :: Primitive h
=> Write
-> h
-> BYTES Int
-> Write
paddedMesg lenW h msgLen = start <> zeros <> lenW
where start = skipWrite msgLen <> writeStorable (0x80 :: Word8)
zeros = writeBytes 0 sz
totalBytes = bytesToWrite start + bytesToWrite lenW
sz = inBytes (atLeast totalBytes `asTypeOf` blocksOf 1 h)
totalBytes