module Crypto.Cipher.Types
(
Cipher(..)
, BlockCipher(..)
, StreamCipher(..)
, DataUnitOffset
, KeySizeSpecifier(..)
, KeyError(..)
, AEAD(..)
, AEADState(..)
, AEADMode(..)
, AEADModeImpl(..)
, aeadAppendHeader
, aeadEncrypt
, aeadDecrypt
, aeadFinalize
, aeadSimpleEncrypt
, aeadSimpleDecrypt
, Key
, makeKey
, IV
, makeIV
, nullIV
, ivAdd
, AuthTag(..)
) where
import Data.SecureMem
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Byteable
import Data.Word
import Data.Bits (shiftR, xor)
import Crypto.Cipher.Types.GF
type DataUnitOffset = Word32
data KeyError =
KeyErrorTooSmall
| KeyErrorTooBig
| KeyErrorInvalid String
deriving (Show,Eq)
data KeySizeSpecifier =
KeySizeRange Int Int
| KeySizeEnum [Int]
| KeySizeFixed Int
deriving (Show,Eq)
class Cipher cipher where
cipherInit :: Key cipher -> cipher
cipherName :: cipher -> String
cipherKeySize :: cipher -> KeySizeSpecifier
class Cipher cipher => StreamCipher cipher where
streamEncrypt :: cipher -> ByteString -> (ByteString, cipher)
streamDecrypt :: cipher -> ByteString -> (ByteString, cipher)
class Cipher cipher => BlockCipher cipher where
blockSize :: cipher -> Int
ecbEncrypt :: cipher -> ByteString -> ByteString
ecbDecrypt :: cipher -> ByteString -> ByteString
cbcEncrypt :: cipher -> IV cipher -> ByteString -> ByteString
cbcEncrypt = cbcEncryptGeneric
cbcDecrypt :: cipher -> IV cipher -> ByteString -> ByteString
cbcDecrypt = cbcDecryptGeneric
ctrCombine :: cipher -> IV cipher -> ByteString -> ByteString
ctrCombine = ctrCombineGeneric
xtsEncrypt :: (cipher, cipher) -> IV cipher -> DataUnitOffset -> ByteString -> ByteString
xtsEncrypt = xtsEncryptGeneric
xtsDecrypt :: (cipher, cipher) -> IV cipher -> DataUnitOffset -> ByteString -> ByteString
xtsDecrypt = xtsDecryptGeneric
aeadInit :: Byteable iv => AEADMode -> cipher -> iv -> Maybe (AEAD cipher)
aeadInit _ _ _ = Nothing
data AEADMode =
AEAD_OCB
| AEAD_CCM
| AEAD_EAX
| AEAD_CWC
| AEAD_GCM
deriving (Show,Eq)
data AEAD cipher = AEAD cipher (AEADState cipher)
data AEADState cipher = forall st . AEADModeImpl cipher st => AEADState st
class BlockCipher cipher => AEADModeImpl cipher state where
aeadStateAppendHeader :: cipher -> state -> ByteString -> state
aeadStateEncrypt :: cipher -> state -> ByteString -> (ByteString, state)
aeadStateDecrypt :: cipher -> state -> ByteString -> (ByteString, state)
aeadStateFinalize :: cipher -> state -> Int -> AuthTag
aeadAppendHeader :: BlockCipher a => AEAD a -> ByteString -> AEAD a
aeadAppendHeader (AEAD cipher (AEADState state)) bs =
AEAD cipher $ AEADState (aeadStateAppendHeader cipher state bs)
aeadEncrypt :: BlockCipher a => AEAD a -> ByteString -> (ByteString, AEAD a)
aeadEncrypt (AEAD cipher (AEADState state)) input = (output, AEAD cipher (AEADState nst))
where (output, nst) = aeadStateEncrypt cipher state input
aeadDecrypt :: BlockCipher a => AEAD a -> ByteString -> (ByteString, AEAD a)
aeadDecrypt (AEAD cipher (AEADState state)) input = (output, AEAD cipher (AEADState nst))
where (output, nst) = aeadStateDecrypt cipher state input
aeadFinalize :: BlockCipher a => AEAD a -> Int -> AuthTag
aeadFinalize (AEAD cipher (AEADState state)) len =
aeadStateFinalize cipher state len
aeadSimpleEncrypt :: BlockCipher a
=> AEAD a
-> B.ByteString
-> B.ByteString
-> Int
-> (AuthTag, B.ByteString)
aeadSimpleEncrypt aeadIni header input taglen = (tag, output)
where aead = aeadAppendHeader aeadIni header
(output, aeadFinal) = aeadEncrypt aead input
tag = aeadFinalize aeadFinal taglen
aeadSimpleDecrypt :: BlockCipher a
=> AEAD a
-> B.ByteString
-> B.ByteString
-> AuthTag
-> Maybe B.ByteString
aeadSimpleDecrypt aeadIni header input authTag
| tag == authTag = Just output
| otherwise = Nothing
where aead = aeadAppendHeader aeadIni header
(output, aeadFinal) = aeadDecrypt aead input
tag = aeadFinalize aeadFinal (byteableLength authTag)
newtype Key c = Key SecureMem deriving (Eq)
instance ToSecureMem (Key c) where
toSecureMem (Key sm) = sm
instance Byteable (Key c) where
toBytes (Key sm) = toBytes sm
newtype IV c = IV ByteString deriving (Eq)
instance Byteable (IV c) where
toBytes (IV sm) = sm
newtype AuthTag = AuthTag ByteString
deriving (Show)
instance Eq AuthTag where
(AuthTag a) == (AuthTag b) = constEqBytes a b
instance Byteable AuthTag where
toBytes (AuthTag bs) = bs
makeIV :: (Byteable b, BlockCipher c) => b -> Maybe (IV c)
makeIV b = toIV undefined
where toIV :: BlockCipher c => c -> Maybe (IV c)
toIV cipher
| byteableLength b == sz = Just (IV $ toBytes b)
| otherwise = Nothing
where sz = blockSize cipher
nullIV :: BlockCipher c => IV c
nullIV = toIV undefined
where toIV :: BlockCipher c => c -> IV c
toIV cipher = IV $ B.replicate (blockSize cipher) 0
ivAdd :: BlockCipher c => IV c -> Int -> IV c
ivAdd (IV b) i = IV $ snd $ B.mapAccumR addCarry i b
where addCarry :: Int -> Word8 -> (Int, Word8)
addCarry acc w
| acc == 0 = (0, w)
| otherwise = let (hi,lo) = acc `divMod` 256
nw = lo + (fromIntegral w)
in (hi + (nw `shiftR` 8), fromIntegral nw)
makeKey :: (ToSecureMem b, Cipher c) => b -> Either KeyError (Key c)
makeKey b = toKey undefined
where sm = toSecureMem b
smLen = byteableLength sm
toKey :: Cipher c => c -> Either KeyError (Key c)
toKey cipher = case cipherKeySize cipher of
KeySizeRange mi ma | smLen < mi -> Left KeyErrorTooSmall
| smLen > ma -> Left KeyErrorTooBig
| otherwise -> Right $ Key sm
KeySizeEnum l | smLen `elem` l -> Right $ Key sm
| otherwise -> Left $ KeyErrorInvalid ("valid size: " ++ show l)
KeySizeFixed v | smLen == v -> Right $ Key sm
| otherwise -> Left $ KeyErrorInvalid ("valid size: " ++ show v)
cbcEncryptGeneric :: BlockCipher cipher => cipher -> IV cipher -> ByteString -> ByteString
cbcEncryptGeneric cipher (IV ivini) input = B.concat $ doEnc ivini $ chunk (blockSize cipher) input
where doEnc _ [] = []
doEnc iv (i:is) =
let o = ecbEncrypt cipher $ bxor iv i
in o : doEnc o is
cbcDecryptGeneric :: BlockCipher cipher => cipher -> IV cipher -> ByteString -> ByteString
cbcDecryptGeneric cipher (IV ivini) input = B.concat $ doDec ivini $ chunk (blockSize cipher) input
where doDec _ [] = []
doDec iv (i:is) =
let o = bxor iv $ ecbDecrypt cipher i
in o : doDec i is
ctrCombineGeneric :: BlockCipher cipher => cipher -> IV cipher -> ByteString -> ByteString
ctrCombineGeneric cipher ivini input = 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
xtsEncryptGeneric :: BlockCipher cipher => (cipher,cipher) -> IV cipher -> DataUnitOffset -> ByteString -> ByteString
xtsEncryptGeneric = xtsGeneric ecbEncrypt
xtsDecryptGeneric :: BlockCipher cipher => (cipher,cipher) -> IV cipher -> DataUnitOffset -> ByteString -> ByteString
xtsDecryptGeneric = xtsGeneric ecbDecrypt
xtsGeneric :: BlockCipher cipher
=> (cipher -> B.ByteString -> B.ByteString)
-> (cipher,cipher)
-> IV cipher
-> DataUnitOffset
-> ByteString
-> ByteString
xtsGeneric f (cipher, tweakCipher) iv sPoint input = B.concat $ doXts iniTweak $ chunk (blockSize cipher) input
where encTweak = ecbEncrypt tweakCipher (toBytes iv)
iniTweak = iterate xtsGFMul encTweak !! fromIntegral sPoint
doXts _ [] = []
doXts tweak (i:is) =
let o = bxor (f cipher $ bxor i tweak) tweak
in o : doXts (xtsGFMul tweak) is
chunk :: Int -> ByteString -> [ByteString]
chunk sz bs = split bs
where split b | B.length b <= sz = [b]
| otherwise =
let (b1, b2) = B.splitAt sz b
in b1 : split b2
bxor :: ByteString -> ByteString -> ByteString
bxor src dst = B.pack $ B.zipWith xor src dst