module Crypto.Number.Generate
( GenTopPolicy(..)
, generateParams
, generateMax
, generateBetween
) where
import Crypto.Internal.Imports
import Crypto.Number.Basic
import Crypto.Number.Serialize
import Crypto.Random.Types
import Control.Monad (when)
import Foreign.Ptr
import Foreign.Storable
import Data.Bits ((.|.), (.&.), shiftL, complement, testBit)
import Crypto.Internal.ByteArray (ScrubbedBytes)
import qualified Crypto.Internal.ByteArray as B
data GenTopPolicy =
SetHighest
| SetTwoHighest
deriving (Int -> GenTopPolicy -> ShowS
[GenTopPolicy] -> ShowS
GenTopPolicy -> String
(Int -> GenTopPolicy -> ShowS)
-> (GenTopPolicy -> String)
-> ([GenTopPolicy] -> ShowS)
-> Show GenTopPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenTopPolicy] -> ShowS
$cshowList :: [GenTopPolicy] -> ShowS
show :: GenTopPolicy -> String
$cshow :: GenTopPolicy -> String
showsPrec :: Int -> GenTopPolicy -> ShowS
$cshowsPrec :: Int -> GenTopPolicy -> ShowS
Show,GenTopPolicy -> GenTopPolicy -> Bool
(GenTopPolicy -> GenTopPolicy -> Bool)
-> (GenTopPolicy -> GenTopPolicy -> Bool) -> Eq GenTopPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenTopPolicy -> GenTopPolicy -> Bool
$c/= :: GenTopPolicy -> GenTopPolicy -> Bool
== :: GenTopPolicy -> GenTopPolicy -> Bool
$c== :: GenTopPolicy -> GenTopPolicy -> Bool
Eq)
generateParams :: MonadRandom m
=> Int
-> Maybe GenTopPolicy
-> Bool
-> m Integer
generateParams :: Int -> Maybe GenTopPolicy -> Bool -> m Integer
generateParams bits :: Int
bits genTopPolicy :: Maybe GenTopPolicy
genTopPolicy generateOdd :: Bool
generateOdd
| Int
bits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return 0
| Bool
otherwise = ScrubbedBytes -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip (ScrubbedBytes -> Integer)
-> (ScrubbedBytes -> ScrubbedBytes) -> ScrubbedBytes -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> ScrubbedBytes
tweak (ScrubbedBytes -> Integer) -> m ScrubbedBytes -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ScrubbedBytes
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
bytes
where
tweak :: ScrubbedBytes -> ScrubbedBytes
tweak :: ScrubbedBytes -> ScrubbedBytes
tweak orig :: ScrubbedBytes
orig = ScrubbedBytes -> (Ptr Word8 -> IO ()) -> ScrubbedBytes
forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze ScrubbedBytes
orig ((Ptr Word8 -> IO ()) -> ScrubbedBytes)
-> (Ptr Word8 -> IO ()) -> ScrubbedBytes
forall a b. (a -> b) -> a -> b
$ \p0 :: Ptr Word8
p0 -> do
let p1 :: Ptr b
p1 = Ptr Word8
p0 Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1
pEnd :: Ptr b
pEnd = Ptr Word8
p0 Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
bytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
case Maybe GenTopPolicy
genTopPolicy of
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just SetHighest -> Ptr Word8
p0 Ptr Word8 -> Word8 -> IO ()
|= (1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
bit)
Just SetTwoHighest
| Int
bit Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> do Ptr Word8
p0 Ptr Word8 -> Word8 -> IO ()
$= 0x1
Ptr Word8
forall b. Ptr b
p1 Ptr Word8 -> Word8 -> IO ()
|= 0x80
| Bool
otherwise -> Ptr Word8
p0 Ptr Word8 -> Word8 -> IO ()
|= (0x3 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` (Int
bit Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1))
Ptr Word8
p0 Ptr Word8 -> Word8 -> IO ()
&= (Word8 -> Word8
forall a. Bits a => a -> a
complement (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ Word8
mask)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
generateOdd (Ptr Word8
forall b. Ptr b
pEnd Ptr Word8 -> Word8 -> IO ()
|= 0x1)
($=) :: Ptr Word8 -> Word8 -> IO ()
$= :: Ptr Word8 -> Word8 -> IO ()
($=) p :: Ptr Word8
p w :: Word8
w = Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p Word8
w
(|=) :: Ptr Word8 -> Word8 -> IO ()
|= :: Ptr Word8 -> Word8 -> IO ()
(|=) p :: Ptr Word8
p w :: Word8
w = Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p IO Word8 -> (Word8 -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \v :: Word8
v -> Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word8
v Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
w)
(&=) :: Ptr Word8 -> Word8 -> IO ()
&= :: Ptr Word8 -> Word8 -> IO ()
(&=) p :: Ptr Word8
p w :: Word8
w = Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p IO Word8 -> (Word8 -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \v :: Word8
v -> Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word8
v Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
w)
bytes :: Int
bytes = (Int
bits Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 8;
bit :: Int
bit = (Int
bits Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 8;
mask :: Word8
mask = 0xff Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` (Int
bit Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1);
generateMax :: MonadRandom m
=> Integer
-> m Integer
generateMax :: Integer -> m Integer
generateMax range :: Integer
range
| Integer
range Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= 1 = Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return 0
| Integer
range Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 127 = m Integer
generateSimple
| Bool
canOverGenerate = Int -> m Integer
forall t (m :: * -> *).
(Eq t, Num t, MonadRandom m) =>
t -> m Integer
loopGenerateOver Int
tries
| Bool
otherwise = Int -> m Integer
forall t (m :: * -> *).
(Eq t, Num t, MonadRandom m) =>
t -> m Integer
loopGenerate Int
tries
where
generateSimple :: m Integer
generateSimple = (Integer -> Integer -> Integer) -> Integer -> Integer -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
range (Integer -> Integer) -> m Integer -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> Maybe GenTopPolicy -> Bool -> m Integer
forall (m :: * -> *).
MonadRandom m =>
Int -> Maybe GenTopPolicy -> Bool -> m Integer
generateParams Int
bits Maybe GenTopPolicy
forall a. Maybe a
Nothing Bool
False
loopGenerate :: t -> m Integer
loopGenerate count :: t
count
| t
count t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = String -> m Integer
forall a. HasCallStack => String -> a
error (String -> m Integer) -> String -> m Integer
forall a b. (a -> b) -> a -> b
$ "internal: generateMax(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
range String -> ShowS
forall a. [a] -> [a] -> [a]
++ " bits=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
bits String -> ShowS
forall a. [a] -> [a] -> [a]
++ ") (normal) doesn't seems to work properly"
| Bool
otherwise = do
Integer
r <- Int -> Maybe GenTopPolicy -> Bool -> m Integer
forall (m :: * -> *).
MonadRandom m =>
Int -> Maybe GenTopPolicy -> Bool -> m Integer
generateParams Int
bits Maybe GenTopPolicy
forall a. Maybe a
Nothing Bool
False
if Integer -> Bool
isValid Integer
r then Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
r else t -> m Integer
loopGenerate (t
countt -> t -> t
forall a. Num a => a -> a -> a
-1)
loopGenerateOver :: t -> m Integer
loopGenerateOver count :: t
count
| t
count t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = String -> m Integer
forall a. HasCallStack => String -> a
error (String -> m Integer) -> String -> m Integer
forall a b. (a -> b) -> a -> b
$ "internal: generateMax(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
range String -> ShowS
forall a. [a] -> [a] -> [a]
++ " bits=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
bits String -> ShowS
forall a. [a] -> [a] -> [a]
++ ") (over) doesn't seems to work properly"
| Bool
otherwise = do
Integer
r <- Int -> Maybe GenTopPolicy -> Bool -> m Integer
forall (m :: * -> *).
MonadRandom m =>
Int -> Maybe GenTopPolicy -> Bool -> m Integer
generateParams (Int
bitsInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Maybe GenTopPolicy
forall a. Maybe a
Nothing Bool
False
let r2 :: Integer
r2 = Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
range
r3 :: Integer
r3 = Integer
r2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
range
if Integer -> Bool
isValid Integer
r
then Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
r
else if Integer -> Bool
isValid Integer
r2
then Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
r2
else if Integer -> Bool
isValid Integer
r3
then Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
r3
else t -> m Integer
loopGenerateOver (t
countt -> t -> t
forall a. Num a => a -> a -> a
-1)
bits :: Int
bits = Integer -> Int
numBits Integer
range
canOverGenerate :: Bool
canOverGenerate = Int
bits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 3 Bool -> Bool -> Bool
&& Bool -> Bool
not (Integer
range Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` (Int
bitsInt -> Int -> Int
forall a. Num a => a -> a -> a
-2)) Bool -> Bool -> Bool
&& Bool -> Bool
not (Integer
range Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` (Int
bitsInt -> Int -> Int
forall a. Num a => a -> a -> a
-3))
isValid :: Integer -> Bool
isValid n :: Integer
n = Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
range
tries :: Int
tries :: Int
tries = 100
generateBetween :: MonadRandom m => Integer -> Integer -> m Integer
generateBetween :: Integer -> Integer -> m Integer
generateBetween low :: Integer
low high :: Integer
high = (Integer
low Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+) (Integer -> Integer) -> m Integer -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> m Integer
forall (m :: * -> *). MonadRandom m => Integer -> m Integer
generateMax (Integer
high Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
low Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1)