diff --git a/Crypto/Cipher/Types/Base.hs b/Crypto/Cipher/Types/Base.hs index 3843a6c..d35fb06 100644 --- a/Crypto/Cipher/Types/Base.hs +++ b/Crypto/Cipher/Types/Base.hs @@ -10,7 +10,6 @@ {-# LANGUAGE ExistentialQuantification #-} module Crypto.Cipher.Types.Base ( KeySizeSpecifier(..) - , IV(..) , Cipher(..) , AuthTag(..) , AEADMode(..) @@ -35,11 +34,6 @@ data KeySizeSpecifier = -- | Offset inside an XTS data unit, measured in block size. type DataUnitOffset = Word32 --- | an IV parametrized by the cipher -data IV c = forall byteArray . ByteArray byteArray => IV byteArray - -instance ByteArray (IV c) where - -- | Authentification Tag for AE cipher mode newtype AuthTag = AuthTag ByteString deriving (Show) diff --git a/Crypto/Cipher/Types/Block.hs b/Crypto/Cipher/Types/Block.hs index 20c9c39..0dbe414 100644 --- a/Crypto/Cipher/Types/Block.hs +++ b/Crypto/Cipher/Types/Block.hs @@ -15,7 +15,7 @@ module Crypto.Cipher.Types.Block -- * BlockCipher BlockCipher(..) -- * initialization vector (IV) - , IV + , IV(..) , makeIV , nullIV , ivAdd @@ -45,6 +45,12 @@ import Crypto.Internal.ByteArray import Foreign.Ptr import Foreign.Storable +-- | an IV parametrized by the cipher +data IV c = forall byteArray . ByteArray byteArray => IV byteArray + +instance BlockCipher c => ByteArray (IV c) where + + type XTS cipher = (cipher, cipher) -> IV cipher -- ^ Usually represent the Data Unit (e.g. disk sector) -> DataUnitOffset -- ^ Offset in the data unit in number of blocks @@ -161,7 +167,26 @@ nullIV = toIV undefined -- -- Assume the IV is in Big Endian format. ivAdd :: BlockCipher c => IV c -> Int -> IV c -ivAdd i _ = i +ivAdd (IV b) i = IV $ copy b + where copy :: ByteArray bs => bs -> bs + copy bs = byteArrayCopyAndFreeze bs $ \p -> do + let until0 accu = do + r <- loop accu (byteArrayLength bs - 1) p + case r of + 0 -> return () + _ -> until0 r + until0 i + + 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 {- ivAdd (IV b) i = IV $ snd $ B.mapAccumR addCarry i b where addCarry :: Int -> Word8 -> (Int, Word8) diff --git a/Crypto/Internal/ByteArray.hs b/Crypto/Internal/ByteArray.hs index 3db24e7..85971bc 100644 --- a/Crypto/Internal/ByteArray.hs +++ b/Crypto/Internal/ByteArray.hs @@ -14,6 +14,7 @@ module Crypto.Internal.ByteArray ( ByteArray(..) , byteArrayAllocAndFreeze , empty + , byteArrayCopyAndFreeze , byteArraySplit , byteArrayXor , byteArrayConcat @@ -99,3 +100,9 @@ byteArrayConcat allBs = byteArrayAllocAndFreeze total (loop allBs) let sz = byteArrayLength b withByteArray b $ \p -> bufCopy dst p sz loop bs (dst `plusPtr` sz) + +byteArrayCopyAndFreeze :: ByteArray bs => bs -> (Ptr p -> IO ()) -> bs +byteArrayCopyAndFreeze bs f = + byteArrayAllocAndFreeze (byteArrayLength bs) $ \d -> do + withByteArray bs $ \s -> bufCopy d s (byteArrayLength bs) + f (castPtr d)