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