forked from haskell-crypto/cryptonite
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
2 changed files
with
118 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,117 @@ | ||
-- | | ||
-- 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 | ||
, 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 | ||
|
||
|
||
-- | compute a MAC using the supplied cipher | ||
cmac :: (ByteArrayAccess bin, ByteArray bout, BlockCipher cipher) | ||
=> cipher -- ^ key to compute CMAC with | ||
-> bin -- ^ input message | ||
-> bout -- ^ output tag | ||
cmac k msg = | ||
B.convert $ 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 where | ||
|
||
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 = hd ++ setBit (head tl) r : tail tl where | ||
(q, r) = i `quotRem` 8 | ||
(hd, tl) = splitAt q ws |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters