{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Crypto.MAC.CMAC
( cmac
, CMAC
, subKeys
) where
import Data.Word
import Data.Bits (setBit, testBit, shiftL)
import Data.List (foldl')
import Crypto.Cipher.Types
import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes)
import qualified Crypto.Internal.ByteArray as B
newtype CMAC a = CMAC Bytes
deriving (CMAC a -> Int
forall a. CMAC a -> Int
forall p. CMAC a -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall a p. CMAC a -> Ptr p -> IO ()
forall p a. CMAC a -> (Ptr p -> IO a) -> IO a
forall a p a. CMAC a -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: forall p. CMAC a -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall a p. CMAC a -> Ptr p -> IO ()
withByteArray :: forall p a. CMAC a -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall a p a. CMAC a -> (Ptr p -> IO a) -> IO a
length :: CMAC a -> Int
$clength :: forall a. CMAC a -> Int
ByteArrayAccess)
instance Eq (CMAC a) where
CMAC Bytes
b1 == :: CMAC a -> CMAC a -> Bool
== CMAC Bytes
b2 = forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
B.constEq Bytes
b1 Bytes
b2
cmac :: (ByteArrayAccess bin, BlockCipher cipher)
=> cipher
-> bin
-> CMAC cipher
cmac :: forall bin cipher.
(ByteArrayAccess bin, BlockCipher cipher) =>
cipher -> bin -> CMAC cipher
cmac cipher
k bin
msg =
forall a. Bytes -> CMAC a
CMAC forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Bytes
c Bytes
m -> forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbEncrypt cipher
k forall a b. (a -> b) -> a -> b
$ forall ba. ByteArray ba => ba -> ba -> ba
bxor Bytes
c Bytes
m) Bytes
zeroV [Bytes]
ms
where
bytes :: Int
bytes = forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
k
zeroV :: Bytes
zeroV = forall ba. ByteArray ba => Int -> Word8 -> ba
B.replicate Int
bytes Word8
0 :: Bytes
(Bytes
k1, Bytes
k2) = forall k ba. (BlockCipher k, ByteArray ba) => k -> (ba, ba)
subKeys cipher
k
ms :: [Bytes]
ms = forall k ba.
(BlockCipher k, ByteArray ba) =>
k -> ba -> ba -> ba -> [ba]
cmacChunks cipher
k Bytes
k1 Bytes
k2 forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert bin
msg
cmacChunks :: (BlockCipher k, ByteArray ba) => k -> ba -> ba -> ba -> [ba]
cmacChunks :: forall k ba.
(BlockCipher k, ByteArray ba) =>
k -> ba -> ba -> ba -> [ba]
cmacChunks k
k ba
k1 ba
k2 = ba -> [ba]
rec' where
rec' :: ba -> [ba]
rec' ba
msg
| forall a. ByteArrayAccess a => a -> Bool
B.null ba
tl = if Int
lack forall a. Eq a => a -> a -> Bool
== Int
0
then [forall ba. ByteArray ba => ba -> ba -> ba
bxor ba
k1 ba
hd]
else [forall ba. ByteArray ba => ba -> ba -> ba
bxor ba
k2 forall a b. (a -> b) -> a -> b
$ ba
hd forall ba. ByteArray ba => ba -> ba -> ba
`B.append` forall a. ByteArray a => [Word8] -> a
B.pack (Word8
0x80 forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate (Int
lack forall a. Num a => a -> a -> a
- Int
1) Word8
0)]
| Bool
otherwise = ba
hd forall a. a -> [a] -> [a]
: ba -> [ba]
rec' ba
tl
where
bytes :: Int
bytes = forall cipher. BlockCipher cipher => cipher -> Int
blockSize k
k
(ba
hd, ba
tl) = forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt Int
bytes ba
msg
lack :: Int
lack = Int
bytes forall a. Num a => a -> a -> a
- forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
hd
subKeys :: (BlockCipher k, ByteArray ba)
=> k
-> (ba, ba)
subKeys :: forall k ba. (BlockCipher k, ByteArray ba) => k -> (ba, ba)
subKeys k
k = (ba
k1, ba
k2) where
ipt :: [Word8]
ipt = forall k. BlockCipher k => k -> [Word8]
cipherIPT k
k
k0 :: ba
k0 = forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbEncrypt k
k forall a b. (a -> b) -> a -> b
$ forall ba. ByteArray ba => Int -> Word8 -> ba
B.replicate (forall cipher. BlockCipher cipher => cipher -> Int
blockSize k
k) Word8
0
k1 :: ba
k1 = forall ba. ByteArray ba => [Word8] -> ba -> ba
subKey [Word8]
ipt ba
k0
k2 :: ba
k2 = forall ba. ByteArray ba => [Word8] -> ba -> ba
subKey [Word8]
ipt ba
k1
subKey :: (ByteArray ba) => [Word8] -> ba -> ba
subKey :: forall ba. ByteArray ba => [Word8] -> ba -> ba
subKey [Word8]
ipt ba
ws = case forall a. ByteArrayAccess a => a -> [Word8]
B.unpack ba
ws of
[] -> forall a. ByteArray a => a
B.empty
Word8
w:[Word8]
_ | forall a. Bits a => a -> Int -> Bool
testBit Word8
w Int
7 -> forall a. ByteArray a => [Word8] -> a
B.pack [Word8]
ipt forall ba. ByteArray ba => ba -> ba -> ba
`bxor` forall ba. ByteArray ba => ba -> ba
shiftL1 ba
ws
| Bool
otherwise -> forall ba. ByteArray ba => ba -> ba
shiftL1 ba
ws
shiftL1 :: (ByteArray ba) => ba -> ba
shiftL1 :: forall ba. ByteArray ba => ba -> ba
shiftL1 = forall a. ByteArray a => [Word8] -> a
B.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Word8]
shiftL1W forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ByteArrayAccess a => a -> [Word8]
B.unpack
shiftL1W :: [Word8] -> [Word8]
shiftL1W :: [Word8] -> [Word8]
shiftL1W [] = []
shiftL1W ws :: [Word8]
ws@(Word8
_:[Word8]
ns) = forall {b} {a}. (Bits b, Bits a) => [(a, b)] -> [a]
rec' forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Word8]
ws ([Word8]
ns forall a. [a] -> [a] -> [a]
++ [Word8
0]) where
rec' :: [(a, b)] -> [a]
rec' [] = []
rec' ((a
x,b
y):[(a, b)]
ps) = a
w forall a. a -> [a] -> [a]
: [(a, b)] -> [a]
rec' [(a, b)]
ps
where
w :: a
w | forall a. Bits a => a -> Int -> Bool
testBit b
y Int
7 = forall a. Bits a => a -> Int -> a
setBit a
sl1 Int
0
| Bool
otherwise = a
sl1
where sl1 :: a
sl1 = forall a. Bits a => a -> Int -> a
shiftL a
x Int
1
bxor :: ByteArray ba => ba -> ba -> ba
bxor :: forall ba. ByteArray ba => ba -> ba -> ba
bxor = forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
B.xor
cipherIPT :: BlockCipher k => k -> [Word8]
cipherIPT :: forall k. BlockCipher k => k -> [Word8]
cipherIPT = Int -> [Word8]
expandIPT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cipher. BlockCipher cipher => cipher -> Int
blockSize
data IPolynomial
= Q Int Int Int
iPolynomial :: Int -> Maybe IPolynomial
iPolynomial :: Int -> Maybe IPolynomial
iPolynomial = forall {a}. (Eq a, Num a) => a -> Maybe IPolynomial
d where
d :: a -> Maybe IPolynomial
d a
64 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> IPolynomial
Q Int
4 Int
3 Int
1
d a
128 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> IPolynomial
Q Int
7 Int
2 Int
1
d a
_ = forall a. Maybe a
Nothing
expandIPT :: Int -> [Word8]
expandIPT :: Int -> [Word8]
expandIPT Int
bytes = Int -> IPolynomial -> [Word8]
expandIPT' Int
bytes IPolynomial
ipt where
ipt :: IPolynomial
ipt = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Irreducible binary polynomial not defined against " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
nb forall a. [a] -> [a] -> [a]
++ [Char]
" bit") forall a. a -> a
id
forall a b. (a -> b) -> a -> b
$ Int -> Maybe IPolynomial
iPolynomial Int
nb
nb :: Int
nb = Int
bytes forall a. Num a => a -> a -> a
* Int
8
expandIPT' :: Int
-> IPolynomial
-> [Word8]
expandIPT' :: Int -> IPolynomial -> [Word8]
expandIPT' Int
bytes (Q Int
x Int
y Int
z) =
forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Bits a => Int -> [a] -> [a]
setB Int
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Bits a => Int -> [a] -> [a]
setB Int
y forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Bits a => Int -> [a] -> [a]
setB Int
z forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Bits a => Int -> [a] -> [a]
setB Int
0 forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
bytes Word8
0
where
setB :: Int -> [a] -> [a]
setB Int
i [a]
ws = [a]
hd forall a. [a] -> [a] -> [a]
++ forall a. Bits a => a -> Int -> a
setBit (forall a. [a] -> a
head [a]
tl) Int
r forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
tail [a]
tl where
(Int
q, Int
r) = Int
i forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
8
([a]
hd, [a]
tl) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
q [a]
ws