module Codec.Automotive.CSE (
M1, unM1, makeM1, extractM1,
M2, unM2, makeM2,
M3, unM3, makeM3,
M4, unM4, makeM4, extractM4, makeM4', extractM4',
M5, unM5, makeM5,
K1, K1', makeK1,
K2, K2', makeK2,
K3, K3', makeK3,
K4, K4', makeK4,
UID, unUID, makeUID,
Derived, unDerived,
kdf, keyUpdateEncC, keyUpdateMacC,
DerivedCipher, derivedCipher,
KeyAuthUse, Auth, NotAuth,
makeKeyAuthUse, unKeyAuthUse,
UpdateC, Enc, Mac,
) where
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.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as Short
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, ecbDecrypt)
import Crypto.Cipher.AES (AES128)
import Crypto.Error (eitherCryptoError)
import Backport.Crypto.MAC.CMAC (CMAC(..), cmac)
import Backport.Crypto.ConstructHash.MiyaguchiPreneel (MiyaguchiPreneel(..), mp)
dump8 :: [Word8] -> String
dump8 = (`appEndo` "") . mconcat . map (Endo . showW8)
where
showW8 w
| w < 16 = ('0' :) . showHex w
| otherwise = showHex w
hdump :: ByteString -> String
hdump = dump8 . BS.unpack
hdump' :: ShortByteString -> String
hdump' = dump8 . Short.unpack
data Enc
data Mac
newtype UpdateC c =
UpdateC ByteString
deriving Eq
instance Show (UpdateC c) where
show (UpdateC c) = unwords ["UpdateC", hdump c]
keyUpdateEncC :: UpdateC Enc
keyUpdateEncC =
UpdateC . runPut $
putWord64be 0x0101534845008000 >>
putWord64be 0x00000000000000B0
keyUpdateMacC :: UpdateC Mac
keyUpdateMacC =
UpdateC . runPut $
putWord64be 0x0102534845008000 >>
putWord64be 0x00000000000000B0
data Auth
data NotAuth
newtype KeyAuthUse k =
KeyAuthUse ShortByteString
deriving Eq
makeKeyAuthUse :: MonadPlus m => ByteString -> m (KeyAuthUse k)
makeKeyAuthUse k = do
guard $ BS.length k == 16
return . KeyAuthUse $ Short.toShort k
unKeyAuthUse :: KeyAuthUse k -> ByteString
unKeyAuthUse (KeyAuthUse bs) = Short.fromShort bs
newtype Derived k c =
Derived ShortByteString
deriving Eq
instance Show (Derived k c) where
show (Derived k) = unwords ["DerivedCipher", hdump' k]
unDerived :: Derived k c -> ByteString
unDerived (Derived k) = Short.fromShort k
kdf :: KeyAuthUse k -> UpdateC c -> Derived k c
kdf k (UpdateC c) =
Derived . Short.toShort . B.convert
$ chashGetBytes (mp $ unKeyAuthUse 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 -> DerivedCipher k c
derivedCipher k =
DerivedCipher
. either (error . ("Codec.Automotive.CSE.derivedCipher: internal error: " ++) . show) id
. eitherCryptoError . cipherInit $ unDerived k
type K1' = Derived Auth Enc
type K1 = DerivedCipher Auth Enc
makeK1 :: KeyAuthUse Auth
-> K1'
makeK1 = kdfEnc
type K2' = Derived Auth Mac
type K2 = DerivedCipher Auth Mac
makeK2 :: KeyAuthUse Auth
-> K2'
makeK2 = kdfMac
type K3' = Derived NotAuth Enc
type K3 = DerivedCipher NotAuth Enc
makeK3 :: KeyAuthUse NotAuth
-> K3'
makeK3 = kdfEnc
type K4' = Derived NotAuth Mac
type K4 = DerivedCipher NotAuth Mac
makeK4 :: KeyAuthUse NotAuth
-> K4'
makeK4 = kdfMac
newtype UID = UID ShortByteString deriving (Eq, Ord)
instance Show UID where
show (UID s) = unwords ["UID", hdump' s]
unUID :: UID -> ByteString
unUID (UID u) = Short.fromShort u
makeUID :: MonadPlus m => ByteString -> m UID
makeUID s = do
guard $ BS.length s == 15
return . UID $ Short.toShort s
newtype M1 = M1 ByteString deriving Eq
instance Show M1 where
show (M1 s) = unwords ["M1", hdump s]
makeM1 :: UID
-> Word8
-> Word8
-> M1
makeM1 uid kid akid = M1 $ unUID uid <> BS.singleton (kid `shiftL` 4 .|. akid)
unM1 :: M1 -> ByteString
unM1 (M1 m1) = m1
extractM1 :: M1 -> (UID, Word8, Word8)
extractM1 (M1 m1) = (UID $ Short.toShort uid, lw `shiftR` 4, lw .&. 0x0F)
where
(uid, x) = BS.splitAt 15 m1
lw = head $ BS.unpack x
newtype M2 = M2 ByteString deriving Eq
instance Show M2 where
show (M2 s) = unwords ["M2", hdump s]
makeM2 :: K1
-> Word32
-> Word8
-> KeyAuthUse NotAuth
-> M2
makeM2 (DerivedCipher k1) counter flags keyData =
M2 $ cbcEncrypt k1 nullIV plain
where
plain = (runPut $ do
putWord64be $
fromIntegral counter `shiftL` 36 .|.
fromIntegral flags `shiftL` 30
putWord64be 0)
<> unKeyAuthUse 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
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
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