{-# LANGUAGE BangPatterns #-}
module Crypto.Number.Prime (
generatePrime,
generateSafePrime,
isProbablyPrime,
findPrimeFrom,
findPrimeFromWith,
primalityTestMillerRabin,
primalityTestNaive,
primalityTestFermat,
isCoprime,
) where
import Crypto.Error
import Crypto.Number.Basic (gcde, sqrti)
import Crypto.Number.Compat
import Crypto.Number.Generate
import Crypto.Number.ModArithmetic (expSafe)
import Crypto.Random.Probabilistic
import Crypto.Random.Types
import Data.Bits
isProbablyPrime :: Integer -> Bool
isProbablyPrime :: Integer -> Bool
isProbablyPrime !Integer
n
| (Integer -> Bool) -> [Integer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Integer
p -> Integer
p Integer -> Integer -> Bool
`divides` Integer
n) ((Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
filter (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
n) [Integer]
firstPrimes) = Bool
False
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
2 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
2903 = Bool
True
| Int -> Integer -> Integer -> Bool
primalityTestFermat Int
50 (Integer
n Integer -> Integer -> Integer
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5
then
CryptoFailable (m Integer) -> m Integer
forall a. CryptoFailable a -> a
throwCryptoError (CryptoFailable (m Integer) -> m Integer)
-> CryptoFailable (m Integer) -> m Integer
forall a b. (a -> b) -> a -> b
$ CryptoError -> CryptoFailable (m Integer)
forall a. CryptoError -> CryptoFailable a
CryptoFailed (CryptoError -> CryptoFailable (m Integer))
-> CryptoError -> CryptoFailable (m Integer)
forall a b. (a -> b) -> a -> b
$ CryptoError
CryptoError_PrimeSizeInvalid
else do
Integer
sp <- Int -> Maybe GenTopPolicy -> Bool -> m Integer
forall (m :: * -> *).
MonadRandom m =>
Int -> Maybe GenTopPolicy -> Bool -> m Integer
generateParams Int
bits (GenTopPolicy -> Maybe GenTopPolicy
forall a. a -> Maybe a
Just GenTopPolicy
SetTwoHighest) Bool
True
let prime :: Integer
prime = Integer -> Integer
findPrimeFrom Integer
sp
if Integer
prime Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
bits
then
Integer -> m Integer
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer
prime
else Int -> m Integer
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
6
then
CryptoFailable (m Integer) -> m Integer
forall a. CryptoFailable a -> a
throwCryptoError (CryptoFailable (m Integer) -> m Integer)
-> CryptoFailable (m Integer) -> m Integer
forall a b. (a -> b) -> a -> b
$ CryptoError -> CryptoFailable (m Integer)
forall a. CryptoError -> CryptoFailable a
CryptoFailed (CryptoError -> CryptoFailable (m Integer))
-> CryptoError -> CryptoFailable (m Integer)
forall a b. (a -> b) -> a -> b
$ CryptoError
CryptoError_PrimeSizeInvalid
else do
Integer
sp <- Int -> Maybe GenTopPolicy -> Bool -> m Integer
forall (m :: * -> *).
MonadRandom m =>
Int -> Maybe GenTopPolicy -> Bool -> m Integer
generateParams Int
bits (GenTopPolicy -> Maybe GenTopPolicy
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
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)) (Integer
sp Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
2)
let val :: Integer
val = Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
if Integer
val Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
bits
then
Integer -> m Integer
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer
val
else Int -> m Integer
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
| Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
n = (Integer -> Bool) -> Integer -> Integer
findPrimeFromWith Integer -> Bool
prop (Integer
n Integer -> Integer -> Integer
forall 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
n Integer -> Integer -> Integer
forall 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
n Integer -> Integer -> Integer
forall 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 -> MonadPseudoRandom ChaChaDRG Bool -> Bool
forall a. MonadPseudoRandom ChaChaDRG a -> a
probabilistic MonadPseudoRandom ChaChaDRG Bool
run
where
run :: MonadPseudoRandom ChaChaDRG Bool
run
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
3 = [Char] -> MonadPseudoRandom ChaChaDRG Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"Miller-Rabin requires tested value to be > 3"
| Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
n = Bool -> MonadPseudoRandom ChaChaDRG Bool
forall a. a -> MonadPseudoRandom ChaChaDRG a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
| Int
tries Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Char] -> MonadPseudoRandom ChaChaDRG Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"Miller-Rabin tries need to be > 0"
| Bool
otherwise = [Integer] -> Bool
loop ([Integer] -> Bool)
-> MonadPseudoRandom ChaChaDRG [Integer]
-> MonadPseudoRandom ChaChaDRG Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> MonadPseudoRandom ChaChaDRG [Integer]
forall {t} {m :: * -> *}.
(Eq t, Num t, MonadRandom m) =>
t -> m [Integer]
generateTries Int
tries
!nm1 :: Integer
nm1 = Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
!nm2 :: Integer
nm2 = Integer
n Integer -> Integer -> Integer
forall 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 = [Integer] -> m [Integer]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
generateTries t
t = do
Integer
v <- Integer -> Integer -> m Integer
forall (m :: * -> *).
MonadRandom m =>
Integer -> Integer -> m Integer
generateBetween Integer
2 Integer
nm2
[Integer]
vs <- t -> m [Integer]
generateTries (t
t t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
[Integer] -> m [Integer]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
v Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
vs)
factorise :: Integer -> Integer -> (Integer, Integer)
factorise :: Integer -> Integer -> (Integer, Integer)
factorise !Integer
si !Integer
vi
| Integer
vi Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
0 = (Integer
si, Integer
vi)
| Bool
otherwise = Integer -> Integer -> (Integer, Integer)
factorise (Integer
si Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) (Integer
vi Integer -> Int -> Integer
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 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer
1 :: Integer) Bool -> Bool -> Bool
|| Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
nm1
then [Integer] -> Bool
loop [Integer]
ws
else [Integer] -> Integer -> Integer -> Bool
loop' [Integer]
ws ((Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x) Integer -> Integer -> Integer
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 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
s = Bool
False
| Integer
x2 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = Bool
False
| Integer
x2 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
nm1 = [Integer] -> Integer -> Integer -> Bool
loop' [Integer]
ws ((Integer
x2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x2) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
n) (Integer
r Integer -> Integer -> Integer
forall 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 = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Integer -> Bool) -> [Integer] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Bool
expTest [Integer
a .. (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)]
where
!pm1 :: Integer
pm1 = Integer
p Integer -> Integer -> Integer
forall 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 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1
primalityTestNaive :: Integer -> Bool
primalityTestNaive :: Integer -> Bool
primalityTestNaive Integer
n
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
1 = Bool
False
| Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2 = Bool
True
| Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
n = Bool
False
| Bool
otherwise = Integer -> Bool
search Integer
3
where
!ubound :: Integer
ubound = (Integer, Integer) -> Integer
forall a b. (a, b) -> b
snd ((Integer, Integer) -> Integer) -> (Integer, Integer) -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> (Integer, Integer)
sqrti Integer
n
search :: Integer -> Bool
search !Integer
i
| Integer
i Integer -> Integer -> Bool
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
i Integer -> Integer -> Integer
forall 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 Integer -> Integer -> Bool
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 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0