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