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