{-# 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
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
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
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
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)
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
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 :: 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)
expmod :: Integer -> Integer -> Integer -> Integer
expmod = Integer -> Integer -> Integer -> Integer
expSafe
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' :: [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
primalityTestFermat :: Int
-> Integer
-> Integer
-> 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
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)
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
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