From 8fb59dfc1975d95982f5019b257b3a61af7f7a35 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= <olivier.cheron@gmail.com>
Date: Mon, 22 May 2017 19:34:42 +0200
Subject: [PATCH 1/3] Test IV arithmetic

With emphasis on ivAdd overflow behaviour.
---
 tests/BlockCipher.hs | 26 ++++++++++++++++++++++++--
 1 file changed, 24 insertions(+), 2 deletions(-)

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

From 07592ab2375c762bc997b166b513b44402843c9a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= <olivier.cheron@gmail.com>
Date: Mon, 22 May 2017 19:34:42 +0200
Subject: [PATCH 2/3] Fix ivAdd overflow behaviour

---
 Crypto/Cipher/Types/Block.hs | 17 +++++------------
 1 file changed, 5 insertions(+), 12 deletions(-)

diff --git a/Crypto/Cipher/Types/Block.hs b/Crypto/Cipher/Types/Block.hs
index 90d90bc..49dafe9 100644
--- a/Crypto/Cipher/Types/Block.hs
+++ b/Crypto/Cipher/Types/Block.hs
@@ -36,6 +36,7 @@ module Crypto.Cipher.Types.Block
     --, cfb8Decrypt
     ) where
 
+import           Control.Monad (unless)
 import           Data.Word
 import           Data.Monoid
 import           Crypto.Error
@@ -167,24 +168,16 @@ 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 :: Int -> Int -> Ptr Word8 -> IO ()
+        loop 0   _   _ = return ()
         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
+            unless (ofs == 0) $ 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

From edd5d94bd4b628fd28b49b48c241a48973c06dc4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= <olivier.cheron@gmail.com>
Date: Wed, 31 May 2017 23:31:29 +0200
Subject: [PATCH 3/3] Make ivAdd more constant-time

All IV bytes are processed even if accumulator is zero.
---
 Crypto/Cipher/Types/Block.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/Crypto/Cipher/Types/Block.hs b/Crypto/Cipher/Types/Block.hs
index 49dafe9..ff3fedd 100644
--- a/Crypto/Cipher/Types/Block.hs
+++ b/Crypto/Cipher/Types/Block.hs
@@ -36,7 +36,6 @@ module Crypto.Cipher.Types.Block
     --, cfb8Decrypt
     ) where
 
-import           Control.Monad (unless)
 import           Data.Word
 import           Data.Monoid
 import           Crypto.Error
@@ -171,13 +170,14 @@ ivAdd (IV b) i = IV $ copy b
         copy bs = B.copyAndFreeze bs $ loop i (B.length bs - 1)
 
         loop :: Int -> Int -> Ptr Word8 -> IO ()
-        loop 0   _   _ = return ()
-        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)
-            unless (ofs == 0) $ loop hi (ofs - 1) p
+        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