1-- | 2-- Module : Crypto.Hash 3-- License : BSD-style 4-- Maintainer : Vincent Hanquez <vincent@snarc.org> 5-- Stability : experimental 6-- Portability : unknown 7-- 8-- Generalized cryptographic hash interface, that you can use with cryptographic hash 9-- algorithm that belong to the HashAlgorithm type class. 10-- 11-- > import Crypto.Hash 12-- > 13-- > sha1 :: ByteString -> Digest SHA1 14-- > sha1 = hash 15-- > 16-- > hexSha3_512 :: ByteString -> String 17-- > hexSha3_512 bs = show (hash bs :: Digest SHA3_512) 18-- 19{-# LANGUAGE ScopedTypeVariables #-} 20{-# LANGUAGE BangPatterns #-} 21module Crypto.Hash 22 ( 23 -- * Types 24 Context 25 , Digest 26 -- * Functions 27 , digestFromByteString 28 -- * Hash methods parametrized by algorithm 29 , hashInitWith 30 , hashWith 31 , hashPrefixWith 32 -- * Hash methods 33 , hashInit 34 , hashUpdates 35 , hashUpdate 36 , hashFinalize 37 , hashFinalizePrefix 38 , hashBlockSize 39 , hashDigestSize 40 , hash 41 , hashPrefix 42 , hashlazy 43 -- * Hash algorithms 44 , module Crypto.Hash.Algorithms 45 ) where 46 47import Basement.Types.OffsetSize (CountOf (..)) 48import Basement.Block (Block, unsafeFreeze) 49import Basement.Block.Mutable (copyFromPtr, new) 50import Crypto.Internal.Compat (unsafeDoIO) 51import Crypto.Hash.Types 52import Crypto.Hash.Algorithms 53import Foreign.Ptr (Ptr, plusPtr) 54import Crypto.Internal.ByteArray (ByteArrayAccess) 55import qualified Crypto.Internal.ByteArray as B 56import qualified Data.ByteString.Lazy as L 57import Data.Word (Word8) 58import Data.Int (Int32) 59 60-- | Hash a strict bytestring into a digest. 61hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a 62hash bs = hashFinalize $ hashUpdate hashInit bs 63 64-- | Hash the first N bytes of a bytestring, with code path independent from N. 65hashPrefix :: (ByteArrayAccess ba, HashAlgorithmPrefix a) => ba -> Int -> Digest a 66hashPrefix = hashFinalizePrefix hashInit 67 68-- | Hash a lazy bytestring into a digest. 69hashlazy :: HashAlgorithm a => L.ByteString -> Digest a 70hashlazy lbs = hashFinalize $ hashUpdates hashInit (L.toChunks lbs) 71 72-- | Initialize a new context for this hash algorithm 73hashInit :: forall a . HashAlgorithm a => Context a 74hashInit = Context $ B.allocAndFreeze (hashInternalContextSize (undefined :: a)) $ \(ptr :: Ptr (Context a)) -> 75 hashInternalInit ptr 76 77-- | run hashUpdates on one single bytestring and return the updated context. 78hashUpdate :: (ByteArrayAccess ba, HashAlgorithm a) => Context a -> ba -> Context a 79hashUpdate ctx b 80 | B.null b = ctx 81 | otherwise = hashUpdates ctx [b] 82 83-- | Update the context with a list of strict bytestring, 84-- and return a new context with the updates. 85hashUpdates :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba) 86 => Context a 87 -> [ba] 88 -> Context a 89hashUpdates c l 90 | null ls = c 91 | otherwise = Context $ B.copyAndFreeze c $ \(ctx :: Ptr (Context a)) -> 92 mapM_ (\b -> B.withByteArray b (processBlocks ctx (B.length b))) ls 93 where 94 ls = filter (not . B.null) l 95 -- process the data in 2GB chunks to fit in uint32_t and Int on 32 bit systems 96 processBlocks ctx bytesLeft dataPtr 97 | bytesLeft == 0 = return () 98 | otherwise = do 99 hashInternalUpdate ctx dataPtr (fromIntegral actuallyProcessed) 100 processBlocks ctx (bytesLeft - actuallyProcessed) (dataPtr `plusPtr` actuallyProcessed) 101 where 102 actuallyProcessed = min bytesLeft (fromIntegral (maxBound :: Int32)) 103 104-- | Finalize a context and return a digest. 105hashFinalize :: forall a . HashAlgorithm a 106 => Context a 107 -> Digest a 108hashFinalize !c = 109 Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \(dig :: Ptr (Digest a)) -> do 110 ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig 111 return () 112 113-- | Update the context with the first N bytes of a bytestring and return the 114-- digest. The code path is independent from N but much slower than a normal 115-- 'hashUpdate'. The function can be called for the last bytes of a message, in 116-- order to exclude a variable padding, without leaking the padding length. The 117-- begining of the message, never impacted by the padding, should preferably go 118-- through 'hashUpdate' for better performance. 119hashFinalizePrefix :: forall a ba . (HashAlgorithmPrefix a, ByteArrayAccess ba) 120 => Context a 121 -> ba 122 -> Int 123 -> Digest a 124hashFinalizePrefix !c b len = 125 Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \(dig :: Ptr (Digest a)) -> do 126 ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> 127 B.withByteArray b $ \d -> 128 hashInternalFinalizePrefix ctx d (fromIntegral $ B.length b) (fromIntegral len) dig 129 return () 130 131-- | Initialize a new context for a specified hash algorithm 132hashInitWith :: HashAlgorithm alg => alg -> Context alg 133hashInitWith _ = hashInit 134 135-- | Run the 'hash' function but takes an explicit hash algorithm parameter 136hashWith :: (ByteArrayAccess ba, HashAlgorithm alg) => alg -> ba -> Digest alg 137hashWith _ = hash 138 139-- | Run the 'hashPrefix' function but takes an explicit hash algorithm parameter 140hashPrefixWith :: (ByteArrayAccess ba, HashAlgorithmPrefix alg) => alg -> ba -> Int -> Digest alg 141hashPrefixWith _ = hashPrefix 142 143-- | Try to transform a bytearray into a Digest of specific algorithm. 144-- 145-- If the digest is not the right size for the algorithm specified, then 146-- Nothing is returned. 147digestFromByteString :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba) => ba -> Maybe (Digest a) 148digestFromByteString = from undefined 149 where 150 from :: a -> ba -> Maybe (Digest a) 151 from alg bs 152 | B.length bs == (hashDigestSize alg) = Just $ Digest $ unsafeDoIO $ copyBytes bs 153 | otherwise = Nothing 154 155 copyBytes :: ba -> IO (Block Word8) 156 copyBytes ba = do 157 muArray <- new count 158 B.withByteArray ba $ \ptr -> copyFromPtr ptr muArray 0 count 159 unsafeFreeze muArray 160 where 161 count = CountOf (B.length ba) 162