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    -- * Hash methods
32    , hashInit
33    , hashUpdates
34    , hashUpdate
35    , hashFinalize
36    , hashBlockSize
37    , hashDigestSize
38    , hash
39    , hashlazy
40    -- * Hash algorithms
41    , module Crypto.Hash.Algorithms
42    ) where
43
44import           Basement.Types.OffsetSize (CountOf (..))
45import           Basement.Block (Block, unsafeFreeze)
46import           Basement.Block.Mutable (copyFromPtr, new)
47import           Crypto.Internal.Compat (unsafeDoIO)
48import           Crypto.Hash.Types
49import           Crypto.Hash.Algorithms
50import           Foreign.Ptr (Ptr)
51import           Crypto.Internal.ByteArray (ByteArrayAccess)
52import qualified Crypto.Internal.ByteArray as B
53import qualified Data.ByteString.Lazy as L
54import           Data.Word (Word8)
55
56-- | Hash a strict bytestring into a digest.
57hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a
58hash bs = hashFinalize $ hashUpdate hashInit bs
59
60-- | Hash a lazy bytestring into a digest.
61hashlazy :: HashAlgorithm a => L.ByteString -> Digest a
62hashlazy lbs = hashFinalize $ hashUpdates hashInit (L.toChunks lbs)
63
64-- | Initialize a new context for this hash algorithm
65hashInit :: forall a . HashAlgorithm a => Context a
66hashInit = Context $ B.allocAndFreeze (hashInternalContextSize (undefined :: a)) $ \(ptr :: Ptr (Context a)) ->
67    hashInternalInit ptr
68
69-- | run hashUpdates on one single bytestring and return the updated context.
70hashUpdate :: (ByteArrayAccess ba, HashAlgorithm a) => Context a -> ba -> Context a
71hashUpdate ctx b
72    | B.null b  = ctx
73    | otherwise = hashUpdates ctx [b]
74
75-- | Update the context with a list of strict bytestring,
76-- and return a new context with the updates.
77hashUpdates :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba)
78            => Context a
79            -> [ba]
80            -> Context a
81hashUpdates c l
82    | null ls   = c
83    | otherwise = Context $ B.copyAndFreeze c $ \(ctx :: Ptr (Context a)) ->
84        mapM_ (\b -> B.withByteArray b $ \d -> hashInternalUpdate ctx d (fromIntegral $ B.length b)) ls
85  where
86    ls = filter (not . B.null) l
87
88-- | Finalize a context and return a digest.
89hashFinalize :: forall a . HashAlgorithm a
90             => Context a
91             -> Digest a
92hashFinalize !c =
93    Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \(dig :: Ptr (Digest a)) -> do
94        ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig
95        return ()
96
97-- | Initialize a new context for a specified hash algorithm
98hashInitWith :: HashAlgorithm alg => alg -> Context alg
99hashInitWith _ = hashInit
100
101-- | Run the 'hash' function but takes an explicit hash algorithm parameter
102hashWith :: (ByteArrayAccess ba, HashAlgorithm alg) => alg -> ba -> Digest alg
103hashWith _ = hash
104
105-- | Try to transform a bytearray into a Digest of specific algorithm.
106--
107-- If the digest is not the right size for the algorithm specified, then
108-- Nothing is returned.
109digestFromByteString :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba) => ba -> Maybe (Digest a)
110digestFromByteString = from undefined
111  where
112        from :: a -> ba -> Maybe (Digest a)
113        from alg bs
114            | B.length bs == (hashDigestSize alg) = Just $ Digest $ unsafeDoIO $ copyBytes bs
115            | otherwise                           = Nothing
116
117        copyBytes :: ba -> IO (Block Word8)
118        copyBytes ba = do
119            muArray <- new count
120            B.withByteArray ba $ \ptr -> copyFromPtr ptr muArray 0 count
121            unsafeFreeze muArray
122          where
123            count = CountOf (B.length ba)
124