1-- |
2-- Module      : Crypto.ConstructHash.MiyaguchiPreneel
3-- License     : BSD-style
4-- Maintainer  : Kei Hibino <ex8k.hibino@gmail.com>
5-- Stability   : experimental
6-- Portability : unknown
7--
8-- Provide the hash function construction method from block cipher
9-- <https://en.wikipedia.org/wiki/One-way_compression_function>
10--
11{-# LANGUAGE GeneralizedNewtypeDeriving #-}
12module Crypto.ConstructHash.MiyaguchiPreneel
13       ( compute, compute'
14       , MiyaguchiPreneel
15       ) where
16
17import           Data.List (foldl')
18
19import           Crypto.Data.Padding (pad, Format (ZERO))
20import           Crypto.Cipher.Types
21import           Crypto.Error (throwCryptoError)
22import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes)
23import qualified Crypto.Internal.ByteArray as B
24
25
26newtype MiyaguchiPreneel a = MP Bytes
27    deriving (ByteArrayAccess)
28
29instance Eq (MiyaguchiPreneel a) where
30    MP b1 == MP b2  =  B.constEq b1 b2
31
32
33-- | Compute Miyaguchi-Preneel one way compress using the supplied block cipher.
34compute' :: (ByteArrayAccess bin, BlockCipher cipher)
35         => (Bytes -> cipher)       -- ^ key build function to compute Miyaguchi-Preneel. care about block-size and key-size
36         -> bin                     -- ^ input message
37         -> MiyaguchiPreneel cipher -- ^ output tag
38compute' g = MP . foldl' (step $ g) (B.replicate bsz 0) . chunks . pad (ZERO bsz) . B.convert
39  where
40    bsz = blockSize ( g B.empty {- dummy to get block size -} )
41    chunks msg
42      | B.null msg  =  []
43      | otherwise  =   (hd :: Bytes) : chunks tl
44      where
45        (hd, tl) = B.splitAt bsz msg
46
47-- | Compute Miyaguchi-Preneel one way compress using the inferred block cipher.
48--   Only safe when KEY-SIZE equals to BLOCK-SIZE.
49--
50--   Simple usage /mp' msg :: MiyaguchiPreneel AES128/
51compute :: (ByteArrayAccess bin, BlockCipher cipher)
52        => bin                     -- ^ input message
53        -> MiyaguchiPreneel cipher -- ^ output tag
54compute = compute' $ throwCryptoError . cipherInit
55
56-- | computation step of Miyaguchi-Preneel
57step :: (ByteArray ba, BlockCipher k)
58     => (ba -> k)
59     -> ba
60     -> ba
61     -> ba
62step g iv msg =
63    ecbEncrypt k msg `bxor` iv `bxor` msg
64  where
65    k = g iv
66
67bxor :: ByteArray ba => ba -> ba -> ba
68bxor = B.xor
69