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