diff --git a/Crypto/Cipher/DH.hs b/Crypto/Cipher/DH.hs new file mode 100644 --- /dev/null +++ b/Crypto/Cipher/DH.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- | +-- Module : Crypto.Cipher.DH +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +module Crypto.Cipher.DH + ( Params + , PublicNumber + , PrivateNumber + , SharedKey + , generatePublic + , getShared + ) where + +import Number.ModArithmetic (exponantiation_rtl_binary) +import Number.Prime +import Crypto.Random + +type Params = (Integer,Integer) {- P prime, G generator -} + +newtype PublicNumber = PublicNumber Integer {- Y -} + deriving (Show,Read,Eq,Enum,Real,Num,Ord) + +newtype PrivateNumber = PrivateNumber Integer {- X -} + deriving (Show,Read,Eq,Enum,Real,Num,Ord) + +newtype SharedKey = SharedKey Integer {- S -} + deriving (Show,Read,Eq,Enum,Real,Num,Ord) + +generateParams :: CryptoRandomGen g => g -> Params +generateParams = undefined + +generatePrivate :: CryptoRandomGen g => g -> PrivateNumber +generatePrivate rng = undefined + +generatePublic :: Params -> PrivateNumber -> PublicNumber +generatePublic (p,g) (PrivateNumber x) = PublicNumber $ exponantiation_rtl_binary g x p + +getShared :: Params -> PrivateNumber -> PublicNumber -> SharedKey +getShared (p,_) (PrivateNumber x) (PublicNumber y) = SharedKey $ exponantiation_rtl_binary y x p diff --git a/Crypto/Cipher/RSA.hs b/Crypto/Cipher/RSA.hs --- a/Crypto/Cipher/RSA.hs +++ b/Crypto/Cipher/RSA.hs @@ -13,6 +13,7 @@ , PrivateKey(..) , HashF , HashASN1 + , generate , decrypt , encrypt , sign @@ -23,8 +24,10 @@ import Crypto.Random import Data.ByteString (ByteString) import qualified Data.ByteString as B -import Number.ModArithmetic (exponantiation_rtl_binary) +import Number.ModArithmetic (exponantiation_rtl_binary, inverse) +import Number.Prime (generatePrime) import Number.Serialize +import Data.Maybe (fromJust) data Error = MessageSizeIncorrect -- ^ the message to decrypt is not of the correct size (need to be == private_size) @@ -122,6 +125,40 @@ s <- makeSignature hash hashdesc (public_sz pk) m em <- i2ospOf (public_sz pk) $ expmod (os2ip sm) (public_e pk) (public_n pk) Right (s == em) + +-- | generate a pair of (private, public) key of size in bytes. +generate :: CryptoRandomGen g => g -> Int -> Integer -> Either GenError ((PublicKey, PrivateKey), g) +generate rng size e = do + ((p,q), rng') <- generatePQ rng + let n = p * q + let phi = (p-1)*(q-1) + case inverse e phi of + Nothing -> generate rng' size e + Just d -> do + let priv = PrivateKey + { private_sz = size + , private_n = n + , private_d = d + , private_p = p + , private_q = q + , private_dP = d `mod` (p-1) + , private_dQ = d `mod` (q-1) + , private_qinv = fromJust $ inverse q p -- q and p are coprime, so fromJust is safe. + } + let pub = PublicKey + { public_sz = size + , public_n = n + , public_e = e + } + return ((pub, priv), rng') + where + generatePQ g = do + (p, g') <- generatePrime g (8 * (size `div` 2)) + (q, g'') <- generateQ p g' + return ((p,q), g'') + generateQ p h = do + (q, h') <- generatePrime h (8 * (size - (size `div` 2))) + if p == q then generateQ p h' else return (q, h') {- makeSignature for sign and verify -} makeSignature :: HashF -> HashASN1 -> Int -> ByteString -> Either Error ByteString diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2010 Vincent Hanquez +Copyright (c) 2010-2011 Vincent Hanquez All rights reserved. diff --git a/Number/Basic.hs b/Number/Basic.hs new file mode 100644 --- /dev/null +++ b/Number/Basic.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE BangPatterns #-} +module Number.Basic + ( sqrti + , gcde + , gcde_binary + , areEven + ) where + +import Data.Bits + +-- | sqrti returns two integer (l,b) so that l <= sqrt i <= b +-- the implementation is quite naive, use an approximation for the first number +-- and use a dichotomy algorithm to compute the bound relatively efficiently. +sqrti :: Integer -> (Integer, Integer) +sqrti i + | i < 0 = error "cannot compute negative square root" + | i == 0 = (0,0) + | i == 1 = (1,1) + | i == 2 = (1,2) + | otherwise = loop x0 + where + nbdigits = length $ show i + x0n = (if even nbdigits then nbdigits - 2 else nbdigits - 1) `div` 2 + x0 = if even nbdigits then 2 * 10 ^ x0n else 6 * 10 ^ x0n + loop x = case compare (sq x) i of + LT -> iterUp x + EQ -> (x, x) + GT -> iterDown x + iterUp lb = if sq ub >= i then iter lb ub else iterUp ub + where ub = lb * 2 + iterDown ub = if sq lb >= i then iterDown lb else iter lb ub + where lb = ub `div` 2 + iter lb ub + | lb == ub = (lb, ub) + | lb+1 == ub = (lb, ub) + | otherwise = + let d = (ub - lb) `div` 2 in + if sq (lb + d) >= i + then iter lb (ub-d) + else iter (lb+d) ub + sq a = a * a + +-- | get the extended GCD of two integer using integer divMod +gcde :: Integer -> Integer -> (Integer, Integer, Integer) +gcde a b = if d < 0 then (-x,-y,-d) else (x,y,d) where + (d, x, y) = f (a,1,0) (b,0,1) + f t (0, _, _) = t + f (a', sa, ta) t@(b', sb, tb) = + let (q, r) = a' `divMod` b' in + f t (r, sa - (q * sb), ta - (q * tb)) + +-- | get the extended GCD of two integer using the extended binary algorithm (HAC 14.61) +-- get (x,y,d) where d = gcd(a,b) and x,y satisfying ax + by = d +gcde_binary :: Integer -> Integer -> (Integer, Integer, Integer) +gcde_binary a' b' + | b' == 0 = (1,0,a') + | a' >= b' = compute a' b' + | otherwise = (\(x,y,d) -> (y,x,d)) $ compute b' a' + where + getEvenMultiplier !g !x !y + | areEven [x,y] = getEvenMultiplier (g `shiftL` 1) (x `shiftR` 1) (y `shiftR` 1) + | otherwise = (x,y,g) + halfLoop !x !y !u !i !j + | areEven [u,i,j] = halfLoop x y (u `shiftR` 1) (i `shiftR` 1) (j `shiftR` 1) + | even u = halfLoop x y (u `shiftR` 1) ((i + y) `shiftR` 1) ((j - x) `shiftR` 1) + | otherwise = (u, i, j) + compute a b = + let (x,y,g) = getEvenMultiplier 1 a b in + loop g x y x y 1 0 0 1 + + loop g _ _ 0 !v _ _ !c !d = (c, d, g * v) + loop g x y !u !v !a !b !c !d = + let (u2,a2,b2) = halfLoop x y u a b in + let (v2,c2,d2) = halfLoop x y v c d in + if u2 >= v2 + then loop g x y (u2 - v2) v2 (a2 - c2) (b2 - d2) c2 d2 + else loop g x y u2 (v2 - u2) a2 b2 (c2 - a2) (d2 - b2) + +-- | check if a list of integer are all even +areEven :: [Integer] -> Bool +areEven = and . map even diff --git a/Number/Generate.hs b/Number/Generate.hs --- a/Number/Generate.hs +++ b/Number/Generate.hs @@ -1,22 +1,34 @@ module Number.Generate ( generateMax + , generateBetween + , generateOfSize ) where import Number.Serialize import Crypto.Random +import qualified Data.ByteString as B +import Data.Bits ((.|.)) -{- a bit too simplitic and probably not very good. need to have a serious look - - on how to generate random integer. -} +-- | generate a positive integer between 0 and m. +-- using as many bytes as necessary to the same size as m, that are converted to integer. generateMax :: CryptoRandomGen g => g -> Integer -> Either GenError (Integer, g) -generateMax rng m = - let nbbytes = nbBytes m in - case genBytes nbbytes rng of - Left err -> Left err - Right (bs, rng') -> - let n = os2ip bs in - if n < m then Right (n, rng') else generateMax rng' m +generateMax rng m = genBytes (logiBytes m) rng >>= \(bs, rng') -> return (os2ip bs `mod` m, rng') -nbBytes :: Integer -> Int -nbBytes n +-- | generate a number between the inclusive bound [low,high]. +generateBetween :: CryptoRandomGen g => g -> Integer -> Integer -> Either GenError (Integer, g) +generateBetween rng low high = generateMax rng rmax >>= \(v, rng') -> return (low + v, rng') + where + rmax = high - low + 1 -- relative maximum before being corrected by the low bound + +-- | generate a positive integer of a specific size in bits. +-- the number of bits need to be multiple of 8. It will always returns +-- an integer that is close 2^(1+bits/8) by setting the 2 highest bits to 1. +generateOfSize :: CryptoRandomGen g => g -> Int -> Either GenError (Integer, g) +generateOfSize rng bits = case genBytes (bits `div` 8) rng of + Left err -> Left err + Right (bs, rng') -> Right (os2ip $ snd $ B.mapAccumL (\acc w -> (0, w .|. acc)) 0xc0 bs, rng') + +logiBytes :: Integer -> Int +logiBytes n | n < 256 = 1 - | otherwise = 1 + nbBytes (n `div` 256) + | otherwise = 1 + logiBytes (n `div` 256) diff --git a/Number/ModArithmetic.hs b/Number/ModArithmetic.hs --- a/Number/ModArithmetic.hs +++ b/Number/ModArithmetic.hs @@ -2,9 +2,9 @@ module Number.ModArithmetic ( exponantiation_rtl_binary , inverse - , gcde_binary ) where +import Number.Basic (gcde_binary) import Data.Bits -- note on exponantiation: 0^0 is treated as 1 for mimicking the standard library; @@ -23,35 +23,5 @@ -- | inverse computes the modular inverse as in g^(-1) mod m inverse :: Integer -> Integer -> Maybe Integer -inverse g m = if d > 1 then Nothing else Just x +inverse g m = if d > 1 then Nothing else Just (x `mod` m) where (x,_,d) = gcde_binary g m - --- | get the extended GCD of two integer using the extended binary algorithm (HAC 14.61) --- get (x,y,d) where d = gcd(a,b) and x,y satisfying ax + by = d -gcde_binary :: Integer -> Integer -> (Integer, Integer, Integer) -gcde_binary a' b' - | b' == 0 = (1,0,a') - | a' >= b' = compute a' b' - | otherwise = (\(x,y,d) -> (y,x,d)) $ compute b' a' - where - getEvenMultiplier !g !x !y - | areEven [x,y] = getEvenMultiplier (g `shiftL` 1) (x `shiftR` 1) (y `shiftR` 1) - | otherwise = (x,y,g) - halfLoop !x !y !u !i !j - | areEven [u,i,j] = halfLoop x y (u `shiftR` 1) (i `shiftR` 1) (j `shiftR` 1) - | even u = halfLoop x y (u `shiftR` 1) ((i + y) `shiftR` 1) ((j - x) `shiftR` 1) - | otherwise = (u, i, j) - compute a b = - let (x,y,g) = getEvenMultiplier 1 a b in - loop g x y x y 1 0 0 1 - - loop g _ _ 0 !v _ _ !c !d = (c, d, g * v) - loop g x y !u !v !a !b !c !d = - let (u2,a2,b2) = halfLoop x y u a b in - let (v2,c2,d2) = halfLoop x y v c d in - if u2 >= v2 - then loop g x y (u2 - v2) v2 (a2 - c2) (b2 - d2) c2 d2 - else loop g x y u2 (v2 - u2) a2 b2 (c2 - a2) (d2 - b2) - -areEven :: [Integer] -> Bool -areEven = and . map even diff --git a/Number/Prime.hs b/Number/Prime.hs new file mode 100644 --- /dev/null +++ b/Number/Prime.hs @@ -0,0 +1,147 @@ +module Number.Prime + ( generatePrime + , isProbablyPrime + , primalityTestNaive + -- , primalityTestAKS + , primalityTestMillerRabin + , isCoprime + ) where + +import Crypto.Random +import Data.Bits +import Number.Generate +import Number.Basic (sqrti, gcde_binary) +import Number.ModArithmetic (exponantiation_rtl_binary) + +-- | returns if the number is probably prime. +-- first a list of small primes are implicitely tested for divisibility, +-- then the Miller Rabin algorithm is used with an accuracy of 30 recursions +isProbablyPrime :: CryptoRandomGen g => g -> Integer -> Either GenError (Bool, g) +isProbablyPrime rng n + | any (\p -> p `divides` n) (filter (< n) smallPrimes) = Right (False, rng) + | otherwise = primalityTestMillerRabin rng 30 n + +generatePrime :: CryptoRandomGen g => g -> Int -> Either GenError (Integer, g) +generatePrime rng bits = generateOfSize rng bits >>= \(sp, rng') -> findPrimeFrom rng' sp + +findPrimeFrom :: CryptoRandomGen g => g -> Integer -> Either GenError (Integer, g) +findPrimeFrom rng n + | even n = findPrimeFrom rng (n+1) + | otherwise = isProbablyPrime rng n + >>= \(isPPrime, rng') -> if isPPrime then return (n, rng') else findPrimeFrom rng' (n+2) + +-- | Miller Rabin algorithm return if the number is probably prime or composite. +-- the tries parameter is the number of recursion, that determines the accuracy of the test. +primalityTestMillerRabin :: CryptoRandomGen g => g -> Int -> Integer -> Either GenError (Bool, g) +primalityTestMillerRabin rng tries n + | n <= 3 = error "Miller-Rabin requires tested value to be > 3" + | even n = Right (False, rng) + | tries <= 0 = error "Miller-Rabin tries need to be > 0" + | otherwise = loop rng (factorise 0 (n-1)) tries where + -- factorise n-1 into the form 2^s*d + factorise :: Integer -> Integer -> (Integer, Integer) + factorise s v + | v `testBit` 0 = (s, v) + | otherwise = factorise (s+1) (v `shiftR` 1) + expmod = exponantiation_rtl_binary + -- when iteration reach zero, we have a probable prime + loop g _ 0 = return (True, g) + loop g (s,d) k = generateBetween g 2 (n-2) >>= \(a, g') -> + let x = expmod a d n in + if x == (1 :: Integer) || x == (n-1) + then loop g' (s,d) (k-1) + else loop' g' (s,d) (k-1) ((x*x) `mod` n) 1 + -- loop from 1 to s-1. if we reach the end then it's composite + loop' g o@(s,_) km1 x2 r + | r == s = Right (False, g) + | x2 == 1 = Right (False, g) + | x2 /= (n-1) = loop' g o km1 ((x2*x2) `mod` n) (r+1) + | otherwise = loop g o km1 + +-- | AKS primality test return if the number is prime or composite +-- it uses the following algorithm: +-- Input: integer n > 1. +-- If n = ab for integers a > 0 and b > 1, output composite. +-- Find the smallest r such that o_r(n) > log2(n). +-- If 1 < gcd(a,n) < n for some a ≤ r, output composite. +-- If n <= r, output prime. +-- For a = 1 to lower-bound(sqrt(phi(n)) * log2(n)) do +-- if (X+a)n ≠ Xn+a (mod Xr − 1,n), output composite; +-- Output prime. +primalityTestAKS :: Integer -> Bool +primalityTestAKS n = undefined + where + -- for p prime, the euler totient (# of coprime to n) is clearly n -1 + totient = n-1 + ubound = (fst $ sqrti totient) * (logi n) + logi n + | n == 0 = 0 + | otherwise = 1 + logi (n `shiftR` 1) + +-- | Test naively is integer is prime. +-- while naive, we skip even number and stop iteration at i > sqrt(n) +primalityTestNaive :: Integer -> Bool +primalityTestNaive n + | n <= 1 = False + | n == 2 = True + | even n = False + | otherwise = loop 3 where + ubound = snd $ sqrti n + loop i + | i > ubound = True + | i `divides` n = False + | otherwise = loop (i+2) + +-- | Test is two integer are coprime to each other +isCoprime :: Integer -> Integer -> Bool +isCoprime m n = case gcde_binary m n of (_,_,d) -> d == 1 + +-- | list of the first primes till 2903.. +smallPrimes :: [Integer] +smallPrimes = + [ 2 , 3 , 5 , 7 , 11 , 13 , 17 , 19 , 23 , 29 + , 31 , 37 , 41 , 43 , 47 , 53 , 59 , 61 , 67 , 71 + , 73 , 79 , 83 , 89 , 97 , 101 , 103 , 107 , 109 , 113 + , 127 , 131 , 137 , 139 , 149 , 151 , 157 , 163 , 167 , 173 + , 179 , 181 , 191 , 193 , 197 , 199 , 211 , 223 , 227 , 229 + , 233 , 239 , 241 , 251 , 257 , 263 , 269 , 271 , 277 , 281 + , 283 , 293 , 307 , 311 , 313 , 317 , 331 , 337 , 347 , 349 + , 353 , 359 , 367 , 373 , 379 , 383 , 389 , 397 , 401 , 409 + , 419 , 421 , 431 , 433 , 439 , 443 , 449 , 457 , 461 , 463 + , 467 , 479 , 487 , 491 , 499 , 503 , 509 , 521 , 523 , 541 + , 547 , 557 , 563 , 569 , 571 , 577 , 587 , 593 , 599 , 601 + , 607 , 613 , 617 , 619 , 631 , 641 , 643 , 647 , 653 , 659 + , 661 , 673 , 677 , 683 , 691 , 701 , 709 , 719 , 727 , 733 + , 739 , 743 , 751 , 757 , 761 , 769 , 773 , 787 , 797 , 809 + , 811 , 821 , 823 , 827 , 829 , 839 , 853 , 857 , 859 , 863 + , 877 , 881 , 883 , 887 , 907 , 911 , 919 , 929 , 937 , 941 + , 947 , 953 , 967 , 971 , 977 , 983 , 991 , 997 , 1009 , 1013 + , 1019 , 1021 , 1031 , 1033 , 1039 , 1049 , 1051 , 1061 , 1063 , 1069 + , 1087 , 1091 , 1093 , 1097 , 1103 , 1109 , 1117 , 1123 , 1129 , 1151 + , 1153 , 1163 , 1171 , 1181 , 1187 , 1193 , 1201 , 1213 , 1217 , 1223 + , 1229 , 1231 , 1237 , 1249 , 1259 , 1277 , 1279 , 1283 , 1289 , 1291 + , 1297 , 1301 , 1303 , 1307 , 1319 , 1321 , 1327 , 1361 , 1367 , 1373 + , 1381 , 1399 , 1409 , 1423 , 1427 , 1429 , 1433 , 1439 , 1447 , 1451 + , 1453 , 1459 , 1471 , 1481 , 1483 , 1487 , 1489 , 1493 , 1499 , 1511 + , 1523 , 1531 , 1543 , 1549 , 1553 , 1559 , 1567 , 1571 , 1579 , 1583 + , 1597 , 1601 , 1607 , 1609 , 1613 , 1619 , 1621 , 1627 , 1637 , 1657 + , 1663 , 1667 , 1669 , 1693 , 1697 , 1699 , 1709 , 1721 , 1723 , 1733 + , 1741 , 1747 , 1753 , 1759 , 1777 , 1783 , 1787 , 1789 , 1801 , 1811 + , 1823 , 1831 , 1847 , 1861 , 1867 , 1871 , 1873 , 1877 , 1879 , 1889 + , 1901 , 1907 , 1913 , 1931 , 1933 , 1949 , 1951 , 1973 , 1979 , 1987 + , 1993 , 1997 , 1999 , 2003 , 2011 , 2017 , 2027 , 2029 , 2039 , 2053 + , 2063 , 2069 , 2081 , 2083 , 2087 , 2089 , 2099 , 2111 , 2113 , 2129 + , 2131 , 2137 , 2141 , 2143 , 2153 , 2161 , 2179 , 2203 , 2207 , 2213 + , 2221 , 2237 , 2239 , 2243 , 2251 , 2267 , 2269 , 2273 , 2281 , 2287 + , 2293 , 2297 , 2309 , 2311 , 2333 , 2339 , 2341 , 2347 , 2351 , 2357 + , 2371 , 2377 , 2381 , 2383 , 2389 , 2393 , 2399 , 2411 , 2417 , 2423 + , 2437 , 2441 , 2447 , 2459 , 2467 , 2473 , 2477 , 2503 , 2521 , 2531 + , 2539 , 2543 , 2549 , 2551 , 2557 , 2579 , 2591 , 2593 , 2609 , 2617 + , 2621 , 2633 , 2647 , 2657 , 2659 , 2663 , 2671 , 2677 , 2683 , 2687 + , 2689 , 2693 , 2699 , 2707 , 2711 , 2713 , 2719 , 2729 , 2731 , 2741 + , 2749 , 2753 , 2767 , 2777 , 2789 , 2791 , 2797 , 2801 , 2803 , 2819 + , 2833 , 2837 , 2843 , 2851 , 2857 , 2861 , 2879 , 2887 , 2897 , 2903 + ] + +{-# INLINE divides #-} +divides i n = n `mod` i == 0 diff --git a/Tests.hs b/Tests.hs --- a/Tests.hs +++ b/Tests.hs @@ -9,6 +9,7 @@ import Control.Monad import Control.Arrow (first) +import Control.Applicative ((<$>)) import Data.List (intercalate) import Data.Char @@ -22,12 +23,16 @@ -- numbers import Number.ModArithmetic --- ciphers +import Number.Basic +import Number.Prime +import Number.Serialize +-- ciphers/Kexch import qualified Crypto.Cipher.AES as AES import qualified Crypto.Cipher.RC4 as RC4 import qualified Crypto.Cipher.Camellia as Camellia import qualified Crypto.Cipher.RSA as RSA import qualified Crypto.Cipher.DSA as DSA +import qualified Crypto.Cipher.DH as DH import Crypto.Random encryptStream fi fc key plaintext = B.unpack $ snd $ fc (fi key) plaintext @@ -242,25 +247,44 @@ {- end of units tests -} {- start of QuickCheck verification -} --- FIXME better to tweak the property to generate positive integer instead of this. - -prop_gcde_binary_valid (a, b) - | a > 0 && b >= 0 = - let (x,y,v) = gcde_binary a b in - and [a*x + b*y == v, gcd a b == v] - | otherwise = True +prop_gcde_binary_valid (Positive a, Positive b) = + let (x,y,v) = gcde_binary a b in + let (x',y',v') = gcde a b in + and [v==v', a*x' + b*y' == v', a*x + b*y == v, gcd a b == v] -prop_modexp_rtl_valid (a, b, m) - | m > 0 && a >= 0 && b >= 0 = exponantiation_rtl_binary a b m == ((a ^ b) `mod` m) - | otherwise = True +prop_modexp_rtl_valid (NonNegative a, NonNegative b, Positive m) = + exponantiation_rtl_binary a b m == ((a ^ b) `mod` m) -prop_modinv_valid (a, m) - | m > 1 && a > 0 = +prop_modinv_valid (Positive a, Positive m) + | m > 1 = case inverse a m of Just ainv -> (ainv * a) `mod` m == 1 Nothing -> True | otherwise = True +prop_sqrti_valid (Positive i) = l*l <= i && i <= u*u where (l, u) = sqrti i + +prop_generate_prime_valid i = + -- becuase of the next naive test, we can't generate easily number above 32 bits + -- otherwise it slows down the tests to uselessness. when AKS or ECPP is implemented + -- we can revisit the number here + let p = withAleasInteger rng i (\g -> generatePrime g 32) in + -- FIXME test if p is around 32 bits + primalityTestNaive p + +prop_miller_rabin_valid i + | i <= 3 = True + | otherwise = + -- miller rabin only returns with certitude that the integer is composite. + let b = withAleasInteger rng i (\g -> isProbablyPrime g i) in + (b == False && primalityTestNaive i == False) || b == True + +withAleasInteger rng i f = case reseed (i2osp (if i < 0 then -i else i)) rng of + Left _ -> error "impossible" + Right rng' -> case f rng' of + Left _ -> error "impossible" + Right v -> fst v + newtype RSAMessage = RSAMessage B.ByteString deriving (Show, Eq) instance Arbitrary RSAMessage where @@ -275,7 +299,7 @@ getByte :: Rng -> (Word8, Rng) getByte (Rng (mz, mw)) = let mz2 = 36969 * (mz `mod` 65536) in - let mw2 = 18000 * (mw `mod` 65536) in + let mw2 = 18070 * (mw `mod` 65536) in (fromIntegral (mz2 + mw2), Rng (mz2, mw2)) getBytes 0 rng = ([], rng) @@ -288,7 +312,9 @@ newGen _ = Right (Rng (2,3)) genSeedLength = 0 genBytes len g = Right $ first B.pack $ getBytes len g - reseed = undefined + reseed bs (Rng (a,b)) = Right $ Rng (fromIntegral a', b) where + a' = ((fromIntegral a) + i * 36969) `mod` 65536 + i = os2ip bs rng = Rng (1,2) @@ -296,6 +322,14 @@ {- testing RSA -} {-----------------------------------------------------------------------------------------------} +prop_rsa_generate_valid (Positive i, RSAMessage msgz) = + let keysz = 64 in + let (pub,priv) = withAleasInteger rng i (\g -> RSA.generate g keysz 65537) in + let msg = B.take (keysz - 11) msgz in + (RSA.private_p priv * RSA.private_q priv == RSA.private_n priv) && + ((RSA.private_d priv * RSA.public_e pub) `mod` ((RSA.private_p priv - 1) * (RSA.private_q priv - 1)) == 1) && + (either Left (RSA.decrypt priv . fst) $ RSA.encrypt rng pub msg) == Right msg + prop_rsa_valid fast (RSAMessage msg) = (either Left (RSA.decrypt pk . fst) $ RSA.encrypt rng rsaPublickey msg) == Right msg where pk = if fast then rsaPrivatekey else rsaPrivatekey { RSA.private_p = 0, RSA.private_q = 0 } @@ -359,6 +393,20 @@ Right (signature, rng') = DSA.sign rng (SHA1.hash) dsaPrivatekey msg {-----------------------------------------------------------------------------------------------} +{- testing DH -} +{-----------------------------------------------------------------------------------------------} +instance Arbitrary DH.PrivateNumber where + arbitrary = fromIntegral <$> (suchThat (arbitrary :: Gen Integer) (\x -> x >= 1)) + +prop_dh_valid (xa, xb) = sa == sb + where + sa = DH.getShared dhparams xa yb + sb = DH.getShared dhparams xb ya + yb = DH.generatePublic dhparams xb + ya = DH.generatePublic dhparams xa + dhparams = (11, 7) + +{-----------------------------------------------------------------------------------------------} {- testing AES -} {-----------------------------------------------------------------------------------------------} data AES128Message = AES128Message B.ByteString B.ByteString B.ByteString deriving (Show, Eq) @@ -441,6 +489,9 @@ run_test "gcde binary valid" prop_gcde_binary_valid run_test "exponantiation RTL valid" prop_modexp_rtl_valid run_test "inverse valid" prop_modinv_valid + run_test "sqrt integer valid" prop_sqrti_valid + run_test "primality test Miller Rabin" prop_miller_rabin_valid + run_test "Generate prime" prop_generate_prime_valid -- AES Tests run_test "AES128 (ECB) decrypt.encrypt = id" prop_aes128_ecb_valid @@ -452,7 +503,11 @@ run_test "AES256 (ECB) decrypt.encrypt = id" prop_aes256_ecb_valid run_test "AES256 (CBC) decrypt.encrypt = id" prop_aes256_cbc_valid + -- DH Tests + run_test "DH test" prop_dh_valid + -- RSA Tests + run_test "RSA generate" prop_rsa_generate_valid run_test "RSA verify . sign(slow) = true" prop_rsa_sign_slow_valid run_test "RSA verify . sign(fast) = true" prop_rsa_sign_fast_valid diff --git a/cryptocipher.cabal b/cryptocipher.cabal --- a/cryptocipher.cabal +++ b/cryptocipher.cabal @@ -1,5 +1,5 @@ Name: cryptocipher -Version: 0.2.8 +Version: 0.2.9 Description: Symmetrical Block, Stream and PubKey Ciphers License: BSD3 License-file: LICENSE @@ -33,9 +33,12 @@ Crypto.Cipher.Camellia Crypto.Cipher.RSA Crypto.Cipher.DSA + Crypto.Cipher.DH other-modules: Number.ModArithmetic Number.Serialize Number.Generate + Number.Basic + Number.Prime ghc-options: -Wall Executable Tests