-- |
-- Module      : Crypto.PubKey.Rabin.Types
-- License     : BSD-style
-- Maintainer  : Carlos Rodriguez-Vega <crodveg@yahoo.es>
-- Stability   : experimental
-- Portability : unknown
module Crypto.PubKey.Rabin.Types (
    Error (..),
    generatePrimes,
) where

import Crypto.Number.Basic (numBits)
import Crypto.Number.Prime (findPrimeFromWith, generatePrime)
import Crypto.Random.Types

type PrimeCondition = Integer -> Bool

-- | Error possible during encryption, decryption or signing.
data Error
    = -- | the message to encrypt is too long
      MessageTooLong
    | -- | the message decrypted doesn't have a OAEP structure
      MessageNotRecognized
    | -- | some parameters lead to breaking assumptions
      InvalidParameters
    deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show, Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
/= :: Error -> Error -> Bool
Eq)

-- | Generate primes p & q
generatePrimes
    :: MonadRandom m
    => Int
    -- ^ size in bytes
    -> PrimeCondition
    -- ^ condition prime p must satisfy
    -> PrimeCondition
    -- ^ condition prime q must satisfy
    -> m (Integer, Integer)
    -- ^ chosen distinct primes p and q
generatePrimes :: forall (m :: * -> *).
MonadRandom m =>
Int -> PrimeCondition -> PrimeCondition -> m (Integer, Integer)
generatePrimes Int
size PrimeCondition
pCond PrimeCondition
qCond =
    let pBits :: Int
pBits = (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
size Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2))
        qBits :: Int
qBits = (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
size Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)))
     in do
            Integer
p <- Int -> PrimeCondition -> m Integer
forall {m :: * -> *}.
MonadRandom m =>
Int -> PrimeCondition -> m Integer
generatePrime' Int
pBits PrimeCondition
pCond
            Integer
q <- Int -> PrimeCondition -> m Integer
forall {m :: * -> *}.
MonadRandom m =>
Int -> PrimeCondition -> m Integer
generatePrime' Int
qBits PrimeCondition
qCond
            (Integer, Integer) -> m (Integer, Integer)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
p, Integer
q)
  where
    generatePrime' :: Int -> PrimeCondition -> m Integer
generatePrime' Int
bits PrimeCondition
cond = do
        Integer
pr' <- Int -> m Integer
forall (m :: * -> *). MonadRandom m => Int -> m Integer
generatePrime Int
bits
        let pr :: Integer
pr = PrimeCondition -> Integer -> Integer
findPrimeFromWith PrimeCondition
cond Integer
pr'
        if Integer -> Int
numBits Integer
pr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
bits
            then Integer -> m Integer
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
pr
            else Int -> PrimeCondition -> m Integer
generatePrime' Int
bits PrimeCondition
cond