automotive-cse (empty) → 0.0.1.0
raw patch · 7 files changed
+556/−0 lines, 7 filesdep +automotive-csedep +basedep +bytestringsetup-changed
Dependencies added: automotive-cse, base, bytestring, cereal, cryptonite, memory, quickcheck-simple
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- automotive-cse.cabal +55/−0
- src/Backport/Crypto/ConstructHash/MiyaguchiPreneel.hs +66/−0
- src/Backport/Crypto/MAC/CMAC.hs +121/−0
- src/Codec/Automotive/CSE.hs +165/−0
- test/expectTrue.hs +117/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Kei Hibino++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Kei Hibino nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ automotive-cse.cabal view
@@ -0,0 +1,55 @@++name: automotive-cse+version: 0.0.1.0+synopsis: Automotive CSE emulation+description: This package includes Cryptography Security Engine (CSE)+ codec emulation for automotive things.+license: BSD3+license-file: LICENSE+author: Kei Hibino+maintainer: ex8k.hibino@gmail.com+copyright: Copyright (c) 2016 Kei Hibino+category: Codec+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++library+ exposed-modules: Codec.Automotive.CSE++ other-modules:+ Backport.Crypto.MAC.CMAC+ Backport.Crypto.ConstructHash.MiyaguchiPreneel++ other-extensions: GeneralizedNewtypeDeriving+ build-depends: base >=4.6 && <5+ , bytestring+ , cereal+ , memory+ , cryptonite+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall++test-suite exTrue+ build-depends: base <5+ , quickcheck-simple+ , automotive-cse++ , bytestring+ , cryptonite++ type: exitcode-stdio-1.0+ main-is: expectTrue.hs+ -- other-modules:+ hs-source-dirs: test+ default-language: Haskell2010+ ghc-options: -Wall++source-repository head+ type: git+ location: https://github.com/khibino/haskell-automotive-cse++source-repository head+ type: mercurial+ location: https://bitbucket.org/khibino/haskell-automotive-cse
+ src/Backport/Crypto/ConstructHash/MiyaguchiPreneel.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Backport.Crypto.ConstructHash.MiyaguchiPreneel+ ( mp, mp'+ , MiyaguchiPreneel(..)+ , cipherInit'+ ) where++import Data.List (foldl')++import Crypto.Cipher.Types+import Crypto.Error (eitherCryptoError)+import Data.ByteArray (ByteArrayAccess, ByteArray, Bytes)+import qualified Data.ByteArray as B+++newtype MiyaguchiPreneel a = MP { chashGetBytes :: Bytes }+ deriving ByteArrayAccess++instance Eq (MiyaguchiPreneel a) where+ MP b1 == MP b2 = B.constEq b1 b2+++-- | Compute Miyaguchi-Preneel one way compress using the supplied block cipher.+mp' :: (ByteArrayAccess bin, BlockCipher cipher)+ => (Bytes -> cipher) -- ^ key build function to compute Miyaguchi-Preneel. care about block-size and key-size+ -> bin -- ^ input message+ -> MiyaguchiPreneel cipher -- ^ output tag+mp' g = MP . foldl' (step $ g) (B.replicate bsz 0) . chunks . B.convert+ where+ bsz = blockSize ( g B.empty {- dummy to get block size -} )+ chunks msg+ | B.null tl = [hd :: Bytes]+ | otherwise = hd : chunks tl+ where+ (hd, tl) = B.splitAt bsz msg++-- | Simple key build function, which may raise size error.+cipherInit' :: (ByteArray ba, Cipher k) => ba -> k+cipherInit' = either (error . show) id . eitherCryptoError . cipherInit++-- | Compute Miyaguchi-Preneel one way compress using the infered block cipher.+-- Only safe when KEY-SIZE equals to BLOCK-SIZE.+--+-- Simple usage /mp' msg :: MiyaguchiPreneel AES128/+mp :: (ByteArrayAccess bin, BlockCipher cipher)+ => bin -- ^ input message+ -> MiyaguchiPreneel cipher -- ^ output tag+mp = mp' cipherInit'++-- | computation step of Miyaguchi-Preneel+step :: (ByteArray ba, BlockCipher k)+ => (ba -> k)+ -> ba+ -> ba+ -> ba+step g iv msg =+ ecbEncrypt k pmsg `bxor` iv `bxor` pmsg+ where+ k = g iv+ pmsg = pad0 k msg++pad0 :: (ByteArray ba, BlockCipher k) => k -> ba -> ba+pad0 k s = s `B.append` B.replicate (blockSize k - B.length s) 0++bxor :: ByteArray ba => ba -> ba -> ba+bxor = B.xor
+ src/Backport/Crypto/MAC/CMAC.hs view
@@ -0,0 +1,121 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Backport.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 Data.ByteArray (ByteArrayAccess, ByteArray, Bytes)+import qualified Data.ByteArray as B+++newtype CMAC a = CMAC { cmacGetBytes :: 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 where++-- 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 = hd ++ setBit (head tl) r : tail tl where+ (q, r) = i `quotRem` 8+ (hd, tl) = splitAt q ws
+ src/Codec/Automotive/CSE.hs view
@@ -0,0 +1,165 @@++-- CSE (Cryptographic Service Engine) emulation implementation+module Codec.Automotive.CSE (+ M1 (M1), M2 (M2), M3 (M3), M4 (M4), M5 (M5),+ makeM1, makeM2, makeM3, makeM4, makeM5,++ K1, K2, K3, K4,+ makeK1, makeK2, makeK3, makeK4,++ Derived, kdf,++ DerivedCipher, derivedCipher,++ KeyAuthUse (..), Auth, NotAuth,+ ) where++import Control.Applicative ((<$>))+import Data.Monoid ((<>))+import Data.Bits (shiftL, (.|.))+import Data.Word (Word8, Word32)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Serialize.Put (runPut, putWord64be)++import qualified Data.ByteArray as B+import Crypto.Cipher.Types (cipherInit, ecbEncrypt, cbcEncrypt, nullIV)+import Crypto.Cipher.AES (AES128)+import Crypto.Error (CryptoError, eitherCryptoError)+import Backport.Crypto.MAC.CMAC (CMAC(..), cmac)+import Backport.Crypto.ConstructHash.MiyaguchiPreneel (MiyaguchiPreneel(..), mp)+++data Enc+data Mac++newtype UpdateC c =+ UpdateC ByteString+ deriving Eq++keyUpdateEncC :: UpdateC Enc+keyUpdateEncC =+ UpdateC . runPut $+ putWord64be 0x0101534845008000 >>+ putWord64be 0x00000000000000B0+ --- 0x010153484500800000000000000000B0++keyUpdateMacC :: UpdateC Mac+keyUpdateMacC =+ UpdateC . runPut $+ putWord64be 0x0102534845008000 >>+ putWord64be 0x00000000000000B0+ -- 0x010253484500800000000000000000B0++data Auth+data NotAuth++newtype KeyAuthUse k =+ KeyAuthUse ByteString+ deriving Eq++newtype Derived k c =+ Derived ByteString+ deriving Eq++kdf :: KeyAuthUse k -> UpdateC c -> Derived k c+kdf (KeyAuthUse k) (UpdateC c) = Derived . B.convert $ chashGetBytes (mp $ k <> c :: MiyaguchiPreneel AES128)++kdfEnc :: KeyAuthUse k -> Derived k Enc+kdfEnc = (`kdf` keyUpdateEncC)++kdfMac :: KeyAuthUse k -> Derived k Mac+kdfMac = (`kdf` keyUpdateMacC)++newtype DerivedCipher k c = DerivedCipher AES128++derivedCipher :: Derived k c -> Either CryptoError (DerivedCipher k c)+derivedCipher (Derived k) = DerivedCipher <$> (eitherCryptoError $ cipherInit k)++type K1' = Derived Auth Enc+type K1 = DerivedCipher Auth Enc++makeK1 :: KeyAuthUse Auth -- ^ AuthKey Data+ -> K1' -- ^ Result Hash value+makeK1 = kdfEnc++type K2' = Derived Auth Mac+type K2 = DerivedCipher Auth Mac++makeK2 :: KeyAuthUse Auth -- ^ AuthKey Data+ -> K2' -- ^ Result Hash value+makeK2 = kdfMac++type K3' = Derived NotAuth Enc+type K3 = DerivedCipher NotAuth Enc++makeK3 :: KeyAuthUse NotAuth -- ^ Key Data+ -> K3' -- ^ Result Hash value+makeK3 = kdfEnc++type K4' = Derived NotAuth Mac+type K4 = DerivedCipher NotAuth Mac++makeK4 :: KeyAuthUse NotAuth -- ^ Key Data+ -> K4' -- ^ Result Hash value+makeK4 = kdfMac+++newtype M1 = M1 ByteString deriving Eq++makeM1 :: ByteString -- ^ UID - 15 octet+ -> Word8 -- ^ Key ID - 4 bit+ -> Word8 -- ^ Auth key ID - 4 bit+ -> M1+makeM1 uid kid akid = M1 $ uid <> BS.singleton (kid `shiftL` 4 .|. akid)++newtype M2 = M2 ByteString deriving Eq++makeM2 :: K1 -- ^ K1 value+ -> Word32 -- ^ Counter - 28 bit+ -> Word8 -- ^ Key Flag - 6 bit+ -> KeyAuthUse NotAuth -- ^ Key Data for AES128+ -> M2+makeM2 (DerivedCipher k1) counter flags (KeyAuthUse keyData) =+ M2 $ cbcEncrypt k1 nullIV plain+ where+ plain = (runPut $ do+ putWord64be $+ fromIntegral counter `shiftL` 36 .|.+ fromIntegral flags `shiftL` 30+ --- fromIntegral (flags `shiftR` 1) `shiftL` 31 --- SHE standard+ putWord64be 0)+ <> keyData++newtype M3 = M3 ByteString deriving Eq++makeM3 :: K2+ -> M1+ -> M2+ -> M3+makeM3 (DerivedCipher k2) (M1 m1) (M2 m2) = M3 . B.convert . cmacGetBytes . cmac k2 $ m1 <> m2++newtype M4 = M4 ByteString deriving Eq++makeM4 :: ByteString+ -> Word8+ -> Word8+ -> K3+ -> Word32+ -> M4+makeM4 uid kid akid (DerivedCipher k3) counter =+ M4 $ p1 <> ecbEncrypt k3 p2+ where+ M1 p1 = makeM1 uid kid akid+ p2 = runPut $ do+ putWord64be $+ fromIntegral counter `shiftL` 36 .|.+ 1 `shiftL` 35+ putWord64be 0++newtype M5 = M5 ByteString deriving Eq++makeM5 :: K4+ -> M4+ -> M5+makeM5 (DerivedCipher k4) (M4 m4) = M5 . B.convert . cmacGetBytes $ cmac k4 m4
+ test/expectTrue.hs view
@@ -0,0 +1,117 @@++import Test.QuickCheck.Simple (Test, boolTest, defaultMain)++import Codec.Automotive.CSE+ (M1(M1), makeM1,+ M2(M2), makeM2,+ M3(M3), makeM3,+ M4(M4), makeM4,+ M5(M5), makeM5,+ KeyAuthUse (..), Auth, NotAuth, derivedCipher,+ makeK1, makeK2, makeK3, makeK4)++import Numeric (showHex, showInt)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Char (digitToInt)+import Data.Word (Word8, Word32)+import Crypto.Error (CryptoError)+++testAuthKey :: KeyAuthUse Auth+testAuthKey = KeyAuthUse $ hxs "00010203_04050607_08090a0b_0c0d0e0f"++testKey :: KeyAuthUse NotAuth+testKey = KeyAuthUse $ hxs "0f0e0d0c_0b0a0908_07060504_03020100"++testAuthKeyID :: Word8+testAuthKeyID = 1++testKeyID :: Word8+testKeyID = 4++testUID :: ByteString+testUID = hxs "000000000000000000000000000001"++testCounter :: Word32+testCounter = 1++testFlags :: Word8+testFlags = 0+++testM1 :: M1+testM1 = makeM1 testUID testKeyID testAuthKeyID++expectM1 :: Bool+expectM1 =+ testM1 == M1 (hxs "00000000000000000000000000000141")++testM2 :: Either CryptoError M2+testM2 = do+ k1 <- derivedCipher $ makeK1 testAuthKey+ return $ makeM2 k1 testCounter testFlags testKey++expectM2 :: Bool+expectM2 =+ testM2 == Right (M2 $ hxs "2b111e2d93f486566bcbba1d7f7a9797_c94643b050fc5d4d7de14cff682203c3")++testM3 :: Either CryptoError M3+testM3 = do+ k2 <- derivedCipher $ makeK2 testAuthKey+ m2 <- testM2+ return $ makeM3 k2 testM1 m2++expectM3 :: Bool+expectM3 =+ testM3 == Right (M3 $ hxs "b9d745e5ace7d41860bc63c2b9f5bb46")++testM4 :: Either CryptoError M4+testM4 = do+ k3 <- derivedCipher $ makeK3 testKey+ return $ makeM4 testUID testKeyID testAuthKeyID k3 testCounter++expectM4 :: Bool+expectM4 =+ testM4 == Right (M4 $ hxs "00000000000000000000000000000141_b472e8d8727d70d57295e74849a27917")++testM5 :: Either CryptoError M5+testM5 = do+ k4 <- derivedCipher $ makeK4 testKey+ m4 <- testM4+ return $ makeM5 k4 m4++expectM5 :: Bool+expectM5 =+ testM5 == Right (M5 $ hxs "820d8d95dc11b4668878160cb2a4e23e")++hxs :: String -> ByteString+hxs = BS.pack . rec' where+ dtoW8 = fromIntegral . digitToInt+ rec' (' ':xs) = rec' xs+ rec' ('_':xs) = rec' xs+ rec' (x:y:xs) = dtoW8 x * 16 + dtoW8 y : rec' xs+ rec' [_] = error "hxs: invalid hex pattern."+ rec' [] = []++_dump :: ByteString -> String+_dump = (`rec'` []) . BS.unpack where+ rec' [] = id+ rec' (w:ws) = (if w < 16 then ('0' :) . showHex w else showHex w) . rec' ws++_dumpD :: ByteString -> String+_dumpD = (`rec'` []) . BS.unpack where+ rec' [] = id+ rec' (w:ws) = showInt w . ("," ++) . rec' ws+++tests :: [Test]+tests = [ boolTest "M1" expectM1+ , boolTest "M2" expectM2+ , boolTest "M3" expectM3+ , boolTest "M4" expectM4+ , boolTest "M5" expectM5+ ]++main :: IO ()+main = defaultMain tests