diff --git a/Crypto/Cipher/Types/Block.hs b/Crypto/Cipher/Types/Block.hs index 90d90bc..ff3fedd 100644 --- a/Crypto/Cipher/Types/Block.hs +++ b/Crypto/Cipher/Types/Block.hs @@ -167,24 +167,17 @@ nullIV = toIV undefined ivAdd :: BlockCipher c => IV c -> Int -> IV c ivAdd (IV b) i = IV $ copy b where copy :: ByteArray bs => bs -> bs - copy bs = B.copyAndFreeze bs $ \p -> do - let until0 accu = do - r <- loop accu (B.length bs - 1) p - case r of - 0 -> return () - _ -> until0 r - until0 i + copy bs = B.copyAndFreeze bs $ loop i (B.length bs - 1) - loop :: Int -> Int -> Ptr Word8 -> IO Int - loop 0 _ _ = return 0 - loop acc ofs p = do - v <- peek (p `plusPtr` ofs) :: IO Word8 - let accv = acc + fromIntegral v - (hi,lo) = accv `divMod` 256 - poke (p `plusPtr` ofs) (fromIntegral lo :: Word8) - if ofs == 0 - then return hi - else loop hi (ofs - 1) p + loop :: Int -> Int -> Ptr Word8 -> IO () + loop acc ofs p + | ofs < 0 = return () + | otherwise = do + v <- peek (p `plusPtr` ofs) :: IO Word8 + let accv = acc + fromIntegral v + (hi,lo) = accv `divMod` 256 + poke (p `plusPtr` ofs) (fromIntegral lo :: Word8) + loop hi (ofs - 1) p cbcEncryptGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba cbcEncryptGeneric cipher ivini input = mconcat $ doEnc ivini $ chunk (blockSize cipher) input diff --git a/tests/BlockCipher.hs b/tests/BlockCipher.hs index 8d0d020..3243f70 100644 --- a/tests/BlockCipher.hs +++ b/tests/BlockCipher.hs @@ -17,7 +17,7 @@ import Data.Maybe import Crypto.Error import Crypto.Cipher.Types import Data.ByteArray as B hiding (pack, null) -import qualified Data.ByteString as B +import qualified Data.ByteString as B hiding (all) ------------------------------------------------------------------------ -- KAT @@ -437,11 +437,33 @@ testModes cipher = (testBlockCipherBasic cipher ++ testBlockCipherModes cipher ++ testBlockCipherAEAD cipher) ] +-- | Test IV arithmetic (based on the cipher block size) +testIvArith :: BlockCipher a => a -> [TestTree] +testIvArith cipher = + [ testCase "nullIV is null" $ + True @=? B.all (== 0) (ivNull cipher) + , testProperty "ivAdd is linear" $ \a b -> do + iv <- generateIvFromCipher cipher + return $ ivAdd iv (a + b) `propertyEq` ivAdd (ivAdd iv a) b + ] + where + ivNull :: BlockCipher a => a -> IV a + ivNull = const nullIV + + -- uses IV pattern <00 .. 00 FF .. FF> to test carry propagation + generateIvFromCipher :: BlockCipher a => a -> Gen (IV a) + generateIvFromCipher c = do + let n = blockSize c + i <- choose (0, n) + let zeros = Prelude.replicate (n - i) 0x00 + ones = Prelude.replicate i 0xFF + return $ cipherMakeIV c (B.pack $ zeros ++ ones) + -- | Return tests for a specific blockcipher and a list of KATs testBlockCipher :: BlockCipher a => KATs -> a -> TestTree testBlockCipher kats cipher = testGroup (cipherName cipher) ( (if kats == defaultKATs then [] else [testKATs kats cipher]) - ++ testModes cipher + ++ testModes cipher ++ testIvArith cipher ) cipherMakeKey :: Cipher cipher => cipher -> ByteString -> Key cipher