1-- |
2-- Module      : Crypto.MAC.CMAC
3-- License     : BSD-style
4-- Maintainer  : Kei Hibino <ex8k.hibino@gmail.com>
5-- Stability   : experimental
6-- Portability : unknown
7--
8-- Provide the CMAC (Cipher based Message Authentification Code) base algorithm.
9-- <http://en.wikipedia.org/wiki/CMAC>
10-- <http://csrc.nist.gov/publications/nistpubs/800-38B/SP_800-38B.pdf>
11--
12{-# LANGUAGE GeneralizedNewtypeDeriving #-}
13module Crypto.MAC.CMAC
14    ( cmac
15    , CMAC
16    , subKeys
17    ) where
18
19import           Data.Word
20import           Data.Bits (setBit, testBit, shiftL)
21import           Data.List (foldl')
22
23import           Crypto.Cipher.Types
24import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes)
25import qualified Crypto.Internal.ByteArray as B
26
27-- | Authentication code
28newtype CMAC a = CMAC Bytes
29    deriving (ByteArrayAccess)
30
31instance Eq (CMAC a) where
32  CMAC b1 == CMAC b2  =  B.constEq b1 b2
33
34-- | compute a MAC using the supplied cipher
35cmac :: (ByteArrayAccess bin, BlockCipher cipher)
36     => cipher      -- ^ key to compute CMAC with
37     -> bin         -- ^ input message
38     -> CMAC cipher -- ^ output tag
39cmac k msg =
40    CMAC $ foldl' (\c m -> ecbEncrypt k $ bxor c m) zeroV ms
41  where
42    bytes = blockSize k
43    zeroV = B.replicate bytes 0 :: Bytes
44    (k1, k2) = subKeys k
45    ms = cmacChunks k k1 k2 $ B.convert msg
46
47cmacChunks :: (BlockCipher k, ByteArray ba) => k -> ba -> ba -> ba -> [ba]
48cmacChunks k k1 k2  =  rec'  where
49    rec' msg
50      | B.null tl  =  if lack == 0
51                      then  [bxor k1 hd]
52                      else  [bxor k2 $ hd `B.append` B.pack (0x80 : replicate (lack - 1) 0)]
53      | otherwise  =        hd : rec' tl
54      where
55          bytes = blockSize k
56          (hd, tl) = B.splitAt bytes msg
57          lack = bytes - B.length hd
58
59-- | make sub-keys used in CMAC
60subKeys :: (BlockCipher k, ByteArray ba)
61        => k         -- ^ key to compute CMAC with
62        -> (ba, ba)  -- ^ sub-keys to compute CMAC
63subKeys k = (k1, k2)   where
64    ipt = cipherIPT k
65    k0 = ecbEncrypt k $ B.replicate (blockSize k) 0
66    k1 = subKey ipt k0
67    k2 = subKey ipt k1
68
69-- polynomial multiply operation to culculate subkey
70subKey :: (ByteArray ba) => [Word8] -> ba -> ba
71subKey ipt ws  =  case B.unpack ws of
72    []                  ->  B.empty
73    w:_  | testBit w 7  ->  B.pack ipt `bxor` shiftL1 ws
74         | otherwise    ->  shiftL1 ws
75
76shiftL1 :: (ByteArray ba) => ba -> ba
77shiftL1 = B.pack . shiftL1W . B.unpack
78
79shiftL1W :: [Word8] -> [Word8]
80shiftL1W []         =  []
81shiftL1W ws@(_:ns)  =  rec' $ zip ws (ns ++ [0])   where
82    rec'  []         =  []
83    rec' ((x,y):ps)  =  w : rec' ps
84      where
85          w | testBit y 7  =  setBit sl1 0
86            | otherwise    =  sl1
87            where     sl1 = shiftL x 1
88
89bxor :: ByteArray ba => ba -> ba -> ba
90bxor = B.xor
91
92
93-----
94
95
96cipherIPT :: BlockCipher k => k -> [Word8]
97cipherIPT = expandIPT . blockSize
98
99-- Data type which represents the smallest irreducibule binary polynomial
100-- against specified degree.
101--
102-- Maximum degree bit and degree 0 bit are omitted.
103-- For example, The value /Q 7 2 1/ corresponds to the degree /128/.
104-- It represents that the smallest irreducible binary polynomial of degree 128
105-- is x^128 + x^7 + x^2 + x^1 + 1.
106data IPolynomial
107  = Q Int Int Int
108---  | T Int
109
110iPolynomial :: Int -> Maybe IPolynomial
111iPolynomial = d  where
112    d   64  =  Just $ Q 4 3 1
113    d  128  =  Just $ Q 7 2 1
114    d    _  =  Nothing
115
116-- Expand a tail bit pattern of irreducible binary polynomial
117expandIPT :: Int -> [Word8]
118expandIPT bytes = expandIPT' bytes ipt  where
119    ipt = maybe (error $ "Irreducible binary polynomial not defined against " ++ show nb ++ " bit") id
120          $ iPolynomial nb
121    nb = bytes * 8
122
123-- Expand a tail bit pattern of irreducible binary polynomial
124expandIPT' :: Int         -- ^ width in byte
125           -> IPolynomial -- ^ irreducible binary polynomial definition
126           -> [Word8]     -- ^ result bit pattern
127expandIPT' bytes (Q x y z) =
128    reverse . setB x . setB y . setB z . setB 0 $ replicate bytes 0
129  where
130    setB i ws =  hd ++ setBit (head tl) r : tail tl  where
131        (q, r) = i `quotRem` 8
132        (hd, tl) = splitAt q ws
133