Merge pull request #77 from khibino/mp

Adding miyaguchi-preneel hash construction

Crypto/ConstructHash/MiyaguchiPreneel.hs

@@ -0,0 +1,68 @@
+-- |
+-- Module      : Crypto.ConstructHash.MiyaguchiPreneel
+-- License     : BSD-style
+-- Maintainer  : Kei Hibino <ex8k.hibino@gmail.com>
+-- Stability   : experimental
+-- Portability : unknown
+--
+-- provide the hash function construction method from block cipher
+-- <https://en.wikipedia.org/wiki/One-way_compression_function>
+--
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Crypto.ConstructHash.MiyaguchiPreneel
+       ( compute, compute'
+       , MiyaguchiPreneel
+       ) where
+
+import           Data.List (foldl')
+
+import           Crypto.Data.Padding (pad, Format (ZERO))
+import           Crypto.Cipher.Types
+import           Crypto.Error (throwCryptoError)
+import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes)
+import qualified Crypto.Internal.ByteArray as B
+
+
+newtype MiyaguchiPreneel a = MP Bytes
+    deriving (ByteArrayAccess)
+
+instance Eq (MiyaguchiPreneel a) where
+    MP b1 == MP b2  =  B.constEq b1 b2
+
+
+-- | Compute Miyaguchi-Preneel one way compress using the supplied block cipher.
+compute' :: (ByteArrayAccess bin, BlockCipher cipher)
+         => (Bytes -> cipher)       -- ^ key build function to compute Miyaguchi-Preneel. care about block-size and key-size
+         -> bin                     -- ^ input message
+         -> MiyaguchiPreneel cipher -- ^ output tag
+compute' g = MP . foldl' (step $ g) (B.replicate bsz 0) . chunks . pad (ZERO bsz) . B.convert
+  where
+    bsz = blockSize ( g B.empty {- dummy to get block size -} )
+    chunks msg
+      | B.null msg  =  []
+      | otherwise  =   (hd :: Bytes) : chunks tl
+      where
+        (hd, tl) = B.splitAt bsz msg
+
+-- | Compute Miyaguchi-Preneel one way compress using the infered block cipher.
+--   Only safe when KEY-SIZE equals to BLOCK-SIZE.
+--
+--   Simple usage /mp' msg :: MiyaguchiPreneel AES128/
+compute :: (ByteArrayAccess bin, BlockCipher cipher)
+        => bin                     -- ^ input message
+        -> MiyaguchiPreneel cipher -- ^ output tag
+compute = compute' $ throwCryptoError . cipherInit
+
+-- | computation step of Miyaguchi-Preneel
+step :: (ByteArray ba, BlockCipher k)
+     => (ba -> k)
+     -> ba
+     -> ba
+     -> ba
+step g iv msg =
+    ecbEncrypt k msg `bxor` iv `bxor` msg
+  where
+    k = g iv
+
+bxor :: ByteArray ba => ba -> ba -> ba
+bxor = B.xor

Crypto/Data/Padding.hs

@@ -21,6 +21,7 @@ import qualified Data.ByteArray as B
 data Format =
       PKCS5     -- ^ PKCS5: PKCS7 with hardcoded size of 8
     | PKCS7 Int -- ^ PKCS7 with padding size between 1 and 255
+    | ZERO Int  -- ^ zero padding with block size
     deriving (Show, Eq)
 
 -- | Apply some pad to a bytearray
@@ -30,6 +31,15 @@ pad (PKCS7 sz) bin = bin `B.append` paddingString
   where
     paddingString = B.replicate paddingByte (fromIntegral paddingByte)
     paddingByte   = sz - (B.length bin `mod` sz)
+pad (ZERO sz)  bin = bin `B.append` paddingString
+  where
+    paddingString = B.replicate paddingSz 0
+    paddingSz
+      | len == 0   =  sz
+      | m == 0     =  0
+      | otherwise  =  sz - m
+    m = len `mod` sz
+    len = B.length bin
 
 -- | Try to remove some padding from a bytearray.
 unpad :: ByteArray byteArray => Format -> byteArray -> Maybe byteArray
@@ -46,3 +56,10 @@ unpad (PKCS7 sz) bin
     paddingSz   = fromIntegral paddingByte
     (content, padding) = B.splitAt (len - paddingSz) bin
     paddingWitness     = B.replicate paddingSz paddingByte :: Bytes
+unpad (ZERO sz)  bin
+    | len == 0                           = Nothing
+    | (len `mod` sz) /= 0                = Nothing
+    | B.index bin (len - 1) /= 0         = Just bin
+    | otherwise                          = Nothing
+  where
+    len         = B.length bin

cryptonite.cabal

@@ -95,6 +95,7 @@ Library
                      Crypto.Cipher.Salsa
                      Crypto.Cipher.TripleDES
                      Crypto.Cipher.Types
+                     Crypto.ConstructHash.MiyaguchiPreneel
                      Crypto.Data.AFIS
                      Crypto.Data.Padding
                      Crypto.Error
@@ -310,6 +311,7 @@ Test-Suite test-cryptonite
                      KAT_Ed25519
                      KAT_CMAC
                      KAT_HMAC
+                     KAT_MiyaguchiPreneel
                      KAT_PBKDF2
                      KAT_PubKey.DSA
                      KAT_PubKey.ECC

tests/KAT_MiyaguchiPreneel.hs

@@ -0,0 +1,50 @@
+
+module KAT_MiyaguchiPreneel (tests) where
+
+import           Crypto.Cipher.AES (AES128)
+import           Crypto.ConstructHash.MiyaguchiPreneel as MiyaguchiPreneel
+
+import           Imports
+
+import           Data.Char (digitToInt)
+import qualified Data.ByteString.Char8 as B8
+import qualified Data.ByteArray as B
+import Data.ByteArray.Encoding (Base (Base16), convertFromBase)
+
+
+runMP128 :: ByteString -> ByteString
+runMP128 s = B.convert (MiyaguchiPreneel.compute s :: MiyaguchiPreneel AES128)
+
+hxs :: String -> ByteString
+hxs = either (error . ("hxs:" ++)) id . convertFromBase Base16
+      . B8.pack . filter (/= ' ')
+
+gAES128 :: TestTree
+gAES128 =
+  igroup "aes128"
+  [ runMP128  B8.empty
+    @?=       hxs "66e94bd4 ef8a2c3b 884cfa59 ca342b2e"
+  , runMP128 (hxs "01000000 00000000 00000000 00000000")
+    @?=       hxs "46711816 e91d6ff0 59bbbf2b f58e0fd3"
+  , runMP128 (hxs "00000000 00000000 00000000 00000001")
+    @?=       hxs "58e2fcce fa7e3061 367f1d57 a4e7455b"
+  , runMP128     (hxs $
+                  "00000000 00000000 00000000 00000000" ++
+                  "01")
+    @?=       hxs "a5ff35ae 097adf5d 646abf5e bf4c16f4"
+  ]
+
+igroup :: TestName -> [Assertion] -> TestTree
+igroup nm = testGroup nm . zipWith (flip ($)) [1..] . map icase
+  where
+    icase c i = testCase (show (i :: Int)) c
+
+vectors :: TestTree
+vectors =
+  testGroup "KATs"
+  [ gAES128 ]
+
+tests :: TestTree
+tests =
+    testGroup "MiyaguchiPreneel"
+    [ vectors ]

tests/Padding.hs

@@ -13,6 +13,12 @@ cases =
     , ("xyze", 5, "xyze\x01")
     ]
 
+zeroCases =
+    [ ("", 4, "\NUL\NUL\NUL\NUL", Nothing)
+    , ("abcdef", 8, "abcdef\NUL\NUL", Nothing)
+    , ("0123456789abcdef", 16, "0123456789abcdef", Just "0123456789abcdef")
+    ]
+
 --instance Arbitrary where
 
 testPad :: Int -> (B.ByteString, Int, B.ByteString) -> TestTree
@@ -21,6 +27,13 @@ testPad n (inp, sz, padded) =
                                          , eqTest "unpadded" (Just inp) (unpad (PKCS7 sz) padded)
                                          ]
 
+testZeroPad :: Int -> (B.ByteString, Int, B.ByteString, Maybe B.ByteString) -> TestTree
+testZeroPad n (inp, sz, padded, unpadded) =
+    testCase (show n) $ propertyHoldCase [ eqTest "padded" padded (pad (ZERO sz) inp)
+                                         , eqTest "unpadded" unpadded (unpad (ZERO sz) padded)
+                                         ]
+
 tests = testGroup "Padding"
     [ testGroup "Cases" $ map (uncurry testPad) (zip [1..] cases)
+    , testGroup "ZeroCases" $ map (uncurry testZeroPad) (zip [1..] zeroCases)
     ]

tests/Tests.hs

@@ -10,6 +10,7 @@ import qualified Poly1305
 import qualified Salsa
 import qualified ChaCha
 import qualified ChaChaPoly1305
+import qualified KAT_MiyaguchiPreneel
 import qualified KAT_CMAC
 import qualified KAT_HMAC
 import qualified KAT_HKDF
@@ -34,6 +35,9 @@ tests = testGroup "cryptonite"
     [ Number.tests
     , Hash.tests
     , Padding.tests
+    , testGroup "ConstructHash"
+        [ KAT_MiyaguchiPreneel.tests
+        ]
     , testGroup "MAC"
         [ Poly1305.tests
         , KAT_CMAC.tests