-- |
-- Module      : Crypto.MAC.CMAC
-- License     : BSD-style
-- Maintainer  : Kei Hibino <ex8k.hibino@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
-- Provide the CMAC (Cipher based Message Authentification Code) base algorithm.
-- <http://en.wikipedia.org/wiki/CMAC>
-- <http://csrc.nist.gov/publications/nistpubs/800-38B/SP_800-38B.pdf>
--
{-# 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

-- | Authentication code
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

-- | compute a MAC using the supplied cipher
cmac :: (ByteArrayAccess bin, BlockCipher cipher)
     => cipher      -- ^ key to compute CMAC with
     -> bin         -- ^ input message
     -> CMAC cipher -- ^ output tag
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

-- | make sub-keys used in CMAC
subKeys :: (BlockCipher k, ByteArray ba)
        => k         -- ^ key to compute CMAC with
        -> (ba, ba)  -- ^ sub-keys to compute CMAC
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

-- polynomial multiply operation to culculate subkey
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 type which represents the smallest irreducibule binary polynomial
-- against specified degree.
--
-- Maximum degree bit and degree 0 bit are omitted.
-- For example, The value /Q 7 2 1/ corresponds to the degree /128/.
-- It represents that the smallest irreducible binary polynomial of degree 128
-- is x^128 + x^7 + x^2 + x^1 + 1.
data IPolynomial
  = Q Int Int Int
---  | T 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

-- Expand a tail bit pattern of irreducible binary polynomial
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

-- Expand a tail bit pattern of irreducible binary polynomial
expandIPT' :: Int         -- ^ width in byte
           -> IPolynomial -- ^ irreducible binary polynomial definition
           -> [Word8]     -- ^ result bit pattern
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