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, Word32) 58 59-- | Hash a strict bytestring into a digest. 60hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a 61hash bs = hashFinalize $ hashUpdate hashInit bs 62 63-- | Hash the first N bytes of a bytestring, with code path independent from N. 64hashPrefix :: (ByteArrayAccess ba, HashAlgorithmPrefix a) => ba -> Int -> Digest a 65hashPrefix = hashFinalizePrefix hashInit 66 67-- | Hash a lazy bytestring into a digest. 68hashlazy :: HashAlgorithm a => L.ByteString -> Digest a 69hashlazy lbs = hashFinalize $ hashUpdates hashInit (L.toChunks lbs) 70 71-- | Initialize a new context for this hash algorithm 72hashInit :: forall a . HashAlgorithm a => Context a 73hashInit = Context $ B.allocAndFreeze (hashInternalContextSize (undefined :: a)) $ \(ptr :: Ptr (Context a)) -> 74 hashInternalInit ptr 75 76-- | run hashUpdates on one single bytestring and return the updated context. 77hashUpdate :: (ByteArrayAccess ba, HashAlgorithm a) => Context a -> ba -> Context a 78hashUpdate ctx b 79 | B.null b = ctx 80 | otherwise = hashUpdates ctx [b] 81 82-- | Update the context with a list of strict bytestring, 83-- and return a new context with the updates. 84hashUpdates :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba) 85 => Context a 86 -> [ba] 87 -> Context a 88hashUpdates c l 89 | null ls = c 90 | otherwise = Context $ B.copyAndFreeze c $ \(ctx :: Ptr (Context a)) -> 91 mapM_ (\b -> B.withByteArray b (processBlocks ctx (B.length b))) ls 92 where 93 ls = filter (not . B.null) l 94 -- process the data in 4GB chunks to fit in uint32_t 95 processBlocks ctx bytesLeft dataPtr 96 | bytesLeft == 0 = return () 97 | otherwise = do 98 hashInternalUpdate ctx dataPtr (fromIntegral actuallyProcessed) 99 processBlocks ctx (bytesLeft - actuallyProcessed) (dataPtr `plusPtr` actuallyProcessed) 100 where 101 actuallyProcessed = min bytesLeft (fromIntegral (maxBound :: Word32)) 102 103-- | Finalize a context and return a digest. 104hashFinalize :: forall a . HashAlgorithm a 105 => Context a 106 -> Digest a 107hashFinalize !c = 108 Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \(dig :: Ptr (Digest a)) -> do 109 ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig 110 return () 111 112-- | Update the context with the first N bytes of a bytestring and return the 113-- digest. The code path is independent from N but much slower than a normal 114-- 'hashUpdate'. The function can be called for the last bytes of a message, in 115-- order to exclude a variable padding, without leaking the padding length. The 116-- begining of the message, never impacted by the padding, should preferably go 117-- through 'hashUpdate' for better performance. 118hashFinalizePrefix :: forall a ba . (HashAlgorithmPrefix a, ByteArrayAccess ba) 119 => Context a 120 -> ba 121 -> Int 122 -> Digest a 123hashFinalizePrefix !c b len = 124 Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \(dig :: Ptr (Digest a)) -> do 125 ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> 126 B.withByteArray b $ \d -> 127 hashInternalFinalizePrefix ctx d (fromIntegral $ B.length b) (fromIntegral len) dig 128 return () 129 130-- | Initialize a new context for a specified hash algorithm 131hashInitWith :: HashAlgorithm alg => alg -> Context alg 132hashInitWith _ = hashInit 133 134-- | Run the 'hash' function but takes an explicit hash algorithm parameter 135hashWith :: (ByteArrayAccess ba, HashAlgorithm alg) => alg -> ba -> Digest alg 136hashWith _ = hash 137 138-- | Run the 'hashPrefix' function but takes an explicit hash algorithm parameter 139hashPrefixWith :: (ByteArrayAccess ba, HashAlgorithmPrefix alg) => alg -> ba -> Int -> Digest alg 140hashPrefixWith _ = hashPrefix 141 142-- | Try to transform a bytearray into a Digest of specific algorithm. 143-- 144-- If the digest is not the right size for the algorithm specified, then 145-- Nothing is returned. 146digestFromByteString :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba) => ba -> Maybe (Digest a) 147digestFromByteString = from undefined 148 where 149 from :: a -> ba -> Maybe (Digest a) 150 from alg bs 151 | B.length bs == (hashDigestSize alg) = Just $ Digest $ unsafeDoIO $ copyBytes bs 152 | otherwise = Nothing 153 154 copyBytes :: ba -> IO (Block Word8) 155 copyBytes ba = do 156 muArray <- new count 157 B.withByteArray ba $ \ptr -> copyFromPtr ptr muArray 0 count 158 unsafeFreeze muArray 159 where 160 count = CountOf (B.length ba) 161