-- |
-- Module : Crypto.Cipher.Types.Block
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : Stable
-- Portability : Excellent
--
-- block cipher basic types
--
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ViewPatterns #-}
module Crypto.Cipher.Types.BlockIO
( BlockCipherIO(..)
, PtrDest
, PtrSource
, PtrIV
, BufferLength
, onBlock
) where
import Control.Applicative
import Data.Word
import Data.ByteString (ByteString)
import qualified Data.ByteString.Internal as B (fromForeignPtr, memcpy)
import Data.Byteable
import Data.Bits (xor, Bits)
import Foreign.Storable (poke, peek, Storable)
--import Foreign.Ptr (plusPtr, Ptr, castPtr, nullPtr)
import Crypto.Cipher.Types.Block
import Foreign.Ptr
import Foreign.ForeignPtr (newForeignPtr_)
-- | pointer to the destination data
type PtrDest = Ptr Word8
-- | pointer to the source data
type PtrSource = Ptr Word8
-- | pointer to the IV data
type PtrIV = Ptr Word8
-- | Length of the pointed data
type BufferLength = Word32
-- | Symmetric block cipher class, mutable API
class BlockCipher cipher => BlockCipherIO cipher where
-- | Encrypt using the ECB mode.
--
-- input need to be a multiple of the blocksize
ecbEncryptMutable :: cipher -> PtrDest -> PtrSource -> BufferLength -> IO ()
-- | Decrypt using the ECB mode.
--
-- input need to be a multiple of the blocksize
ecbDecryptMutable :: cipher -> PtrDest -> PtrSource -> BufferLength -> IO ()
-- | encrypt using the CBC mode.
--
-- input need to be a multiple of the blocksize
cbcEncryptMutable :: cipher -> PtrIV -> PtrDest -> PtrSource -> BufferLength -> IO ()
cbcEncryptMutable = cbcEncryptGeneric
-- | decrypt using the CBC mode.
--
-- input need to be a multiple of the blocksize
cbcDecryptMutable :: cipher -> PtrIV -> PtrDest -> PtrSource -> BufferLength -> IO ()
cbcDecryptMutable = cbcDecryptGeneric
{-
-- | encrypt using the CFB mode.
--
-- input need to be a multiple of the blocksize
cfbEncryptMutable :: cipher -> PtrIV -> PtrDest -> PtrSource -> BufferLength -> IO ()
cfbEncryptMutable = cfbEncryptGeneric
-- | decrypt using the CFB mode.
--
-- input need to be a multiple of the blocksize
cfbDecryptMutable :: cipher -> PtrIV -> PtrDest -> PtrSource -> BufferLength -> IO ()
cfbDecryptMutable = cfbDecryptGeneric
-- | combine using the CTR mode.
--
-- CTR mode produce a stream of randomized data that is combined
-- (by XOR operation) with the input stream.
--
-- encryption and decryption are the same operation.
--
-- input can be of any size
ctrCombineMutable :: cipher -> PtrIV -> PtrDest -> PtrSource -> BufferLength -> IO ()
ctrCombineMutable = ctrCombineGeneric
-- | encrypt using the XTS mode.
--
-- input need to be a multiple of the blocksize
xtsEncryptMutable :: (cipher, cipher) -> PtrIV -> DataUnitOffset -> PtrDest -> PtrSource -> BufferLength -> IO ()
xtsEncryptMutable = xtsEncryptGeneric
-- | decrypt using the XTS mode.
--
-- input need to be a multiple of the blocksize
xtsDecryptMutable :: (cipher, cipher) -> PtrIV -> DataUnitOffset -> PtrDest -> PtrSource -> BufferLength -> IO ()
xtsDecryptMutable = xtsDecryptGeneric
-}
cbcEncryptGeneric :: BlockCipherIO cipher => cipher -> PtrIV -> PtrDest -> PtrSource -> BufferLength -> IO ()
cbcEncryptGeneric cipher = loopBS cipher encrypt
where encrypt bs iv d s = do
mutableXor d iv s bs
ecbEncryptMutable cipher d d (fromIntegral bs)
return s
cbcDecryptGeneric :: BlockCipherIO cipher => cipher -> PtrIV -> PtrDest -> PtrSource -> BufferLength -> IO ()
cbcDecryptGeneric cipher = loopBS cipher decrypt
where decrypt bs iv d s = do
ecbEncryptMutable cipher d s (fromIntegral bs)
-- FIXME only work if s != d
mutableXor d iv d bs
return d
{-
cfbEncryptGeneric :: BlockCipherIO cipher => cipher -> PtrIV -> PtrDest -> PtrSource -> BufferLength -> IO ()
cfbEncryptGeneric cipher = loopBS cipher encrypt
where encrypt bs iv d s = do
ecbEncryptMutable cipher d iv (fromIntegral bs)
mutableXor d d s bs
return d
cfbDecryptGeneric :: BlockCipherIO cipher => cipher -> PtrIV -> PtrDest -> PtrSource -> BufferLength -> IO ()
cfbDecryptGeneric cipher = loopBS cipher decrypt
where decrypt bs iv d s = do
ecbEncryptMutable cipher d iv (fromIntegral bs)
mutableXor d d s bs
return s
ctrCombineGeneric :: BlockCipherIO cipher => cipher -> PtrIV -> PtrDest -> PtrSource -> BufferLength -> IO ()
ctrCombineGeneric cipher ivini dst src len = return () {-B.concat $ doCnt ivini $ chunk (blockSize cipher) input
where doCnt _ [] = []
doCnt iv (i:is) =
let ivEnc = ecbEncrypt cipher (toBytes iv)
in bxor i ivEnc : doCnt (ivAdd iv 1) is-}
-}
-- | Helper to use a purer interface
onBlock :: BlockCipherIO cipher
=> cipher
-> (ByteString -> ByteString)
-> PtrDest
-> PtrSource
-> BufferLength
-> IO ()
onBlock cipher f dst src len = loopBS cipher wrap nullPtr dst src len
where wrap bs fakeIv d s = do
fSrc <- newForeignPtr_ s
let res = f (B.fromForeignPtr fSrc 0 bs)
withBytePtr res $ \r -> B.memcpy d r (fromIntegral bs)
return fakeIv
loopBS :: BlockCipherIO cipher
=> cipher
-> (Int -> PtrIV -> PtrDest -> PtrSource -> IO PtrIV)
-> PtrIV -> PtrDest -> PtrSource -> BufferLength
-> IO ()
loopBS cipher f iv dst src len = loop iv dst src len
where bs = blockSize cipher
loop _ _ _ 0 = return ()
loop i d s n = do
newIV <- f bs i d s
loop newIV (d `plusPtr` bs) (s `plusPtr` bs) (n - fromIntegral bs)
mutableXor :: PtrDest -> PtrSource -> PtrIV -> Int -> IO ()
mutableXor (to64 -> dst) (to64 -> src) (to64 -> iv) 16 = do
peeksAndPoke dst src iv
peeksAndPoke (dst `plusPtr` 8) (src `plusPtr` 8) ((iv `plusPtr` 8) :: Ptr Word64)
mutableXor (to64 -> dst) (to64 -> src) (to64 -> iv) 8 = do
peeksAndPoke dst src iv
mutableXor dst src iv len = loop dst src iv len
where loop _ _ _ 0 = return ()
loop d s i n = peeksAndPoke d s i >> loop (d `plusPtr` 1) (s `plusPtr` 1) (i `plusPtr` 1) (n-1)
to64 :: Ptr Word8 -> Ptr Word64
to64 = castPtr
peeksAndPoke :: (Bits a, Storable a) => Ptr a -> Ptr a -> Ptr a -> IO ()
peeksAndPoke dst a b = (xor <$> peek a <*> peek b) >>= poke dst