automotive-cse 0.0.1.1 → 0.0.2.0

raw patch · 6 files changed

+347/−153 lines, 6 filesdep +QuickCheckdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• automotive-cse.cabal +8/−5
• src/Codec/Automotive/CSE.hs +134/−24
• test/Iso.hs +68/−0
• test/TestVector.hs +128/−0
• test/expectTrue.hs +0/−124
• test/runTests.hs +9/−0

@@ -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

@@ -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

@@ -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+  ]

@@ -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+        ]

@@ -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

@@ -0,0 +1,9 @@+import Test.QuickCheck.Simple (defaultMain)++import qualified TestVector+import qualified Iso+++main :: IO ()+main =+  defaultMain $ TestVector.tests ++ Iso.tests