-- |
-- Module      : Crypto.Number.Prime
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : Good

{-# LANGUAGE BangPatterns #-}
module Crypto.Number.Prime
    (
      generatePrime
    , generateSafePrime
    , isProbablyPrime
    , findPrimeFrom
    , findPrimeFromWith
    , primalityTestMillerRabin
    , primalityTestNaive
    , primalityTestFermat
    , isCoprime
    ) where

import Crypto.Number.Compat
import Crypto.Number.Generate
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

-- | Returns if the number is probably prime.
-- First a list of small primes are implicitely tested for divisibility,
-- then a fermat primality test is used with arbitrary numbers and
-- then the Miller Rabin algorithm is used with an accuracy of 30 recursions.
isProbablyPrime :: Integer -> Bool
isProbablyPrime :: Integer -> Bool
isProbablyPrime !Integer
n
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Integer
p -> Integer
p Integer -> Integer -> Bool
`divides` Integer
n) (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
< Integer
n) [Integer]
firstPrimes) = Bool
False
    | Integer
n forall a. Ord a => a -> a -> Bool
>= Integer
2 Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
<= Integer
2903                                  = Bool
True
    | Int -> Integer -> Integer -> Bool
primalityTestFermat Int
50 (Integer
n forall a. Integral a => a -> a -> a
`div` Integer
2) Integer
n                 = Int -> Integer -> Bool
primalityTestMillerRabin Int
30 Integer
n
    | Bool
otherwise                                            = Bool
False

-- | 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 :: forall (m :: * -> *). MonadRandom m => Int -> m Integer
generatePrime Int
bits = do
    if Int
bits forall a. Ord a => a -> a -> Bool
< Int
5 then
        forall a. CryptoFailable a -> a
throwCryptoError forall a b. (a -> b) -> a -> b
$ forall a. CryptoError -> CryptoFailable a
CryptoFailed forall a b. (a -> b) -> a -> b
$ CryptoError
CryptoError_PrimeSizeInvalid
    else do
        Integer
sp <- forall (m :: * -> *).
MonadRandom m =>
Int -> Maybe GenTopPolicy -> Bool -> m Integer
generateParams Int
bits (forall a. a -> Maybe a
Just GenTopPolicy
SetTwoHighest) Bool
True
        let prime :: Integer
prime = Integer -> Integer
findPrimeFrom Integer
sp
        if Integer
prime forall a. Ord a => a -> a -> Bool
< Integer
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
bits then
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer
prime
        else forall (m :: * -> *). MonadRandom m => Int -> m Integer
generatePrime Int
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 :: forall (m :: * -> *). MonadRandom m => Int -> m Integer
generateSafePrime Int
bits = do
    if Int
bits forall a. Ord a => a -> a -> Bool
< Int
6 then
        forall a. CryptoFailable a -> a
throwCryptoError forall a b. (a -> b) -> a -> b
$ forall a. CryptoError -> CryptoFailable a
CryptoFailed forall a b. (a -> b) -> a -> b
$ CryptoError
CryptoError_PrimeSizeInvalid
    else do
        Integer
sp <- forall (m :: * -> *).
MonadRandom m =>
Int -> Maybe GenTopPolicy -> Bool -> m Integer
generateParams Int
bits (forall a. a -> Maybe a
Just GenTopPolicy
SetTwoHighest) Bool
True
        let p :: Integer
p = (Integer -> Bool) -> Integer -> Integer
findPrimeFromWith (\Integer
i -> Integer -> Bool
isProbablyPrime (Integer
2forall a. Num a => a -> a -> a
*Integer
iforall a. Num a => a -> a -> a
+Integer
1)) (Integer
sp forall a. Integral a => a -> a -> a
`div` Integer
2)
        let val :: Integer
val = Integer
2 forall a. Num a => a -> a -> a
* Integer
p forall a. Num a => a -> a -> a
+ Integer
1
        if Integer
val forall a. Ord a => a -> a -> Bool
< Integer
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
bits then
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer
val
        else forall (m :: * -> *). MonadRandom m => Int -> m Integer
generateSafePrime Int
bits

-- | Find a prime from a starting point where the property hold.
findPrimeFromWith :: (Integer -> Bool) -> Integer -> Integer
findPrimeFromWith :: (Integer -> Bool) -> Integer -> Integer
findPrimeFromWith Integer -> Bool
prop !Integer
n
    | forall a. Integral a => a -> Bool
even Integer
n        = (Integer -> Bool) -> Integer -> Integer
findPrimeFromWith Integer -> Bool
prop (Integer
nforall a. Num a => a -> a -> a
+Integer
1)
    | Bool
otherwise     =
        if Bool -> Bool
not (Integer -> Bool
isProbablyPrime Integer
n)
            then (Integer -> Bool) -> Integer -> Integer
findPrimeFromWith Integer -> Bool
prop (Integer
nforall a. Num a => a -> a -> a
+Integer
2)
            else
                if Integer -> Bool
prop Integer
n
                    then Integer
n
                    else (Integer -> Bool) -> Integer -> Integer
findPrimeFromWith Integer -> Bool
prop (Integer
nforall a. Num a => a -> a -> a
+Integer
2)

-- | Find a prime from a starting point with no specific property.
findPrimeFrom :: Integer -> Integer
findPrimeFrom :: Integer -> Integer
findPrimeFrom Integer
n =
    case Integer -> GmpSupported Integer
gmpNextPrime Integer
n of
        GmpSupported Integer
p -> Integer
p
        GmpSupported Integer
GmpUnsupported -> (Integer -> Bool) -> Integer -> Integer
findPrimeFromWith (\Integer
_ -> Bool
True) Integer
n

-- | 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 :: Int -> Integer -> Bool
primalityTestMillerRabin :: Int -> Integer -> Bool
primalityTestMillerRabin Int
tries !Integer
n =
    case Int -> Integer -> GmpSupported Bool
gmpTestPrimeMillerRabin Int
tries Integer
n of
        GmpSupported Bool
b -> Bool
b
        GmpSupported Bool
GmpUnsupported -> forall a. MonadPseudoRandom ChaChaDRG a -> a
probabilistic MonadPseudoRandom ChaChaDRG Bool
run
  where
    run :: MonadPseudoRandom ChaChaDRG Bool
run
        | Integer
n forall a. Ord a => a -> a -> Bool
<= Integer
3     = forall a. HasCallStack => [Char] -> a
error [Char]
"Miller-Rabin requires tested value to be > 3"
        | forall a. Integral a => a -> Bool
even Integer
n     = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        | Int
tries forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. HasCallStack => [Char] -> a
error [Char]
"Miller-Rabin tries need to be > 0"
        | Bool
otherwise  = [Integer] -> Bool
loop forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {t} {m :: * -> *}.
(Eq t, Num t, MonadRandom m) =>
t -> m [Integer]
generateTries Int
tries

    !nm1 :: Integer
nm1 = Integer
nforall a. Num a => a -> a -> a
-Integer
1
    !nm2 :: Integer
nm2 = Integer
nforall a. Num a => a -> a -> a
-Integer
2

    (!Integer
s,!Integer
d) = (Integer -> Integer -> (Integer, Integer)
factorise Integer
0 Integer
nm1)

    generateTries :: t -> m [Integer]
generateTries t
0 = forall (m :: * -> *) a. Monad m => a -> m a
return []
    generateTries t
t = do
        Integer
v  <- forall (m :: * -> *).
MonadRandom m =>
Integer -> Integer -> m Integer
generateBetween Integer
2 Integer
nm2
        [Integer]
vs <- t -> m [Integer]
generateTries (t
tforall a. Num a => a -> a -> a
-t
1)
        forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
vforall a. a -> [a] -> [a]
:[Integer]
vs)

    -- factorise n-1 into the form 2^s*d
    factorise :: Integer -> Integer -> (Integer, Integer)
    factorise :: Integer -> Integer -> (Integer, Integer)
factorise !Integer
si !Integer
vi
        | Integer
vi forall a. Bits a => a -> Int -> Bool
`testBit` Int
0 = (Integer
si, Integer
vi)
        | Bool
otherwise     = Integer -> Integer -> (Integer, Integer)
factorise (Integer
siforall a. Num a => a -> a -> a
+Integer
1) (Integer
vi forall a. Bits a => a -> Int -> a
`shiftR` Int
1) -- probably faster to not shift v continuously, but just once.
    expmod :: Integer -> Integer -> Integer -> Integer
expmod = Integer -> Integer -> Integer -> Integer
expSafe

    -- when iteration reach zero, we have a probable prime
    loop :: [Integer] -> Bool
loop []     = Bool
True
    loop (Integer
w:[Integer]
ws) = let x :: Integer
x = Integer -> Integer -> Integer -> Integer
expmod Integer
w Integer
d Integer
n
                   in if Integer
x forall a. Eq a => a -> a -> Bool
== (Integer
1 :: Integer) Bool -> Bool -> Bool
|| Integer
x forall a. Eq a => a -> a -> Bool
== Integer
nm1
                          then [Integer] -> Bool
loop [Integer]
ws
                          else [Integer] -> Integer -> Integer -> Bool
loop' [Integer]
ws ((Integer
xforall a. Num a => a -> a -> a
*Integer
x) forall a. Integral a => a -> a -> a
`mod` Integer
n) Integer
1

    -- loop from 1 to s-1. if we reach the end then it's composite
    loop' :: [Integer] -> Integer -> Integer -> Bool
loop' [Integer]
ws !Integer
x2 !Integer
r
        | Integer
r forall a. Eq a => a -> a -> Bool
== Integer
s    = Bool
False
        | Integer
x2 forall a. Eq a => a -> a -> Bool
== Integer
1   = Bool
False
        | Integer
x2 forall a. Eq a => a -> a -> Bool
/= Integer
nm1 = [Integer] -> Integer -> Integer -> Bool
loop' [Integer]
ws ((Integer
x2forall a. Num a => a -> a -> a
*Integer
x2) forall a. Integral a => a -> a -> a
`mod` Integer
n) (Integer
rforall a. Num a => a -> a -> a
+Integer
1)
        | Bool
otherwise = [Integer] -> Bool
loop [Integer]
ws

{-
    n < z -> witness to test
              1373653 [2,3]
              9080191 [31,73]
              4759123141 [2,7,61]
              2152302898747 [2,3,5,7,11]
              3474749660383 [2,3,5,7,11,13]
              341550071728321 [2,3,5,7,11,13,17]
-}

-- | Probabilitic Test using Fermat primility test.
-- Beware of Carmichael numbers that are Fermat liars, i.e. this test
-- is useless for them. always combines with some other test.
primalityTestFermat :: Int -- ^ number of iterations of the algorithm
                    -> Integer -- ^ starting a
                    -> Integer -- ^ number to test for primality
                    -> Bool
primalityTestFermat :: Int -> Integer -> Integer -> Bool
primalityTestFermat Int
n Integer
a Integer
p = forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Integer -> Bool
expTest [Integer
a..(Integer
aforall a. Num a => a -> a -> a
+forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)]
    where !pm1 :: Integer
pm1 = Integer
pforall a. Num a => a -> a -> a
-Integer
1
          expTest :: Integer -> Bool
expTest Integer
i = Integer -> Integer -> Integer -> Integer
expSafe Integer
i Integer
pm1 Integer
p forall a. Eq a => a -> a -> Bool
== Integer
1

-- | Test naively is integer is prime.
-- while naive, we skip even number and stop iteration at i > sqrt(n)
primalityTestNaive :: Integer -> Bool
primalityTestNaive :: Integer -> Bool
primalityTestNaive Integer
n
    | Integer
n forall a. Ord a => a -> a -> Bool
<= Integer
1    = Bool
False
    | Integer
n forall a. Eq a => a -> a -> Bool
== Integer
2    = Bool
True
    | forall a. Integral a => a -> Bool
even Integer
n    = Bool
False
    | Bool
otherwise = Integer -> Bool
search Integer
3
        where !ubound :: Integer
ubound = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Integer -> (Integer, Integer)
sqrti Integer
n
              search :: Integer -> Bool
search !Integer
i
                  | Integer
i forall a. Ord a => a -> a -> Bool
> Integer
ubound    = Bool
True
                  | Integer
i Integer -> Integer -> Bool
`divides` Integer
n = Bool
False
                  | Bool
otherwise     = Integer -> Bool
search (Integer
iforall a. Num a => a -> a -> a
+Integer
2)

-- | Test is two integer are coprime to each other
isCoprime :: Integer -> Integer -> Bool
isCoprime :: Integer -> Integer -> Bool
isCoprime Integer
m Integer
n = case Integer -> Integer -> (Integer, Integer, Integer)
gcde Integer
m Integer
n of (Integer
_,Integer
_,Integer
d) -> Integer
d forall a. Eq a => a -> a -> Bool
== Integer
1

-- | List of the first primes till 2903.
firstPrimes :: [Integer]
firstPrimes :: [Integer]
firstPrimes =
    [ Integer
2    , Integer
3    , Integer
5    , Integer
7    , Integer
11   , Integer
13   , Integer
17   , Integer
19   , Integer
23   , Integer
29
    , Integer
31   , Integer
37   , Integer
41   , Integer
43   , Integer
47   , Integer
53   , Integer
59   , Integer
61   , Integer
67   , Integer
71
    , Integer
73   , Integer
79   , Integer
83   , Integer
89   , Integer
97   , Integer
101  , Integer
103  , Integer
107  , Integer
109  , Integer
113
    , Integer
127  , Integer
131  , Integer
137  , Integer
139  , Integer
149  , Integer
151  , Integer
157  , Integer
163  , Integer
167  , Integer
173
    , Integer
179  , Integer
181  , Integer
191  , Integer
193  , Integer
197  , Integer
199  , Integer
211  , Integer
223  , Integer
227  , Integer
229
    , Integer
233  , Integer
239  , Integer
241  , Integer
251  , Integer
257  , Integer
263  , Integer
269  , Integer
271  , Integer
277  , Integer
281
    , Integer
283  , Integer
293  , Integer
307  , Integer
311  , Integer
313  , Integer
317  , Integer
331  , Integer
337  , Integer
347  , Integer
349
    , Integer
353  , Integer
359  , Integer
367  , Integer
373  , Integer
379  , Integer
383  , Integer
389  , Integer
397  , Integer
401  , Integer
409
    , Integer
419  , Integer
421  , Integer
431  , Integer
433  , Integer
439  , Integer
443  , Integer
449  , Integer
457  , Integer
461  , Integer
463
    , Integer
467  , Integer
479  , Integer
487  , Integer
491  , Integer
499  , Integer
503  , Integer
509  , Integer
521  , Integer
523  , Integer
541
    , Integer
547  , Integer
557  , Integer
563  , Integer
569  , Integer
571  , Integer
577  , Integer
587  , Integer
593  , Integer
599  , Integer
601
    , Integer
607  , Integer
613  , Integer
617  , Integer
619  , Integer
631  , Integer
641  , Integer
643  , Integer
647  , Integer
653  , Integer
659
    , Integer
661  , Integer
673  , Integer
677  , Integer
683  , Integer
691  , Integer
701  , Integer
709  , Integer
719  , Integer
727  , Integer
733
    , Integer
739  , Integer
743  , Integer
751  , Integer
757  , Integer
761  , Integer
769  , Integer
773  , Integer
787  , Integer
797  , Integer
809
    , Integer
811  , Integer
821  , Integer
823  , Integer
827  , Integer
829  , Integer
839  , Integer
853  , Integer
857  , Integer
859  , Integer
863
    , Integer
877  , Integer
881  , Integer
883  , Integer
887  , Integer
907  , Integer
911  , Integer
919  , Integer
929  , Integer
937  , Integer
941
    , Integer
947  , Integer
953  , Integer
967  , Integer
971  , Integer
977  , Integer
983  , Integer
991  , Integer
997  , Integer
1009 , Integer
1013
    , Integer
1019 , Integer
1021 , Integer
1031 , Integer
1033 , Integer
1039 , Integer
1049 , Integer
1051 , Integer
1061 , Integer
1063 , Integer
1069
    , Integer
1087 , Integer
1091 , Integer
1093 , Integer
1097 , Integer
1103 , Integer
1109 , Integer
1117 , Integer
1123 , Integer
1129 , Integer
1151
    , Integer
1153 , Integer
1163 , Integer
1171 , Integer
1181 , Integer
1187 , Integer
1193 , Integer
1201 , Integer
1213 , Integer
1217 , Integer
1223
    , Integer
1229 , Integer
1231 , Integer
1237 , Integer
1249 , Integer
1259 , Integer
1277 , Integer
1279 , Integer
1283 , Integer
1289 , Integer
1291
    , Integer
1297 , Integer
1301 , Integer
1303 , Integer
1307 , Integer
1319 , Integer
1321 , Integer
1327 , Integer
1361 , Integer
1367 , Integer
1373
    , Integer
1381 , Integer
1399 , Integer
1409 , Integer
1423 , Integer
1427 , Integer
1429 , Integer
1433 , Integer
1439 , Integer
1447 , Integer
1451
    , Integer
1453 , Integer
1459 , Integer
1471 , Integer
1481 , Integer
1483 , Integer
1487 , Integer
1489 , Integer
1493 , Integer
1499 , Integer
1511
    , Integer
1523 , Integer
1531 , Integer
1543 , Integer
1549 , Integer
1553 , Integer
1559 , Integer
1567 , Integer
1571 , Integer
1579 , Integer
1583
    , Integer
1597 , Integer
1601 , Integer
1607 , Integer
1609 , Integer
1613 , Integer
1619 , Integer
1621 , Integer
1627 , Integer
1637 , Integer
1657
    , Integer
1663 , Integer
1667 , Integer
1669 , Integer
1693 , Integer
1697 , Integer
1699 , Integer
1709 , Integer
1721 , Integer
1723 , Integer
1733
    , Integer
1741 , Integer
1747 , Integer
1753 , Integer
1759 , Integer
1777 , Integer
1783 , Integer
1787 , Integer
1789 , Integer
1801 , Integer
1811
    , Integer
1823 , Integer
1831 , Integer
1847 , Integer
1861 , Integer
1867 , Integer
1871 , Integer
1873 , Integer
1877 , Integer
1879 , Integer
1889
    , Integer
1901 , Integer
1907 , Integer
1913 , Integer
1931 , Integer
1933 , Integer
1949 , Integer
1951 , Integer
1973 , Integer
1979 , Integer
1987
    , Integer
1993 , Integer
1997 , Integer
1999 , Integer
2003 , Integer
2011 , Integer
2017 , Integer
2027 , Integer
2029 , Integer
2039 , Integer
2053
    , Integer
2063 , Integer
2069 , Integer
2081 , Integer
2083 , Integer
2087 , Integer
2089 , Integer
2099 , Integer
2111 , Integer
2113 , Integer
2129
    , Integer
2131 , Integer
2137 , Integer
2141 , Integer
2143 , Integer
2153 , Integer
2161 , Integer
2179 , Integer
2203 , Integer
2207 , Integer
2213
    , Integer
2221 , Integer
2237 , Integer
2239 , Integer
2243 , Integer
2251 , Integer
2267 , Integer
2269 , Integer
2273 , Integer
2281 , Integer
2287
    , Integer
2293 , Integer
2297 , Integer
2309 , Integer
2311 , Integer
2333 , Integer
2339 , Integer
2341 , Integer
2347 , Integer
2351 , Integer
2357
    , Integer
2371 , Integer
2377 , Integer
2381 , Integer
2383 , Integer
2389 , Integer
2393 , Integer
2399 , Integer
2411 , Integer
2417 , Integer
2423
    , Integer
2437 , Integer
2441 , Integer
2447 , Integer
2459 , Integer
2467 , Integer
2473 , Integer
2477 , Integer
2503 , Integer
2521 , Integer
2531
    , Integer
2539 , Integer
2543 , Integer
2549 , Integer
2551 , Integer
2557 , Integer
2579 , Integer
2591 , Integer
2593 , Integer
2609 , Integer
2617
    , Integer
2621 , Integer
2633 , Integer
2647 , Integer
2657 , Integer
2659 , Integer
2663 , Integer
2671 , Integer
2677 , Integer
2683 , Integer
2687
    , Integer
2689 , Integer
2693 , Integer
2699 , Integer
2707 , Integer
2711 , Integer
2713 , Integer
2719 , Integer
2729 , Integer
2731 , Integer
2741
    , Integer
2749 , Integer
2753 , Integer
2767 , Integer
2777 , Integer
2789 , Integer
2791 , Integer
2797 , Integer
2801 , Integer
2803 , Integer
2819
    , Integer
2833 , Integer
2837 , Integer
2843 , Integer
2851 , Integer
2857 , Integer
2861 , Integer
2879 , Integer
2887 , Integer
2897 , Integer
2903
    ]

{-# INLINE divides #-}
divides :: Integer -> Integer -> Bool
divides :: Integer -> Integer -> Bool
divides Integer
i Integer
n = Integer
n forall a. Integral a => a -> a -> a
`mod` Integer
i forall a. Eq a => a -> a -> Bool
== Integer
0