automotive-cse-0.1.5.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, KeyAuthUse, makeKeyAuthUse, derivedCipher, K1, K1', makeK1, K3, K3', makeK3,
   M1, unM1, makeM1, extractM1, refineM1, M2, unM2, makeM2, extractM2, refineM2, M4, makeM4, extractM4)

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 K1' where
  arbitrary = makeK1 <$> arbitrary

instance Arbitrary K3' where
  arbitrary = makeK3 <$> arbitrary

newtype GenM1 = GenM1 M1

instance Show GenM1 where
  show (GenM1 m1) = unwords ["GenM1", show m1]

instance Arbitrary GenM1 where
  arbitrary =
    GenM1
    <$> (makeM1
         <$> arbitrary
         <*> (unKeyID <$> arbitrary)
         <*> (unKeyID <$> arbitrary))

newtype GenM2 = GenM2 (K1 -> M2)

instance Show GenM2 where
  show = const "GenM2"

instance Arbitrary GenM2 where
  arbitrary = do
    c     <-  choose (0, 2^(28 :: Int) - 1)
    f     <-  choose (0, 2^(6 :: Int) - 1)
    key   <-  arbitrary
    return . GenM2 $ \k1 -> makeM2 k1 c f key

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 :: GenM1 -> Bool
isoM1 (GenM1 m1) = makeM1 uid kid akid == m1
  where (uid, kid, akid) = extractM1 m1

isoRefineM1 :: GenM1 -> Bool
isoRefineM1 (GenM1 m1) = refineM1 (unM1 m1) == Just (m1, t)
  where t = extractM1 m1

isoM2 :: K1' -> GenM2 -> Bool
isoM2 k1' (GenM2 g) = makeM2 k1 c f key == m2
  where (c, f, key) = extractM2 k1 m2
        k1 = derivedCipher k1'
        m2 = g k1

isoRefineM2 :: K1' -> GenM2 -> Bool
isoRefineM2 k1' (GenM2 g) = refineM2 k1 (unM2 m2) == Just (m2, t)
  where t = extractM2 k1 m2
        k1 = derivedCipher k1'
        m2 = g k1

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 - M1 refine extract" isoRefineM1
  , qcTest "iso - M2 extract make" isoM2
  , qcTest "iso - M2 refine extract" isoRefineM2
  , qcTest "iso - M4 extract make" isoM4
  ]