lol-0.2.0.0: tests/ZqTests.hs

{-# LANGUAGE NoImplicitPrelude, RebindableSyntax, ScopedTypeVariables, DataKinds, TypeOperators, PolyKinds, FlexibleContexts, RankNTypes, KindSignatures, MultiParamTypeClasses #-}

module ZqTests (zqTests) where

import Crypto.Lol.Types.ZqBasic
import Crypto.Lol.LatticePrelude hiding (Nat)
import Crypto.Lol.Reflects

import Control.Monad

import GHC.TypeLits

import Test.Framework
import Test.Framework.Providers.QuickCheck2
import Test.QuickCheck


prop_add :: forall (q :: Nat) . (Reflects q Int, KnownNat q) => Proxy q -> Int -> Int -> Bool
prop_add _ x y = (fromIntegral $ x + y) == ((fromIntegral x) + (fromIntegral y :: ZqBasic q Int))

prop_mul :: forall (q :: Nat) . (Reflects q Int, KnownNat q) => Proxy q -> Int -> Int -> Bool
prop_mul _ x y = (fromIntegral $ x * y) == ((fromIntegral x) * (fromIntegral y :: ZqBasic q Int))

prop_recip :: forall (q :: Nat) . (Reflects q Int, KnownNat q) => Proxy q -> Int -> Bool
prop_recip _ x = let qval = proxy value (Proxy::Proxy q)
                     y = fromIntegral x :: ZqBasic q Int
                 in if (x `mod` qval) == 0
                    then True
                    else (fromIntegral (1::Int)) == (y * (recip y))

type ZqModuli = '[7, 13, 17, 11, 13, 29]

class CallZqProp xs where
  callProp :: Proxy xs -> Gen Int -> (forall (q :: Nat) . (Reflects q Int, KnownNat q) => Proxy q -> Int -> Int -> Bool) -> [Test]

  callProp2 :: Proxy xs 
                -> Gen Int 
                -> (forall (q :: Nat) . (Reflects q Int, KnownNat q) => Proxy q -> Int -> Bool)
                -> [Test]

instance CallZqProp '[] where
  callProp _ _ _ = []
  callProp2 _ _ _ = []

instance (CallZqProp qs, KnownNat q) => CallZqProp (q ': qs) where
  callProp _ gen f = (testProperty ("q = " ++ (show $ (proxy value (Proxy::Proxy q) :: Int))) $ property $ liftM2 (f (Proxy::Proxy q)) gen gen) : (callProp (Proxy::Proxy qs) gen f)
  callProp2 _ gen f = (testProperty ("q = " ++ (show $ (proxy value (Proxy::Proxy q) :: Int))) $ property $ liftM (f (Proxy::Proxy q)) gen) : (callProp2 (Proxy::Proxy qs) gen f)

zqModuli :: Proxy ZqModuli
zqModuli = Proxy

zqTests :: [Test]
zqTests = 
  [testGroup "ZqBasic +" $ callProp zqModuli (choose (-100,100)) prop_add,
   testGroup "ZqBasic *" $ callProp zqModuli (choose (-100,100)) prop_mul,
   testGroup "ZqBasic recip" $ callProp2 zqModuli (choose (-100,100)) prop_recip]