automotive-cse-0.0.2.0: test/Iso.hs

{-# 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
  ]