Merge pull request #125 from colatkinson/fix_prime_size

Fix generated primes being too large

.gitignore

@@ -10,3 +10,5 @@ QA
 benchs/Bench
 benchs/Hash
 *.sublime-workspace
+.cabal-sandbox/
+cabal.sandbox.config

Crypto/Error/Types.hs

@@ -43,6 +43,8 @@ data CryptoError =
     -- Message authentification error
     | CryptoError_MacKeyInvalid
     | CryptoError_AuthenticationTagSizeInvalid
+    -- Prime generation error
+    | CryptoError_PrimeSizeInvalid
     deriving (Show,Eq,Enum,Data,Typeable)
 
 instance E.Exception CryptoError

Crypto/Number/Prime.hs

@@ -27,6 +27,7 @@ import Crypto.Number.Basic (sqrti, gcde)
 import Crypto.Number.ModArithmetic (expSafe)
 import Crypto.Random.Types
 import Crypto.Random.Probabilistic
+import Crypto.Error
 
 import Data.Bits
 
@@ -37,25 +38,48 @@ import Data.Bits
 isProbablyPrime :: Integer -> Bool
 isProbablyPrime !n
     | any (\p -> p `divides` n) (filter (< n) firstPrimes) = False
-    | primalityTestFermat 50 (n`div`2) n                   = primalityTestMillerRabin 30 n
+    | n >= 2 && n <= 2903                                  = True
+    | primalityTestFermat 50 (n `div` 2) n                 = primalityTestMillerRabin 30 n
     | otherwise                                            = False
 
--- | generate a prime number of the required bitsize
+-- | generate a prime number of the required bitsize (i.e. in the range
+--   [2^(b-1)+2^(b-2), 2^b)).
+--
+--   May throw a CryptoError_PrimeSizeInvalid if the requested size is less
+--   than 5 bits, as the smallest prime meeting these conditions is 29.
+--   This function requires that the two highest bits are set, so that when
+--   multiplied with another prime to create a key, it is guaranteed to be of
+--   the proper size.
 generatePrime :: MonadRandom m => Int -> m Integer
 generatePrime bits = do
-    sp <- generateParams bits (Just SetTwoHighest) True
-    return $ findPrimeFrom sp
+    if bits < 5 then
+        throwCryptoError $ CryptoFailed $ CryptoError_PrimeSizeInvalid
+    else do
+        sp <- generateParams bits (Just SetTwoHighest) True
+        let prime = findPrimeFrom sp
+        if prime < 1 `shiftL` bits then
+            return $ prime
+        else generatePrime bits
 
 -- | generate a prime number of the form 2p+1 where p is also prime.
 -- it is also knowed as a Sophie Germaine prime or safe prime.
 --
 -- The number of safe prime is significantly smaller to the number of prime,
 -- as such it shouldn't be used if this number is supposed to be kept safe.
+--
+-- May throw a CryptoError_PrimeSizeInvalid if the requested size is less than
+-- 6 bits, as the smallest safe prime with the two highest bits set is 59.
 generateSafePrime :: MonadRandom m => Int -> m Integer
 generateSafePrime bits = do
-    sp <- generateParams bits (Just SetTwoHighest) True
-    let p = findPrimeFromWith (\i -> isProbablyPrime (2*i+1)) (sp `div` 2)
-    return (2*p+1)
+    if bits < 6 then
+        throwCryptoError $ CryptoFailed $ CryptoError_PrimeSizeInvalid
+    else do
+        sp <- generateParams bits (Just SetTwoHighest) True
+        let p = findPrimeFromWith (\i -> isProbablyPrime (2*i+1)) (sp `div` 2)
+        let val = 2 * p + 1
+        if val < 1 `shiftL` bits then
+            return $ val
+        else generateSafePrime bits
 
 -- | find a prime from a starting point where the property hold.
 findPrimeFromWith :: (Integer -> Bool) -> Integer -> Integer

tests/Number.hs

@@ -42,17 +42,19 @@ tests = testGroup "number"
          in 0 <= r && r < range
     , testProperty "generate-prime" $ \testDRG (Int0_2901 baseBits') ->
         let baseBits = baseBits' `mod` 800
-            bits  = 48 + baseBits -- no point generating lower than 48 bits ..
+            bits  = 5 + baseBits -- generating lower than 5 bits causes an error ..
             prime = withTestDRG testDRG $ generatePrime bits
-        -- with small base bits numbers, the probability that we "cross" this bit size ness
-        -- to the next is quite high, as the number generated has two highest bit set.
-        --
-         in bits == numBits prime || (if baseBits < 64 then (bits + 1) == numBits prime else False)
+         in bits == numBits prime
+    , testProperty "generate-safe-prime" $ \testDRG (Int0_2901 baseBits') ->
+        let baseBits = baseBits' `mod` 200
+            bits = 6 + baseBits
+            prime = withTestDRG testDRG $ generateSafePrime bits
+         in bits == numBits prime
     , testProperty "marshalling" $ \qaInt ->
         getQAInteger qaInt == os2ip (i2osp (getQAInteger qaInt) :: Bytes)
     , testGroup "marshalling-kat-to-bytearray" $ map toSerializationKat $ zip [katZero..] serializationVectors
     , testGroup "marshalling-kat-to-integer" $ map toSerializationKatInteger $ zip [katZero..] serializationVectors
-    ] 
+    ]
   where
     toSerializationKat (i, (sz, n, ba)) = testCase (show i) (ba @=? i2ospOf_ sz n)
     toSerializationKatInteger (i, (_, n, ba)) = testCase (show i) (n @=? os2ip ba)