diff --git a/automotive-cse.cabal b/automotive-cse.cabal --- a/automotive-cse.cabal +++ b/automotive-cse.cabal @@ -1,6 +1,6 @@ name: automotive-cse -version: 0.0.1.1 +version: 0.0.2.0 synopsis: Automotive CSE emulation description: This package includes Cryptography Security Engine (CSE) codec emulation for automotive things. @@ -27,7 +27,7 @@ Backport.Crypto.ConstructHash.MiyaguchiPreneel other-extensions: GeneralizedNewtypeDeriving - build-depends: base >=4.6 && <5 + build-depends: base >=4.5 && <5 , bytestring , cereal , memory @@ -36,8 +36,9 @@ default-language: Haskell2010 ghc-options: -Wall -test-suite exTrue +test-suite tests build-depends: base <5 + , QuickCheck , quickcheck-simple , automotive-cse @@ -45,8 +46,10 @@ , cryptonite type: exitcode-stdio-1.0 - main-is: expectTrue.hs - -- other-modules: + main-is: runTests.hs + other-modules: + TestVector + Iso hs-source-dirs: test default-language: Haskell2010 ghc-options: -Wall diff --git a/src/Codec/Automotive/CSE.hs b/src/Codec/Automotive/CSE.hs --- a/src/Codec/Automotive/CSE.hs +++ b/src/Codec/Automotive/CSE.hs @@ -1,35 +1,57 @@ -- 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, + M1, unM1, makeM1, extractM1, + M2, unM2, makeM2, + M3, unM3, makeM3, + M4, unM4, makeM4, extractM4, makeM4', extractM4', + M5, unM5, makeM5, - K1, K2, K3, K4, - makeK1, makeK2, makeK3, makeK4, + K1, K1', makeK1, + K2, K2', makeK2, + K3, K3', makeK3, + K4, K4', makeK4, - Derived, kdf, + UID, unUID, makeUID, + Derived, unDerived, + kdf, keyUpdateEncC, keyUpdateMacC, + DerivedCipher, derivedCipher, - KeyAuthUse (..), Auth, NotAuth, + KeyAuthUse, Auth, NotAuth, + makeKeyAuthUse, unKeyAuthUse, + + UpdateC, Enc, Mac, ) where -import Control.Applicative ((<$>)) -import Data.Monoid ((<>)) -import Data.Bits (shiftL, (.|.)) +import Control.Monad (MonadPlus, guard) +import Data.Monoid ((<>), mconcat, Endo (..)) +import Data.Bits (shiftL, shiftR, (.&.), (.|.)) import Data.Word (Word8, Word32) import Data.ByteString (ByteString) import qualified Data.ByteString as BS +import Data.Serialize.Get (runGet, getWord64be) import Data.Serialize.Put (runPut, putWord64be) +import Numeric (showHex) import qualified Data.ByteArray as B -import Crypto.Cipher.Types (cipherInit, ecbEncrypt, cbcEncrypt, nullIV) +import Crypto.Cipher.Types (cipherInit, ecbEncrypt, cbcEncrypt, nullIV, ecbDecrypt) import Crypto.Cipher.AES (AES128) -import Crypto.Error (CryptoError, eitherCryptoError) +import Crypto.Error (eitherCryptoError) + import Backport.Crypto.MAC.CMAC (CMAC(..), cmac) import Backport.Crypto.ConstructHash.MiyaguchiPreneel (MiyaguchiPreneel(..), mp) +hdump :: ByteString -> String +hdump = (`appEndo` "") . mconcat . map (Endo . showW8) . BS.unpack + where + showW8 w + | w < 16 = ('0' :) . showHex w + | otherwise = showHex w + + data Enc data Mac @@ -37,6 +59,9 @@ UpdateC ByteString deriving Eq +instance Show (UpdateC c) where + show (UpdateC c) = unwords ["UpdateC", hdump c] + keyUpdateEncC :: UpdateC Enc keyUpdateEncC = UpdateC . runPut $ @@ -58,10 +83,24 @@ KeyAuthUse ByteString deriving Eq +makeKeyAuthUse :: MonadPlus m => ByteString -> m (KeyAuthUse k) +makeKeyAuthUse k = do + guard $ BS.length k == 16 + return $ KeyAuthUse k + +unKeyAuthUse :: KeyAuthUse k -> ByteString +unKeyAuthUse (KeyAuthUse bs) = bs + newtype Derived k c = Derived ByteString deriving Eq +instance Show (Derived k c) where + show (Derived k) = unwords ["DerivedCipher", hdump k] + +unDerived :: Derived k c -> ByteString +unDerived (Derived k) = k + kdf :: KeyAuthUse k -> UpdateC c -> Derived k c kdf (KeyAuthUse k) (UpdateC c) = Derived . B.convert $ chashGetBytes (mp $ k <> c :: MiyaguchiPreneel AES128) @@ -73,8 +112,12 @@ newtype DerivedCipher k c = DerivedCipher AES128 -derivedCipher :: Derived k c -> Either CryptoError (DerivedCipher k c) -derivedCipher (Derived k) = DerivedCipher <$> (eitherCryptoError $ cipherInit k) +derivedCipher :: Derived k c -> DerivedCipher k c +derivedCipher (Derived k) = + DerivedCipher + . either (error . ("Codec.Automotive.CSE.derivedCipher: internal error: " ++) . show) id + -- assume refined length (16 byte) of miyaguchi-preneel AES128 result + . eitherCryptoError $ cipherInit k type K1' = Derived Auth Enc type K1 = DerivedCipher Auth Enc @@ -105,16 +148,45 @@ makeK4 = kdfMac +newtype UID = UID ByteString deriving Eq + +instance Show UID where + show (UID s) = unwords ["UID", hdump s] + +unUID :: UID -> ByteString +unUID (UID u) = u + +makeUID :: MonadPlus m => ByteString -> m UID +makeUID s = do + guard $ BS.length s == 15 + return $ UID s + newtype M1 = M1 ByteString deriving Eq -makeM1 :: ByteString -- ^ UID - 15 octet +instance Show M1 where + show (M1 s) = unwords ["M1", hdump s] + +makeM1 :: UID -- ^ 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) +makeM1 (UID uid) kid akid = M1 $ uid <> BS.singleton (kid `shiftL` 4 .|. akid) +unM1 :: M1 -> ByteString +unM1 (M1 m1) = m1 + +extractM1 :: M1 -> (UID, Word8, Word8) +extractM1 (M1 m1) = (UID uid, lw `shiftR` 4, lw .&. 0x0F) + where + (uid, x) = BS.splitAt 15 m1 + lw = head $ BS.unpack x + -- assume refined M1 + newtype M2 = M2 ByteString deriving Eq +instance Show M2 where + show (M2 s) = unwords ["M2", hdump s] + makeM2 :: K1 -- ^ K1 value -> Word32 -- ^ Counter - 28 bit -> Word8 -- ^ Key Flag - 6 bit @@ -131,35 +203,73 @@ putWord64be 0) <> keyData +unM2 :: M2 -> ByteString +unM2 (M2 m2) = m2 + newtype M3 = M3 ByteString deriving Eq +instance Show M3 where + show (M3 s) = unwords ["M3", hdump s] + makeM3 :: K2 -> M1 -> M2 -> M3 makeM3 (DerivedCipher k2) (M1 m1) (M2 m2) = M3 . B.convert . cmacGetBytes . cmac k2 $ m1 <> m2 +unM3 :: M3 -> ByteString +unM3 (M3 m3) = m3 + 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 +instance Show M4 where + show (M4 s) = unwords ["M4", hdump s] + +makeM4' :: K3 + -> M1 + -> Word32 + -> M4 +makeM4' (DerivedCipher k3) (M1 m1) counter = + M4 $ m1 <> ecbEncrypt k3 p2 where - M1 p1 = makeM1 uid kid akid p2 = runPut $ do putWord64be $ fromIntegral counter `shiftL` 36 .|. 1 `shiftL` 35 putWord64be 0 +makeM4 :: K3 + -> UID + -> Word8 + -> Word8 + -> Word32 + -> M4 +makeM4 k3 uid kid akid counter = + makeM4' k3 (makeM1 uid kid akid) counter + +unM4 :: M4 -> ByteString +unM4 (M4 m4) = m4 + +extractM4' :: K3 -> M4 -> (M1, Word32) +extractM4' (DerivedCipher k3) (M4 m4) = (M1 m1, fromIntegral $ w64 `shiftR` 36) + where + (m1, m4') = BS.splitAt 16 m4 + w64 = either (error . ("Codec.Automotive.CSE.extractM4: internal error: " ++)) id + . runGet getWord64be $ ecbDecrypt k3 m4' + +extractM4 :: K3 -> M4 -> ((UID, Word8, Word8), Word32) +extractM4 k3 m4 = (extractM1 m1, counter) + where (m1, counter) = extractM4' k3 m4 + newtype M5 = M5 ByteString deriving Eq +instance Show M5 where + show (M5 s) = unwords ["M5", hdump s] + makeM5 :: K4 -> M4 -> M5 makeM5 (DerivedCipher k4) (M4 m4) = M5 . B.convert . cmacGetBytes $ cmac k4 m4 + +unM5 :: M5 -> ByteString +unM5 (M5 m4) = m4 diff --git a/test/Iso.hs b/test/Iso.hs new file mode 100644 --- /dev/null +++ b/test/Iso.hs @@ -0,0 +1,68 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE FlexibleInstances #-} + +module Iso (tests) where + +import Test.QuickCheck.Simple (Test, qcTest) +import Test.QuickCheck (Arbitrary (..), choose) + +import Codec.Automotive.CSE + (UID, makeUID, M1, makeM1, extractM1, M4, makeM4, extractM4, + KeyAuthUse, makeKeyAuthUse, derivedCipher, K3, K3', makeK3) + +import Control.Applicative ((<$>), (<*>)) +import Control.Monad (replicateM) +import Data.Maybe (fromJust) +import Data.Word (Word8) +import qualified Data.ByteString as BS + + +newtype KeyID = KeyID { unKeyID :: Word8 } + +instance Arbitrary KeyID where + arbitrary = KeyID <$> choose (0, 15) + +instance Arbitrary (KeyAuthUse k) where + arbitrary = fromJust . makeKeyAuthUse . BS.pack <$> replicateM 16 arbitrary + +instance Arbitrary UID where + arbitrary = fromJust . makeUID . BS.pack <$> replicateM 15 arbitrary + +instance Arbitrary K3' where + arbitrary = makeK3 <$> arbitrary + +instance Arbitrary M1 where + arbitrary = + makeM1 + <$> arbitrary + <*> (unKeyID <$> arbitrary) + <*> (unKeyID <$> arbitrary) + +newtype GenM4 = GenM4 (K3 -> M4) + +instance Show GenM4 where + show = const "GenM4" + +instance Arbitrary GenM4 where + arbitrary = do + uid <- arbitrary + kid <- unKeyID <$> arbitrary + akid <- unKeyID <$> arbitrary + c <- choose (0, 2^(28 :: Int) - 1) + return . GenM4 $ \k3 -> makeM4 k3 uid kid akid c + +isoM1 :: M1 -> Bool +isoM1 m1 = makeM1 uid kid akid == m1 + where (uid, kid, akid) = extractM1 m1 + +isoM4 :: K3' -> GenM4 -> Bool +isoM4 k3' (GenM4 g) = makeM4 k3 uid kid akid c == m4 + where ((uid, kid, akid), c) = extractM4 k3 m4 + k3 = derivedCipher k3' + m4 = g k3 + +tests :: [Test] +tests = + [ qcTest "iso - M1 extract make" isoM1 + , qcTest "iso - M4 extract make" isoM4 + ] diff --git a/test/TestVector.hs b/test/TestVector.hs new file mode 100644 --- /dev/null +++ b/test/TestVector.hs @@ -0,0 +1,128 @@ +module TestVector (tests) where + +import Test.QuickCheck.Simple (Test, boolTest) + +import Codec.Automotive.CSE + (M1, unM1, makeM1, extractM1, + M2, unM2, makeM2, + M3, unM3, makeM3, + M4, unM4, makeM4, extractM4, + M5, unM5, makeM5, + UID, makeUID, + KeyAuthUse, Auth, NotAuth, makeKeyAuthUse, derivedCipher, + K3, makeK1, makeK2, makeK3, makeK4) + +import Numeric (showHex, showInt) +import Data.Maybe (fromJust) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Char (digitToInt) +import Data.Word (Word8, Word32) + + +{- + Following test vectors are calculated using the implementation: + https://github.com/naohaq/CSE_KeyGen/tree/master/C + with input params: + https://github.com/naohaq/CSE_KeyGen/blob/master/param_sample.txt + -} + +testAuthKey :: KeyAuthUse Auth +testAuthKey = fromJust . makeKeyAuthUse $ hxs "00010203_04050607_08090a0b_0c0d0e0f" + +testKey :: KeyAuthUse NotAuth +testKey = fromJust . makeKeyAuthUse $ hxs "0f0e0d0c_0b0a0908_07060504_03020100" + +testAuthKeyID :: Word8 +testAuthKeyID = 1 + +testKeyID :: Word8 +testKeyID = 4 + +testUID :: UID +testUID = fromJust . makeUID $ hxs "000000000000000000000000000001" + +testCounter :: Word32 +testCounter = 1 + +testFlags :: Word8 +testFlags = 0 + + +testM1 :: M1 +testM1 = makeM1 testUID testKeyID testAuthKeyID + +expectM1 :: Bool +expectM1 = + unM1 testM1 == hxs "00000000000000000000000000000141" + +expectE1 :: Bool +expectE1 = extractM1 testM1 == (testUID, testKeyID, testAuthKeyID) + +testM2 :: M2 +testM2 = + makeM2 (derivedCipher $ makeK1 testAuthKey) testCounter testFlags testKey + +expectM2 :: Bool +expectM2 = + unM2 testM2 == hxs "2b111e2d93f486566bcbba1d7f7a9797_c94643b050fc5d4d7de14cff682203c3" + +testM3 :: M3 +testM3 = + makeM3 (derivedCipher $ makeK2 testAuthKey) testM1 testM2 + +expectM3 :: Bool +expectM3 = + unM3 testM3 == hxs "b9d745e5ace7d41860bc63c2b9f5bb46" + +testK3 :: K3 +testK3 = derivedCipher $ makeK3 testKey + +testM4 :: M4 +testM4 = + makeM4 testK3 testUID testKeyID testAuthKeyID testCounter + +expectM4 :: Bool +expectM4 = + unM4 testM4 == hxs "00000000000000000000000000000141_b472e8d8727d70d57295e74849a27917" + +expectE4 :: Bool +expectE4 = extractM4 testK3 testM4 == ((testUID, testKeyID, testAuthKeyID), testCounter) + +testM5 :: M5 +testM5 = + makeM5 (derivedCipher $ makeK4 testKey) testM4 + +expectM5 :: Bool +expectM5 = + unM5 testM5 == 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 "extract M1" expectE1 + , boolTest "M2" expectM2 + , boolTest "M3" expectM3 + , boolTest "M4" expectM4 + , boolTest "extract M4" expectE4 + , boolTest "M5" expectM5 + ] diff --git a/test/expectTrue.hs b/test/expectTrue.hs deleted file mode 100644 --- a/test/expectTrue.hs +++ /dev/null @@ -1,124 +0,0 @@ - -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) - - -{- - Following test vectors are calculated using the implementation: - https://github.com/naohaq/CSE_KeyGen/tree/master/C - with input params: - https://github.com/naohaq/CSE_KeyGen/blob/master/param_sample.txt - -} - -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 diff --git a/test/runTests.hs b/test/runTests.hs new file mode 100644 --- /dev/null +++ b/test/runTests.hs @@ -0,0 +1,9 @@ +import Test.QuickCheck.Simple (defaultMain) + +import qualified TestVector +import qualified Iso + + +main :: IO () +main = + defaultMain $ TestVector.tests ++ Iso.tests