1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- |
-- 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>
module Crypto.MAC.CMAC (
cmac,
CMAC,
subKeys,
) where
import Data.Bits (setBit, shiftL, testBit)
import Data.List (foldl')
import Data.Word
import Crypto.Cipher.Types
import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, Bytes)
import qualified Crypto.Internal.ByteArray as B
-- | Authentication code
newtype CMAC a = CMAC Bytes
deriving (ByteArrayAccess)
instance Eq (CMAC a) where
CMAC b1 == CMAC b2 = B.constEq b1 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 k msg =
CMAC $ foldl' (\c m -> ecbEncrypt k $ bxor c m) zeroV ms
where
bytes = blockSize k
zeroV = B.replicate bytes 0 :: Bytes
(k1, k2) = subKeys k
ms = cmacChunks k k1 k2 $ B.convert msg
cmacChunks :: (BlockCipher k, ByteArray ba) => k -> ba -> ba -> ba -> [ba]
cmacChunks k k1 k2 = rec'
where
rec' msg
| B.null tl =
if lack == 0
then [bxor k1 hd]
else [bxor k2 $ hd `B.append` B.pack (0x80 : replicate (lack - 1) 0)]
| otherwise = hd : rec' tl
where
bytes = blockSize k
(hd, tl) = B.splitAt bytes msg
lack = bytes - B.length 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 k = (k1, k2)
where
ipt = cipherIPT k
k0 = ecbEncrypt k $ B.replicate (blockSize k) 0
k1 = subKey ipt k0
k2 = subKey ipt k1
-- polynomial multiply operation to culculate subkey
subKey :: ByteArray ba => [Word8] -> ba -> ba
subKey ipt ws = case B.unpack ws of
[] -> B.empty
w : _
| testBit w 7 -> B.pack ipt `bxor` shiftL1 ws
| otherwise -> shiftL1 ws
shiftL1 :: ByteArray ba => ba -> ba
shiftL1 = B.pack . shiftL1W . B.unpack
shiftL1W :: [Word8] -> [Word8]
shiftL1W [] = []
shiftL1W ws@(_ : ns) = rec' $ zip ws (ns ++ [0])
where
rec' [] = []
rec' ((x, y) : ps) = w : rec' ps
where
w
| testBit y 7 = setBit sl1 0
| otherwise = sl1
where
sl1 = shiftL x 1
bxor :: ByteArray ba => ba -> ba -> ba
bxor = B.xor
-----
cipherIPT :: BlockCipher k => k -> [Word8]
cipherIPT = expandIPT . 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 = d
where
d 64 = Just $ Q 4 3 1
d 128 = Just $ Q 7 2 1
d _ = Nothing
-- Expand a tail bit pattern of irreducible binary polynomial
expandIPT :: Int -> [Word8]
expandIPT bytes = expandIPT' bytes ipt
where
ipt =
maybe
( error $
"Irreducible binary polynomial not defined against " ++ show nb ++ " bit"
)
id
$ iPolynomial nb
nb = bytes * 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' bytes (Q x y z) =
reverse . setB x . setB y . setB z . setB 0 $ replicate bytes 0
where
setB i ws = case tl of
(a : as) -> hd ++ setBit a r : as
_ -> error "expandIPT'"
where
(q, r) = i `quotRem` 8
(hd, tl) = splitAt q ws
|
