{-# LANGUAGE CPP #-}
{-# LANGUAGE PackageImports #-}
-- |
-- Module      : Crypto.Hash
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- Generalized cryptographic hash interface, that you can use with cryptographic hash
-- algorithm that belong to the HashAlgorithm type class.
--
-- > import Crypto.Hash
-- >
-- > sha1 :: ByteString -> Digest SHA1
-- > sha1 = hash
-- >
-- > hexSha3_512 :: ByteString -> String
-- > hexSha3_512 bs = show (hash bs :: Digest SHA3_512)
--
module Crypto.Hash
    (
    -- * Types
      HashAlgorithm(..)
    , HashFunctionBS
    , HashFunctionLBS
    , Context
    , Digest
    -- * Functions
    , digestToByteString
    , digestToHexByteString
    , hash
    , hashlazy
    , hashUpdate
    , hashInitAlg
    -- * hash algorithms
    , H.MD2(..)
    , H.MD4(..)
    , H.MD5(..)
    , H.SHA1(..)
    , H.SHA224(..)
    , H.SHA256(..)
    , H.SHA384(..)
    , H.SHA512(..)
    , H.RIPEMD160(..)
    , H.Tiger(..)
    , H.SHA3_224(..)
    , H.SHA3_256(..)
    , H.SHA3_384(..)
    , H.SHA3_512(..)
    , H.Skein256_224(..)
    , H.Skein256_256(..)
    , H.Skein512_224(..)
    , H.Skein512_256(..)
    , H.Skein512_384(..)
    , H.Skein512_512(..)
    , H.Whirlpool(..)
    -- * MAC algorithms
    , HMAC(..)
    , hmac
    , hmacAlg
    ) where

import Crypto.Hash.Types
import Data.ByteString (ByteString)
import Data.Byteable
import Data.Bits (xor)
import qualified Data.ByteString as B
import qualified Data.ByteArray.Encoding as B
import qualified Data.ByteString.Lazy as L

import qualified "cryptonite" Crypto.Hash as H

-- | Alias to a single pass hash function that operate on a strict bytestring
type HashFunctionBS a = ByteString -> Digest a

-- | Alias to a single pass hash function that operate on a lazy bytestring
type HashFunctionLBS a = L.ByteString -> Digest a

-- | run hashUpdates on one single bytestring and return the updated context.
hashUpdate :: HashAlgorithm a => Context a -> ByteString -> Context a
hashUpdate :: Context a -> ByteString -> Context a
hashUpdate ctx :: Context a
ctx b :: ByteString
b = Context a -> [ByteString] -> Context a
forall a. HashAlgorithm a => Context a -> [ByteString] -> Context a
hashUpdates Context a
ctx [ByteString
b]

-- | Hash a strict bytestring into a digest.
hash :: HashAlgorithm a => ByteString -> Digest a
hash :: ByteString -> Digest a
hash bs :: ByteString
bs = Context a -> Digest a
forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize (Context a -> Digest a) -> Context a -> Digest a
forall a b. (a -> b) -> a -> b
$ Context a -> ByteString -> Context a
forall a. HashAlgorithm a => Context a -> ByteString -> Context a
hashUpdate Context a
forall a. HashAlgorithm a => Context a
hashInit ByteString
bs

-- | Hash a lazy bytestring into a digest.
hashlazy :: HashAlgorithm a => L.ByteString -> Digest a
hashlazy :: ByteString -> Digest a
hashlazy lbs :: ByteString
lbs = Context a -> Digest a
forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize (Context a -> Digest a) -> Context a -> Digest a
forall a b. (a -> b) -> a -> b
$ Context a -> [ByteString] -> Context a
forall a. HashAlgorithm a => Context a -> [ByteString] -> Context a
hashUpdates Context a
forall a. HashAlgorithm a => Context a
hashInit (ByteString -> [ByteString]
L.toChunks ByteString
lbs)

-- | Return the hexadecimal (base16) bytestring of the digest
digestToHexByteString :: Digest a -> ByteString
digestToHexByteString :: Digest a -> ByteString
digestToHexByteString = Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
B.convertToBase Base
B.Base16 (ByteString -> ByteString)
-> (Digest a -> ByteString) -> Digest a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes

-- | Class representing hashing algorithms.
--
-- The hash algorithm is built over 3 primitives:
--
-- * init     : create a new hashing context
--
-- * updates  : update the hashing context with some strict bytestrings
--              and return the new context
--
-- * finalize : finalize the context into a digest
--
class HashAlgorithm a where
    -- | Block size in bytes the hash algorithm operates on
    hashBlockSize :: Context a -> Int

    -- | Initialize a new context for this hash algorithm
    hashInit     :: Context a

    -- | Update the context with a list of strict bytestring,
    -- and return a new context with the updates.
    hashUpdates  :: Context a -> [ByteString] -> Context a

    -- | Finalize a context and return a digest.
    hashFinalize :: Context a -> Digest a

    -- | Try to convert a binary digest bytestring to a digest.
    digestFromByteString :: ByteString -> Maybe (Digest a)


#define DEFINE_INSTANCE(NAME, MODULENAME, BLOCKSIZE) \
instance HashAlgorithm H.NAME where \
    { hashInit = Context $ H.hashInit \
    ; hashBlockSize ~(Context _) = BLOCKSIZE \
    ; hashUpdates (Context c) bs = Context $ H.hashUpdates c bs \
    ; hashFinalize (Context c) = Digest $ H.hashFinalize c \
    ; digestFromByteString bs = Digest `fmap` H.digestFromByteString bs \
    };

#define DEFINE_INSTANCE_LEN(NAME, MODULENAME, LEN, BLOCKSIZE) \
instance HashAlgorithm H.NAME where \
    { hashInit = Context $ H.hashInit \
    ; hashBlockSize ~(Context _) = BLOCKSIZE \
    ; hashUpdates (Context c) bs = Context $ H.hashUpdates c bs \
    ; hashFinalize (Context c) = Digest $ H.hashFinalize c \
    ; digestFromByteString bs = Digest `fmap` H.digestFromByteString bs \
    };

-- | MD2 cryptographic hash
DEFINE_INSTANCE(MD2, MD2, 16)
-- | MD4 cryptographic hash
DEFINE_INSTANCE(MD4, MD4, 64)
-- | MD5 cryptographic hash
DEFINE_INSTANCE(MD5, MD5, 64)
-- | SHA1 cryptographic hash
DEFINE_INSTANCE(SHA1, SHA1, 64)
-- | SHA224 cryptographic hash
DEFINE_INSTANCE(SHA224, SHA224, 64)
-- | SHA256 cryptographic hash
DEFINE_INSTANCE(SHA256, SHA256, 64)
-- | SHA384 cryptographic hash
DEFINE_INSTANCE(SHA384, SHA384, 128)
-- | SHA512 cryptographic hash
DEFINE_INSTANCE(SHA512, SHA512, 128)

-- | RIPEMD160 cryptographic hash
DEFINE_INSTANCE(RIPEMD160, RIPEMD160, 64)
-- | Whirlpool cryptographic hash
DEFINE_INSTANCE(Whirlpool, Whirlpool, 64)
-- | Tiger cryptographic hash
DEFINE_INSTANCE(Tiger, Tiger, 64)

-- | SHA3 (224 bits version) cryptographic hash
DEFINE_INSTANCE_LEN(SHA3_224, SHA3, 224, 144)
-- | SHA3 (256 bits version) cryptographic hash
DEFINE_INSTANCE_LEN(SHA3_256, SHA3, 256, 136)
-- | SHA3 (384 bits version) cryptographic hash
DEFINE_INSTANCE_LEN(SHA3_384, SHA3, 384, 104)
-- | SHA3 (512 bits version) cryptographic hash
DEFINE_INSTANCE_LEN(SHA3_512, SHA3, 512, 72)

-- | Skein256 (224 bits version) cryptographic hash
DEFINE_INSTANCE_LEN(Skein256_224, Skein256, 224, 32)
-- | Skein256 (256 bits version) cryptographic hash
DEFINE_INSTANCE_LEN(Skein256_256, Skein256, 256, 32)

-- | Skein512 (224 bits version) cryptographic hash
DEFINE_INSTANCE_LEN(Skein512_224, Skein512, 224, 64)
-- | Skein512 (256 bits version) cryptographic hash
DEFINE_INSTANCE_LEN(Skein512_256, Skein512, 256, 64)
-- | Skein512 (384 bits version) cryptographic hash
DEFINE_INSTANCE_LEN(Skein512_384, Skein512, 384, 64)
-- | Skein512 (512 bits version) cryptographic hash
DEFINE_INSTANCE_LEN(Skein512_512, Skein512, 512, 64)

-- | Initialize a new context for a specified hash algorithm
hashInitAlg :: HashAlgorithm alg => alg -> Context alg
hashInitAlg :: alg -> Context alg
hashInitAlg _ = Context alg
forall a. HashAlgorithm a => Context a
hashInit

-- | Represent an HMAC that is a phantom type with the hash used to produce the mac.
--
-- The Eq instance is constant time.
newtype HMAC a = HMAC { HMAC a -> Digest a
hmacGetDigest :: Digest a }

instance Byteable (HMAC a) where
    toBytes :: HMAC a -> ByteString
toBytes (HMAC b :: Digest a
b) = Digest a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes Digest a
b

instance Eq (HMAC a) where
    (HMAC b1 :: Digest a
b1) == :: HMAC a -> HMAC a -> Bool
== (HMAC b2 :: Digest a
b2) = ByteString -> ByteString -> Bool
forall a. Byteable a => a -> a -> Bool
constEqBytes (Digest a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes Digest a
b1) (Digest a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes Digest a
b2)

-- | compute a MAC using the supplied hashing function
hmac :: HashAlgorithm a
     => ByteString       -- ^ Secret key
     -> ByteString       -- ^ Message to MAC
     -> HMAC a
hmac :: ByteString -> ByteString -> HMAC a
hmac secret :: ByteString
secret msg :: ByteString
msg = Context a -> HMAC a
forall a. HashAlgorithm a => Context a -> HMAC a
doHMAC Context a
forall a. HashAlgorithm a => Context a
hashInit
  where doHMAC :: HashAlgorithm a => Context a -> HMAC a
        doHMAC :: Context a -> HMAC a
doHMAC ctxInit :: Context a
ctxInit = Digest a -> HMAC a
forall a. Digest a -> HMAC a
HMAC (Digest a -> HMAC a) -> Digest a -> HMAC a
forall a b. (a -> b) -> a -> b
$ ByteString -> Digest a
hashF (ByteString -> Digest a) -> ByteString -> Digest a
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
B.append ByteString
opad (Digest a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes (Digest a -> ByteString) -> Digest a -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Digest a
hashF (ByteString -> Digest a) -> ByteString -> Digest a
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
B.append ByteString
ipad ByteString
msg)
          where opad :: ByteString
opad = (Word8 -> Word8) -> ByteString -> ByteString
B.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor 0x5c) ByteString
k'
                ipad :: ByteString
ipad = (Word8 -> Word8) -> ByteString -> ByteString
B.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor 0x36) ByteString
k'

                k' :: ByteString
k'  = ByteString -> ByteString -> ByteString
B.append ByteString
kt ByteString
pad
                kt :: ByteString
kt  = if ByteString -> Int
B.length ByteString
secret Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
blockSize then Digest a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes (ByteString -> Digest a
hashF ByteString
secret) else ByteString
secret
                pad :: ByteString
pad = Int -> Word8 -> ByteString
B.replicate (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
blockSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
kt) 0
                hashF :: ByteString -> Digest a
hashF = Context a -> Digest a
forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize (Context a -> Digest a)
-> (ByteString -> Context a) -> ByteString -> Digest a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> ByteString -> Context a
forall a. HashAlgorithm a => Context a -> ByteString -> Context a
hashUpdate Context a
ctxInit
                blockSize :: Int
blockSize = Context a -> Int
forall a. HashAlgorithm a => Context a -> Int
hashBlockSize Context a
ctxInit

-- | compute a HMAC using a specified algorithm
hmacAlg :: HashAlgorithm a
        => a           -- ^ the hash algorithm the actual value is unused.
        -> ByteString  -- ^ Secret key
        -> ByteString  -- ^ Message to MAC
        -> HMAC a
hmacAlg :: a -> ByteString -> ByteString -> HMAC a
hmacAlg _ secret :: ByteString
secret msg :: ByteString
msg = ByteString -> ByteString -> HMAC a
forall a. HashAlgorithm a => ByteString -> ByteString -> HMAC a
hmac ByteString
secret ByteString
msg