diff --git a/generation/Test.hs b/generation/Test.hs index b744f16..99cd0f5 100644 --- a/generation/Test.hs +++ b/generation/Test.hs @@ -1,4 +1,47 @@ +import Data.Bits hiding (bit) +import Debug.Trace +import GHC.Integer.GMP.Internals import qualified Karatsuba +import Numeric +import Test.QuickCheck + +modular_exponentiation :: Integer -> Integer -> Integer -> Integer +modular_exponentiation x y m = m_e_loop x y 1 + where + m_e_loop _ 0 result = result + m_e_loop b e result = m_e_loop b' e' result' + where + b' = (b * b) `mod` m + e' = e `shiftR` 1 + result' = if testBit e 0 then (result * b) `mod` m else result + +prop_modExpSane :: Integer -> Integer -> Integer -> Property +prop_modExpSane b e m = (m' > 1) ==> modular_exponentiation b' e' m' == powModInteger b' e' m' + where + b' = abs b + e' = abs e + m' = abs m + +modexpLR :: Int -> Integer -> Integer -> Integer -> Integer +modexpLR bitsize b e m = go (bitsize - 1) 1 + where + go bit r0 + | bit < 0 = r0 + | testBit e bit = trace ("1: r = " ++ showHex r2 "") $ go (bit - 1) r2 + | otherwise = trace ("0: r = " ++ showHex r1 "") $ go (bit - 1) r1 + where + r1 = (r0 * r0) `mod` m + r2 = (r1 * b) `mod` m + +prop_modExpLR192 :: Integer -> Integer -> Integer -> Property +prop_modExpLR192 b e m = (m' > 1) ==> modexpLR 192 b' e' m' == powModInteger b' e' m' + where + b' = abs b `mod` (2 ^ (192 :: Integer)) + e' = abs e `mod` (2 ^ (192 :: Integer)) + m' = abs m `mod` (2 ^ (192 :: Integer)) main :: IO () -main = Karatsuba.runChecks +main = + do Karatsuba.runChecks + Karatsuba.runQuickCheck "Modular exponentiation sanity check" prop_modExpSane + Karatsuba.runQuickCheck "ModExp LR 192 works" prop_modExpLR192 diff --git a/generation/generation.cabal b/generation/generation.cabal index 3d80b2f..1b7ba21 100644 --- a/generation/generation.cabal +++ b/generation/generation.cabal @@ -58,4 +58,4 @@ test-suite test-generation default-language: Haskell2010 main-is: Test.hs ghc-options: -Wall - build-depends: base, generation + build-depends: base, generation, integer-gmp, QuickCheck diff --git a/generation/src/ModOps.hs b/generation/src/ModOps.hs index 42bc935..1b72b2d 100644 --- a/generation/src/ModOps.hs +++ b/generation/src/ModOps.hs @@ -5,7 +5,6 @@ module ModOps(modulusOps) import Data.Map.Strict(Map) import qualified Data.Map.Strict as Map import File -import Gen(toLit) import Generators import GHC.Integer.GMP.Internals(powModInteger) import Language.Rust.Data.Ident @@ -15,7 +14,7 @@ import Language.Rust.Syntax import System.Random(RandomGen) numTestCases :: Int -numTestCases = 3000 +numTestCases = 1000 modulusOps :: File modulusOps = File { @@ -30,9 +29,15 @@ declareModOps :: Word -> [Word] -> SourceFile Span declareModOps bitsize _ = let sname = mkIdent ("U" ++ show bitsize) bname = mkIdent ("U" ++ show (bitsize * 2)) - in [sourceFile| - use crate::unsigned::$$sname; + testFileLit = Lit [] (Str (testFile bitsize) Cooked Unsuffixed mempty) mempty + in [sourceFile| + use core::convert::TryFrom; + use crate::unsigned::{$$sname, $$bname}; use crate::{DivMod, ModularOperations}; + #[cfg(test)] + use crate::CryptoNum; + #[cfg(test)] + use crate::testing::{build_test_path,run_test}; impl ModularOperations for $$sname { fn reduce(&self, m: &$$sname) -> $$sname { @@ -41,18 +46,69 @@ declareModOps bitsize _ = } fn modmul(&self, y: &$$sname, m: &$$sname) -> $$sname { - panic!("modmul") + let r = self * y; + let bigm = $$bname::from(m); + let bigres = r % bigm; + $$sname::try_from(bigres) + .expect("Mathematics is broken?! (mod returned too big result") } fn modsq(&self, m: &$$sname) -> $$sname { - panic!("reduce") + let r = self * self; + let bigm = $$bname::from(m); + let bigres = r % bigm; + $$sname::try_from(bigres) + .expect("Mathematics is broken?! (mod returned too big result") } fn modexp(&self, e: &$$sname, m: &$$sname) -> $$sname { - panic!("reduce") + let mut r = $$sname::from(1u64); + let bigm = $$bname::from(m); + + for digit in e.value.iter().rev() { + for bit in (0..64).rev() { + r = r.modsq(&m); + let big_possible_r = (&r * self) % &bigm; + let possible_r = $$sname::try_from(big_possible_r) + .expect("Math is broken (again)"); + let bit = (*digit >> bit) & 1; + r = if bit == 1 { possible_r } else { r }; + } + } + + r } } - |] + + #[cfg(test)] + #[allow(non_snake_case)] + #[test] + fn KATs() { + run_test(build_test_path("modops", $$(testFileLit)), 7, |case| { + let (neg0, xbytes) = case.get("x").unwrap(); + let (neg1, ybytes) = case.get("y").unwrap(); + let (neg2, mbytes) = case.get("m").unwrap(); + let (neg3, rbytes) = case.get("r").unwrap(); + let (neg4, tbytes) = case.get("t").unwrap(); + let (neg5, sbytes) = case.get("s").unwrap(); + let (neg6, ebytes) = case.get("e").unwrap(); + + assert!(!neg0 && !neg1 && !neg2 && !neg3 && !neg4 && !neg5 && !neg6); + let x = $$sname::from_bytes(&xbytes); + let y = $$sname::from_bytes(&ybytes); + let m = $$sname::from_bytes(&mbytes); + let r = $$sname::from_bytes(&rbytes); + let t = $$sname::from_bytes(&tbytes); + let s = $$sname::from_bytes(&sbytes); + let e = $$sname::from_bytes(&ebytes); + + assert_eq!(r, x.reduce(&m)); + assert_eq!(t, x.modmul(&y, &m)); + assert_eq!(s, x.modsq(&m)); + assert_eq!(e, x.modexp(&y, &m)); + }); + } + |] generateModulusTests :: RandomGen g => Word -> g -> [Map String String] generateModulusTests size g = go g numTestCases diff --git a/src/testing.rs b/src/testing.rs index 23530d9..d94126c 100644 --- a/src/testing.rs +++ b/src/testing.rs @@ -63,7 +63,6 @@ fn next_test_case(contents: &mut Lines, lines: usize) -> pub fn run_test(fname: PathBuf, i: usize, f: F) where F: Fn(HashMap)>) { - println!("fname: {:?}", fname); let mut file = File::open(fname).unwrap(); let mut contents = String::new(); file.read_to_string(&mut contents).unwrap();