diff --git a/Crypto/ConstructHash/MiyaguchiPreneel.hs b/Crypto/ConstructHash/MiyaguchiPreneel.hs new file mode 100644 index 0000000..fe3df1c --- /dev/null +++ b/Crypto/ConstructHash/MiyaguchiPreneel.hs @@ -0,0 +1,68 @@ +-- | +-- Module : Crypto.ConstructHash.MiyaguchiPreneel +-- License : BSD-style +-- Maintainer : Kei Hibino +-- Stability : experimental +-- Portability : unknown +-- +-- provide the hash function construction method from block cipher +-- +-- +{-# 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 diff --git a/Crypto/Data/Padding.hs b/Crypto/Data/Padding.hs index 095a2de..66ed160 100644 --- a/Crypto/Data/Padding.hs +++ b/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 diff --git a/cryptonite.cabal b/cryptonite.cabal index 09e3f38..84b17ef 100644 --- a/cryptonite.cabal +++ b/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 diff --git a/tests/KAT_MiyaguchiPreneel.hs b/tests/KAT_MiyaguchiPreneel.hs new file mode 100644 index 0000000..163e434 --- /dev/null +++ b/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 ] diff --git a/tests/Padding.hs b/tests/Padding.hs index 7a6e7fd..f7be773 100644 --- a/tests/Padding.hs +++ b/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) ] diff --git a/tests/Tests.hs b/tests/Tests.hs index 777cef3..9d2c017 100644 --- a/tests/Tests.hs +++ b/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