{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ViewPatterns #-}
module Crypto.Cipher.Types.Block
(
BlockCipher(..)
, IV
, makeIV
, nullIV
, ivAdd
, XTS
, AEAD(..)
, AEADState(..)
, AEADModeImpl(..)
, cfb8Encrypt
, cfb8Decrypt
) where
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B (unsafeCreate)
import Data.Byteable
import Data.Word
import Data.Bits (shiftR, Bits)
import Crypto.Cipher.Types.Base
import Crypto.Cipher.Types.GF
import Crypto.Cipher.Types.Utils
import Foreign.Ptr
import Foreign.Storable
type XTS cipher = (cipher, cipher)
-> IV cipher
-> DataUnitOffset
-> ByteString
-> ByteString
class Cipher cipher => BlockCipher cipher where
blockSize :: cipher -> Int
ecbEncrypt :: cipher -> ByteString -> ByteString
ecbDecrypt :: cipher -> ByteString -> ByteString
cbcEncrypt :: cipher -> IV cipher -> ByteString -> ByteString
cbcEncrypt = cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cbcEncryptGeneric
cbcDecrypt :: cipher -> IV cipher -> ByteString -> ByteString
cbcDecrypt = cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cbcDecryptGeneric
cfbEncrypt :: cipher -> IV cipher -> ByteString -> ByteString
cfbEncrypt = cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cfbEncryptGeneric
cfbDecrypt :: cipher -> IV cipher -> ByteString -> ByteString
cfbDecrypt = cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cfbDecryptGeneric
ctrCombine :: cipher -> IV cipher -> ByteString -> ByteString
ctrCombine = cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
ctrCombineGeneric
xtsEncrypt :: (cipher, cipher)
-> IV cipher
-> DataUnitOffset
-> ByteString
-> ByteString
xtsEncrypt = (cipher, cipher)
-> IV cipher -> DataUnitOffset -> ByteString -> ByteString
forall cipher. BlockCipher cipher => XTS cipher
xtsEncryptGeneric
xtsDecrypt :: (cipher, cipher)
-> IV cipher
-> DataUnitOffset
-> ByteString
-> ByteString
xtsDecrypt = (cipher, cipher)
-> IV cipher -> DataUnitOffset -> ByteString -> ByteString
forall cipher. BlockCipher cipher => XTS cipher
xtsDecryptGeneric
aeadInit :: Byteable iv => AEADMode -> cipher -> iv -> Maybe (AEAD cipher)
aeadInit AEADMode
_ cipher
_ iv
_ = Maybe (AEAD cipher)
forall a. Maybe a
Nothing
data AEAD cipher = AEAD cipher (AEADState cipher)
data AEADState cipher = forall st . AEADModeImpl cipher st => AEADState st
class BlockCipher cipher => AEADModeImpl cipher state where
:: cipher -> state -> ByteString -> state
aeadStateEncrypt :: cipher -> state -> ByteString -> (ByteString, state)
aeadStateDecrypt :: cipher -> state -> ByteString -> (ByteString, state)
aeadStateFinalize :: cipher -> state -> Int -> AuthTag
makeIV :: (Byteable b, BlockCipher c) => b -> Maybe (IV c)
makeIV :: forall b c. (Byteable b, BlockCipher c) => b -> Maybe (IV c)
makeIV b
b = c -> Maybe (IV c)
forall c. BlockCipher c => c -> Maybe (IV c)
toIV c
forall a. HasCallStack => a
undefined
where toIV :: BlockCipher c => c -> Maybe (IV c)
toIV :: forall c. BlockCipher c => c -> Maybe (IV c)
toIV c
cipher
| b -> Int
forall a. Byteable a => a -> Int
byteableLength b
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz = IV c -> Maybe (IV c)
forall a. a -> Maybe a
Just (ByteString -> IV c
forall c. ByteString -> IV c
IV (ByteString -> IV c) -> ByteString -> IV c
forall a b. (a -> b) -> a -> b
$ b -> ByteString
forall a. Byteable a => a -> ByteString
toBytes b
b)
| Bool
otherwise = Maybe (IV c)
forall a. Maybe a
Nothing
where sz :: Int
sz = c -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize c
cipher
nullIV :: BlockCipher c => IV c
nullIV :: forall c. BlockCipher c => IV c
nullIV = c -> IV c
forall c. BlockCipher c => c -> IV c
toIV c
forall a. HasCallStack => a
undefined
where toIV :: BlockCipher c => c -> IV c
toIV :: forall c. BlockCipher c => c -> IV c
toIV c
cipher = ByteString -> IV c
forall c. ByteString -> IV c
IV (ByteString -> IV c) -> ByteString -> IV c
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
B.replicate (c -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize c
cipher) Word8
0
ivAdd :: BlockCipher c => IV c -> Int -> IV c
ivAdd :: forall c. BlockCipher c => IV c -> Int -> IV c
ivAdd (IV ByteString
b) Int
i = ByteString -> IV c
forall c. ByteString -> IV c
IV (ByteString -> IV c) -> ByteString -> IV c
forall a b. (a -> b) -> a -> b
$ (Int, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((Int, ByteString) -> ByteString)
-> (Int, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ (Int -> Word8 -> (Int, Word8))
-> Int -> ByteString -> (Int, ByteString)
forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
B.mapAccumR Int -> Word8 -> (Int, Word8)
addCarry Int
i ByteString
b
where addCarry :: Int -> Word8 -> (Int, Word8)
addCarry :: Int -> Word8 -> (Int, Word8)
addCarry Int
acc Word8
w
| Int
acc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Int
0, Word8
w)
| Bool
otherwise = let (Int
hi,Int
lo) = Int
acc Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
256
nw :: Int
nw = Int
lo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w)
in (Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
nw Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8), Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nw)
cbcEncryptGeneric :: BlockCipher cipher => cipher -> IV cipher -> ByteString -> ByteString
cbcEncryptGeneric :: forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cbcEncryptGeneric cipher
cipher (IV ByteString
ivini) ByteString
input = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> [ByteString]
doEnc ByteString
ivini ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString]
chunk (cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ByteString
input
where doEnc :: ByteString -> [ByteString] -> [ByteString]
doEnc ByteString
_ [] = []
doEnc ByteString
iv (ByteString
i:[ByteString]
is) =
let o :: ByteString
o = cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
ecbEncrypt cipher
cipher (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
bxor ByteString
iv ByteString
i
in ByteString
o ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString] -> [ByteString]
doEnc ByteString
o [ByteString]
is
cbcDecryptGeneric :: BlockCipher cipher => cipher -> IV cipher -> ByteString -> ByteString
cbcDecryptGeneric :: forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cbcDecryptGeneric cipher
cipher (IV ByteString
ivini) ByteString
input = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> [ByteString]
doDec ByteString
ivini ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString]
chunk (cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ByteString
input
where doDec :: ByteString -> [ByteString] -> [ByteString]
doDec ByteString
_ [] = []
doDec ByteString
iv (ByteString
i:[ByteString]
is) =
let o :: ByteString
o = ByteString -> ByteString -> ByteString
bxor ByteString
iv (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
ecbDecrypt cipher
cipher ByteString
i
in ByteString
o ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString] -> [ByteString]
doDec ByteString
i [ByteString]
is
cfbEncryptGeneric :: BlockCipher cipher => cipher -> IV cipher -> ByteString -> ByteString
cfbEncryptGeneric :: forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cfbEncryptGeneric cipher
cipher (IV ByteString
ivini) ByteString
input = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> [ByteString]
doEnc ByteString
ivini ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString]
chunk (cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ByteString
input
where doEnc :: ByteString -> [ByteString] -> [ByteString]
doEnc ByteString
_ [] = []
doEnc ByteString
iv (ByteString
i:[ByteString]
is) =
let o :: ByteString
o = ByteString -> ByteString -> ByteString
bxor ByteString
i (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
ecbEncrypt cipher
cipher ByteString
iv
in ByteString
o ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString] -> [ByteString]
doEnc ByteString
o [ByteString]
is
cfbDecryptGeneric :: BlockCipher cipher => cipher -> IV cipher -> ByteString -> ByteString
cfbDecryptGeneric :: forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cfbDecryptGeneric cipher
cipher (IV ByteString
ivini) ByteString
input = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> [ByteString]
doDec ByteString
ivini ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString]
chunk (cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ByteString
input
where doDec :: ByteString -> [ByteString] -> [ByteString]
doDec ByteString
_ [] = []
doDec ByteString
iv (ByteString
i:[ByteString]
is) =
let o :: ByteString
o = ByteString -> ByteString -> ByteString
bxor ByteString
i (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
ecbEncrypt cipher
cipher ByteString
iv
in ByteString
o ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString] -> [ByteString]
doDec ByteString
i [ByteString]
is
ctrCombineGeneric :: BlockCipher cipher => cipher -> IV cipher -> ByteString -> ByteString
ctrCombineGeneric :: forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
ctrCombineGeneric cipher
cipher IV cipher
ivini ByteString
input = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ IV cipher -> [ByteString] -> [ByteString]
forall {c}. BlockCipher c => IV c -> [ByteString] -> [ByteString]
doCnt IV cipher
ivini ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString]
chunk (cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ByteString
input
where doCnt :: IV c -> [ByteString] -> [ByteString]
doCnt IV c
_ [] = []
doCnt IV c
iv (ByteString
i:[ByteString]
is) =
let ivEnc :: ByteString
ivEnc = cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
ecbEncrypt cipher
cipher (IV c -> ByteString
forall a. Byteable a => a -> ByteString
toBytes IV c
iv)
in ByteString -> ByteString -> ByteString
bxor ByteString
i ByteString
ivEnc ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: IV c -> [ByteString] -> [ByteString]
doCnt (IV c -> Int -> IV c
forall c. BlockCipher c => IV c -> Int -> IV c
ivAdd IV c
iv Int
1) [ByteString]
is
xtsEncryptGeneric :: BlockCipher cipher => XTS cipher
xtsEncryptGeneric :: forall cipher. BlockCipher cipher => XTS cipher
xtsEncryptGeneric = (cipher -> ByteString -> ByteString)
-> (cipher, cipher)
-> IV cipher
-> DataUnitOffset
-> ByteString
-> ByteString
forall cipher.
BlockCipher cipher =>
(cipher -> ByteString -> ByteString)
-> (cipher, cipher)
-> IV cipher
-> DataUnitOffset
-> ByteString
-> ByteString
xtsGeneric cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
ecbEncrypt
xtsDecryptGeneric :: BlockCipher cipher => XTS cipher
xtsDecryptGeneric :: forall cipher. BlockCipher cipher => XTS cipher
xtsDecryptGeneric = (cipher -> ByteString -> ByteString)
-> (cipher, cipher)
-> IV cipher
-> DataUnitOffset
-> ByteString
-> ByteString
forall cipher.
BlockCipher cipher =>
(cipher -> ByteString -> ByteString)
-> (cipher, cipher)
-> IV cipher
-> DataUnitOffset
-> ByteString
-> ByteString
xtsGeneric cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
ecbDecrypt
xtsGeneric :: BlockCipher cipher
=> (cipher -> B.ByteString -> B.ByteString)
-> (cipher, cipher)
-> IV cipher
-> DataUnitOffset
-> ByteString
-> ByteString
xtsGeneric :: forall cipher.
BlockCipher cipher =>
(cipher -> ByteString -> ByteString)
-> (cipher, cipher)
-> IV cipher
-> DataUnitOffset
-> ByteString
-> ByteString
xtsGeneric cipher -> ByteString -> ByteString
f (cipher
cipher, cipher
tweakCipher) IV cipher
iv DataUnitOffset
sPoint ByteString
input
| cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
16 = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"XTS mode is only available with cipher that have a block size of 128 bits"
| Bool
otherwise = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> [ByteString]
doXts ByteString
iniTweak ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString]
chunk (cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ByteString
input
where encTweak :: ByteString
encTweak = cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
ecbEncrypt cipher
tweakCipher (IV cipher -> ByteString
forall a. Byteable a => a -> ByteString
toBytes IV cipher
iv)
iniTweak :: ByteString
iniTweak = (ByteString -> ByteString) -> ByteString -> [ByteString]
forall a. (a -> a) -> a -> [a]
iterate ByteString -> ByteString
xtsGFMul ByteString
encTweak [ByteString] -> Int -> ByteString
forall a. HasCallStack => [a] -> Int -> a
!! DataUnitOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral DataUnitOffset
sPoint
doXts :: ByteString -> [ByteString] -> [ByteString]
doXts ByteString
_ [] = []
doXts ByteString
tweak (ByteString
i:[ByteString]
is) =
let o :: ByteString
o = ByteString -> ByteString -> ByteString
bxor (cipher -> ByteString -> ByteString
f cipher
cipher (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
bxor ByteString
i ByteString
tweak) ByteString
tweak
in ByteString
o ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString] -> [ByteString]
doXts (ByteString -> ByteString
xtsGFMul ByteString
tweak) [ByteString]
is
cfb8Encrypt :: BlockCipher a => a -> IV a -> B.ByteString -> B.ByteString
cfb8Encrypt :: forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cfb8Encrypt a
ctx IV a
origIv ByteString
msg = Int -> (Ptr Word8 -> IO ()) -> ByteString
B.unsafeCreate (ByteString -> Int
B.length ByteString
msg) ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> Ptr Word8 -> IV a -> ByteString -> IO ()
loop Ptr Word8
dst IV a
origIv ByteString
msg
where loop :: Ptr Word8 -> IV a -> ByteString -> IO ()
loop Ptr Word8
d iv :: IV a
iv@(IV ByteString
i) ByteString
m
| ByteString -> Bool
B.null ByteString
m = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
d Word8
out IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word8 -> IV a -> ByteString -> IO ()
loop (Ptr Word8
d Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) IV a
forall {c}. IV c
ni (Int -> ByteString -> ByteString
B.drop Int
1 ByteString
m)
where m' :: ByteString
m' = if ByteString -> Int
B.length ByteString
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< a -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize a
ctx
then ByteString
m ByteString -> ByteString -> ByteString
`B.append` Int -> Word8 -> ByteString
B.replicate (a -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize a
ctx Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
m) Word8
0
else Int -> ByteString -> ByteString
B.take (a -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize a
ctx) ByteString
m
r :: ByteString
r = a -> IV a -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cfbEncrypt a
ctx IV a
iv ByteString
m'
out :: Word8
out = HasCallStack => ByteString -> Word8
ByteString -> Word8
B.head ByteString
r
ni :: IV c
ni = ByteString -> IV c
forall c. ByteString -> IV c
IV (Int -> ByteString -> ByteString
B.drop Int
1 ByteString
i ByteString -> Word8 -> ByteString
`B.snoc` Word8
out)
cfb8Decrypt :: BlockCipher a => a -> IV a -> B.ByteString -> B.ByteString
cfb8Decrypt :: forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cfb8Decrypt a
ctx IV a
origIv ByteString
msg = Int -> (Ptr Word8 -> IO ()) -> ByteString
B.unsafeCreate (ByteString -> Int
B.length ByteString
msg) ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> Ptr Word8 -> IV a -> ByteString -> IO ()
loop Ptr Word8
dst IV a
origIv ByteString
msg
where loop :: Ptr Word8 -> IV a -> ByteString -> IO ()
loop Ptr Word8
d iv :: IV a
iv@(IV ByteString
i) ByteString
m
| ByteString -> Bool
B.null ByteString
m = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
d Word8
out IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word8 -> IV a -> ByteString -> IO ()
loop (Ptr Word8
d Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) IV a
forall {c}. IV c
ni (Int -> ByteString -> ByteString
B.drop Int
1 ByteString
m)
where m' :: ByteString
m' = if ByteString -> Int
B.length ByteString
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< a -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize a
ctx
then ByteString
m ByteString -> ByteString -> ByteString
`B.append` Int -> Word8 -> ByteString
B.replicate (a -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize a
ctx Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
m) Word8
0
else Int -> ByteString -> ByteString
B.take (a -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize a
ctx) ByteString
m
r :: ByteString
r = a -> IV a -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cfbDecrypt a
ctx IV a
iv ByteString
m'
out :: Word8
out = HasCallStack => ByteString -> Word8
ByteString -> Word8
B.head ByteString
r
ni :: IV c
ni = ByteString -> IV c
forall c. ByteString -> IV c
IV (Int -> ByteString -> ByteString
B.drop Int
1 ByteString
i ByteString -> Word8 -> ByteString
`B.snoc` HasCallStack => ByteString -> Word8
ByteString -> Word8
B.head ByteString
m')