-- |
-- Module      : Crypto.PubKey.RSA.Prim
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : Good
--
module Crypto.PubKey.RSA.Prim
    (
    -- * Decrypt primitive
      dp
    -- * Encrypt primitive
    , ep
    ) where

import           Crypto.PubKey.RSA.Types
import           Crypto.Number.ModArithmetic (expFast, expSafe)
import           Crypto.Number.Serialize (os2ip, i2ospOf_)
import           Crypto.Internal.ByteArray (ByteArray)

{- dpSlow computes the decrypted message not using any precomputed cache value.
   only n and d need to valid. -}
dpSlow :: ByteArray ba => PrivateKey -> ba -> ba
dpSlow :: forall ba. ByteArray ba => PrivateKey -> ba -> ba
dpSlow PrivateKey
pk ba
c = forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ (PrivateKey -> Int
private_size PrivateKey
pk) forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer
expSafe (forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ba
c) (PrivateKey -> Integer
private_d PrivateKey
pk) (PrivateKey -> Integer
private_n PrivateKey
pk)

{- dpFast computes the decrypted message more efficiently if the
   precomputed private values are available. mod p and mod q are faster
   to compute than mod pq -}
dpFast :: ByteArray ba => Blinder -> PrivateKey -> ba -> ba
dpFast :: forall ba. ByteArray ba => Blinder -> PrivateKey -> ba -> ba
dpFast (Blinder Integer
r Integer
rm1) PrivateKey
pk ba
c =
    forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ (PrivateKey -> Int
private_size PrivateKey
pk) (Integer -> Integer -> Integer -> Integer
multiplication Integer
rm1 (Integer
m2 forall a. Num a => a -> a -> a
+ Integer
h forall a. Num a => a -> a -> a
* (PrivateKey -> Integer
private_q PrivateKey
pk)) (PrivateKey -> Integer
private_n PrivateKey
pk))
    where
        re :: Integer
re  = Integer -> Integer -> Integer -> Integer
expFast Integer
r (PublicKey -> Integer
public_e forall a b. (a -> b) -> a -> b
$ PrivateKey -> PublicKey
private_pub PrivateKey
pk) (PrivateKey -> Integer
private_n PrivateKey
pk)
        iC :: Integer
iC  = Integer -> Integer -> Integer -> Integer
multiplication Integer
re (forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ba
c) (PrivateKey -> Integer
private_n PrivateKey
pk)
        m1 :: Integer
m1  = Integer -> Integer -> Integer -> Integer
expSafe Integer
iC (PrivateKey -> Integer
private_dP PrivateKey
pk) (PrivateKey -> Integer
private_p PrivateKey
pk)
        m2 :: Integer
m2  = Integer -> Integer -> Integer -> Integer
expSafe Integer
iC (PrivateKey -> Integer
private_dQ PrivateKey
pk) (PrivateKey -> Integer
private_q PrivateKey
pk)
        h :: Integer
h   = ((PrivateKey -> Integer
private_qinv PrivateKey
pk) forall a. Num a => a -> a -> a
* (Integer
m1 forall a. Num a => a -> a -> a
- Integer
m2)) forall a. Integral a => a -> a -> a
`mod` (PrivateKey -> Integer
private_p PrivateKey
pk)

dpFastNoBlinder :: ByteArray ba => PrivateKey -> ba -> ba
dpFastNoBlinder :: forall ba. ByteArray ba => PrivateKey -> ba -> ba
dpFastNoBlinder PrivateKey
pk ba
c = forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ (PrivateKey -> Int
private_size PrivateKey
pk) (Integer
m2 forall a. Num a => a -> a -> a
+ Integer
h forall a. Num a => a -> a -> a
* (PrivateKey -> Integer
private_q PrivateKey
pk))
     where iC :: Integer
iC = forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ba
c
           m1 :: Integer
m1 = Integer -> Integer -> Integer -> Integer
expSafe Integer
iC (PrivateKey -> Integer
private_dP PrivateKey
pk) (PrivateKey -> Integer
private_p PrivateKey
pk)
           m2 :: Integer
m2 = Integer -> Integer -> Integer -> Integer
expSafe Integer
iC (PrivateKey -> Integer
private_dQ PrivateKey
pk) (PrivateKey -> Integer
private_q PrivateKey
pk)
           h :: Integer
h  = ((PrivateKey -> Integer
private_qinv PrivateKey
pk) forall a. Num a => a -> a -> a
* (Integer
m1 forall a. Num a => a -> a -> a
- Integer
m2)) forall a. Integral a => a -> a -> a
`mod` (PrivateKey -> Integer
private_p PrivateKey
pk)

-- | Compute the RSA decrypt primitive.
-- if the p and q numbers are available, then dpFast is used
-- otherwise, we use dpSlow which only need d and n.
dp :: ByteArray ba => Maybe Blinder -> PrivateKey -> ba -> ba
dp :: forall ba. ByteArray ba => Maybe Blinder -> PrivateKey -> ba -> ba
dp Maybe Blinder
blinder PrivateKey
pk
    | PrivateKey -> Integer
private_p PrivateKey
pk forall a. Eq a => a -> a -> Bool
/= Integer
0 Bool -> Bool -> Bool
&& PrivateKey -> Integer
private_q PrivateKey
pk forall a. Eq a => a -> a -> Bool
/= Integer
0 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall ba. ByteArray ba => PrivateKey -> ba -> ba
dpFastNoBlinder forall ba. ByteArray ba => Blinder -> PrivateKey -> ba -> ba
dpFast Maybe Blinder
blinder forall a b. (a -> b) -> a -> b
$ PrivateKey
pk
    | Bool
otherwise                              = forall ba. ByteArray ba => PrivateKey -> ba -> ba
dpSlow PrivateKey
pk

-- | Compute the RSA encrypt primitive
ep :: ByteArray ba => PublicKey -> ba -> ba
ep :: forall ba. ByteArray ba => PublicKey -> ba -> ba
ep PublicKey
pk ba
m = forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ (PublicKey -> Int
public_size PublicKey
pk) forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer
expFast (forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ba
m) (PublicKey -> Integer
public_e PublicKey
pk) (PublicKey -> Integer
public_n PublicKey
pk)

-- | multiply 2 integers in Zm only performing the modulo operation if necessary
multiplication :: Integer -> Integer -> Integer -> Integer
multiplication :: Integer -> Integer -> Integer -> Integer
multiplication Integer
a Integer
b Integer
m = (Integer
a forall a. Num a => a -> a -> a
* Integer
b) forall a. Integral a => a -> a -> a
`mod` Integer
m