-- |
-- Module      : Crypto.PubKey.Rabin.Modified
-- License     : BSD-style
-- Maintainer  : Carlos Rodriguez-Vega <crodveg@yahoo.es>
-- Stability   : experimental
-- Portability : unknown
--
-- Modified-Rabin public-key digital signature algorithm.
-- See algorithm 11.30 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al.
--
{-# LANGUAGE DeriveDataTypeable #-}
module Crypto.PubKey.Rabin.Modified
    ( PublicKey(..)
    , PrivateKey(..)
    , generate
    , sign
    , verify
    ) where

import           Data.ByteString
import           Data.Data

import           Crypto.Hash
import           Crypto.Number.ModArithmetic (expSafe, jacobi)
import           Crypto.Number.Serialize (os2ip)
import           Crypto.PubKey.Rabin.Types
import           Crypto.Random.Types

-- | Represent a Modified-Rabin public key.
data PublicKey = PublicKey
    { PublicKey -> Int
public_size :: Int      -- ^ size of key in bytes
    , PublicKey -> Integer
public_n    :: Integer  -- ^ public p*q
    } deriving (Int -> PublicKey -> ShowS
[PublicKey] -> ShowS
PublicKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublicKey] -> ShowS
$cshowList :: [PublicKey] -> ShowS
show :: PublicKey -> String
$cshow :: PublicKey -> String
showsPrec :: Int -> PublicKey -> ShowS
$cshowsPrec :: Int -> PublicKey -> ShowS
Show, ReadPrec [PublicKey]
ReadPrec PublicKey
Int -> ReadS PublicKey
ReadS [PublicKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PublicKey]
$creadListPrec :: ReadPrec [PublicKey]
readPrec :: ReadPrec PublicKey
$creadPrec :: ReadPrec PublicKey
readList :: ReadS [PublicKey]
$creadList :: ReadS [PublicKey]
readsPrec :: Int -> ReadS PublicKey
$creadsPrec :: Int -> ReadS PublicKey
Read, PublicKey -> PublicKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicKey -> PublicKey -> Bool
$c/= :: PublicKey -> PublicKey -> Bool
== :: PublicKey -> PublicKey -> Bool
$c== :: PublicKey -> PublicKey -> Bool
Eq, Typeable PublicKey
PublicKey -> DataType
PublicKey -> Constr
(forall b. Data b => b -> b) -> PublicKey -> PublicKey
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PublicKey -> u
forall u. (forall d. Data d => d -> u) -> PublicKey -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PublicKey -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PublicKey -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PublicKey
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PublicKey -> c PublicKey
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PublicKey)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PublicKey)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PublicKey -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PublicKey -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PublicKey -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PublicKey -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PublicKey -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PublicKey -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PublicKey -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PublicKey -> r
gmapT :: (forall b. Data b => b -> b) -> PublicKey -> PublicKey
$cgmapT :: (forall b. Data b => b -> b) -> PublicKey -> PublicKey
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PublicKey)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PublicKey)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PublicKey)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PublicKey)
dataTypeOf :: PublicKey -> DataType
$cdataTypeOf :: PublicKey -> DataType
toConstr :: PublicKey -> Constr
$ctoConstr :: PublicKey -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PublicKey
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PublicKey
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PublicKey -> c PublicKey
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PublicKey -> c PublicKey
Data)

-- | Represent a Modified-Rabin private key.
data PrivateKey = PrivateKey
    { PrivateKey -> PublicKey
private_pub :: PublicKey
    , PrivateKey -> Integer
private_p   :: Integer   -- ^ p prime number
    , PrivateKey -> Integer
private_q   :: Integer   -- ^ q prime number
    , PrivateKey -> Integer
private_d   :: Integer
    } deriving (Int -> PrivateKey -> ShowS
[PrivateKey] -> ShowS
PrivateKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrivateKey] -> ShowS
$cshowList :: [PrivateKey] -> ShowS
show :: PrivateKey -> String
$cshow :: PrivateKey -> String
showsPrec :: Int -> PrivateKey -> ShowS
$cshowsPrec :: Int -> PrivateKey -> ShowS
Show, ReadPrec [PrivateKey]
ReadPrec PrivateKey
Int -> ReadS PrivateKey
ReadS [PrivateKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PrivateKey]
$creadListPrec :: ReadPrec [PrivateKey]
readPrec :: ReadPrec PrivateKey
$creadPrec :: ReadPrec PrivateKey
readList :: ReadS [PrivateKey]
$creadList :: ReadS [PrivateKey]
readsPrec :: Int -> ReadS PrivateKey
$creadsPrec :: Int -> ReadS PrivateKey
Read, PrivateKey -> PrivateKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrivateKey -> PrivateKey -> Bool
$c/= :: PrivateKey -> PrivateKey -> Bool
== :: PrivateKey -> PrivateKey -> Bool
$c== :: PrivateKey -> PrivateKey -> Bool
Eq, Typeable PrivateKey
PrivateKey -> DataType
PrivateKey -> Constr
(forall b. Data b => b -> b) -> PrivateKey -> PrivateKey
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PrivateKey -> u
forall u. (forall d. Data d => d -> u) -> PrivateKey -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrivateKey -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrivateKey -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PrivateKey -> m PrivateKey
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrivateKey -> m PrivateKey
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrivateKey
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrivateKey -> c PrivateKey
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PrivateKey)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PrivateKey)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrivateKey -> m PrivateKey
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrivateKey -> m PrivateKey
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrivateKey -> m PrivateKey
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrivateKey -> m PrivateKey
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PrivateKey -> m PrivateKey
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PrivateKey -> m PrivateKey
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PrivateKey -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PrivateKey -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PrivateKey -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PrivateKey -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrivateKey -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrivateKey -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrivateKey -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrivateKey -> r
gmapT :: (forall b. Data b => b -> b) -> PrivateKey -> PrivateKey
$cgmapT :: (forall b. Data b => b -> b) -> PrivateKey -> PrivateKey
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PrivateKey)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PrivateKey)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PrivateKey)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PrivateKey)
dataTypeOf :: PrivateKey -> DataType
$cdataTypeOf :: PrivateKey -> DataType
toConstr :: PrivateKey -> Constr
$ctoConstr :: PrivateKey -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrivateKey
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrivateKey
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrivateKey -> c PrivateKey
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrivateKey -> c PrivateKey
Data)

-- | Generate a pair of (private, public) key of size in bytes.
-- Prime p is congruent 3 mod 8 and prime q is congruent 7 mod 8.
generate :: MonadRandom m
         => Int           
         -> m (PublicKey, PrivateKey)
generate :: forall (m :: * -> *).
MonadRandom m =>
Int -> m (PublicKey, PrivateKey)
generate Int
size = do
    (Integer
p, Integer
q) <- forall (m :: * -> *).
MonadRandom m =>
Int -> PrimeCondition -> PrimeCondition -> m (Integer, Integer)
generatePrimes Int
size (\Integer
p -> Integer
p forall a. Integral a => a -> a -> a
`mod` Integer
8 forall a. Eq a => a -> a -> Bool
== Integer
3) (\Integer
q -> Integer
q forall a. Integral a => a -> a -> a
`mod` Integer
8 forall a. Eq a => a -> a -> Bool
== Integer
7)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> (PublicKey, PrivateKey)
generateKeys Integer
p Integer
q
  where 
    generateKeys :: Integer -> Integer -> (PublicKey, PrivateKey)
generateKeys Integer
p Integer
q =
        let n :: Integer
n = Integer
pforall a. Num a => a -> a -> a
*Integer
q   
            d :: Integer
d = (Integer
n forall a. Num a => a -> a -> a
- Integer
p forall a. Num a => a -> a -> a
- Integer
q forall a. Num a => a -> a -> a
+ Integer
5) forall a. Integral a => a -> a -> a
`div` Integer
8
            publicKey :: PublicKey
publicKey = PublicKey { public_size :: Int
public_size = Int
size
                                    , public_n :: Integer
public_n    = Integer
n }
            privateKey :: PrivateKey
privateKey = PrivateKey { private_pub :: PublicKey
private_pub = PublicKey
publicKey
                                    , private_p :: Integer
private_p   = Integer
p
                                    , private_q :: Integer
private_q   = Integer
q
                                    , private_d :: Integer
private_d   = Integer
d }
            in (PublicKey
publicKey, PrivateKey
privateKey)

-- | Sign message using hash algorithm and private key.
sign :: HashAlgorithm hash
     => PrivateKey    -- ^ private key
     -> hash          -- ^ hash function
     -> ByteString    -- ^ message to sign
     -> Either Error Integer
sign :: forall hash.
HashAlgorithm hash =>
PrivateKey -> hash -> ByteString -> Either Error Integer
sign PrivateKey
pk hash
hashAlg ByteString
m =
    let d :: Integer
d = PrivateKey -> Integer
private_d PrivateKey
pk
        n :: Integer
n = PublicKey -> Integer
public_n forall a b. (a -> b) -> a -> b
$ PrivateKey -> PublicKey
private_pub PrivateKey
pk
        h :: Integer
h = forall ba. ByteArrayAccess ba => ba -> Integer
os2ip forall a b. (a -> b) -> a -> b
$ forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith hash
hashAlg ByteString
m
        limit :: Integer
limit = (Integer
n forall a. Num a => a -> a -> a
- Integer
6) forall a. Integral a => a -> a -> a
`div` Integer
16
     in if Integer
h forall a. Ord a => a -> a -> Bool
> Integer
limit then forall a b. a -> Either a b
Left Error
MessageTooLong
        else let h' :: Integer
h' = Integer
16forall a. Num a => a -> a -> a
*Integer
h forall a. Num a => a -> a -> a
+ Integer
6
              in case Integer -> Integer -> Maybe Integer
jacobi Integer
h' Integer
n of
                    Just Integer
1    -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer
expSafe Integer
h' Integer
d Integer
n
                    Just (-1) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer
expSafe (Integer
h' forall a. Integral a => a -> a -> a
`div` Integer
2) Integer
d Integer
n
                    Maybe Integer
_         -> forall a b. a -> Either a b
Left Error
InvalidParameters

-- | Verify signature using hash algorithm and public key.
verify :: HashAlgorithm hash
       => PublicKey     -- ^ public key
       -> hash          -- ^ hash function
       -> ByteString    -- ^ message
       -> Integer       -- ^ signature
       -> Bool
verify :: forall hash.
HashAlgorithm hash =>
PublicKey -> hash -> ByteString -> PrimeCondition
verify PublicKey
pk hash
hashAlg ByteString
m Integer
s =
    let n :: Integer
n   = PublicKey -> Integer
public_n PublicKey
pk
        h :: Integer
h   = forall ba. ByteArrayAccess ba => ba -> Integer
os2ip forall a b. (a -> b) -> a -> b
$ forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith hash
hashAlg ByteString
m
        s' :: Integer
s'  = Integer -> Integer -> Integer -> Integer
expSafe Integer
s Integer
2 Integer
n
        s'' :: Integer
s'' = case Integer
s' forall a. Integral a => a -> a -> a
`mod` Integer
8 of
            Integer
6 -> Integer
s'
            Integer
3 -> Integer
2forall a. Num a => a -> a -> a
*Integer
s'
            Integer
7 -> Integer
n forall a. Num a => a -> a -> a
- Integer
s'
            Integer
2 -> Integer
2forall a. Num a => a -> a -> a
*(Integer
n forall a. Num a => a -> a -> a
- Integer
s')
            Integer
_ -> Integer
0
     in case Integer
s'' forall a. Integral a => a -> a -> a
`mod` Integer
16 of
            Integer
6 -> let h' :: Integer
h' = (Integer
s'' forall a. Num a => a -> a -> a
- Integer
6) forall a. Integral a => a -> a -> a
`div` Integer
16
                  in Integer
h' forall a. Eq a => a -> a -> Bool
== Integer
h 
            Integer
_ -> Bool
False