{-# LANGUAGE BangPatterns #-}

-- |
-- 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 Data.Memory.PtrMethods (memSet)
import Data.Word (Word32, Word8)
import Foreign.C.Types (CInt (..))
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (Ptr, plusPtr)

import Crypto.Internal.ByteArray (ByteArray)
import Crypto.Internal.Compat (unsafeDoIO)
import Crypto.Number.Basic (numBytes)
import Crypto.Number.ModArithmetic (expFast, expSafe)
import Crypto.Number.ModArithmetic.Pub (expPubBytes)
import Crypto.Number.Serialize (i2ospOf_, os2ip)
import qualified Crypto.Number.Serialize.Internal as Internal
import Crypto.PubKey.RSA.Types

{- 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 = Int -> Integer -> ba
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ (PrivateKey -> Int
private_size PrivateKey
pk) (Integer -> ba) -> Integer -> ba
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer
expSafe (ba -> Integer
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 =
    Int -> Integer -> ba
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_
        (PrivateKey -> Int
private_size PrivateKey
pk)
        (Integer -> Integer -> Integer -> Integer
multiplication Integer
rm1 (PrivateKey -> Integer -> Integer -> Integer
crtChecked PrivateKey
pk Integer
iC (Integer
m2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
h Integer -> Integer -> Integer
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 (PublicKey -> Integer) -> PublicKey -> Integer
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 (ba -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ba
c) (PrivateKey -> Integer
private_n PrivateKey
pk)
    (Integer
m1, Integer
m2) = Integer -> PrivateKey -> (Integer, Integer)
crtHalves Integer
iC PrivateKey
pk
    h :: Integer
h = ((PrivateKey -> Integer
private_qinv PrivateKey
pk) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
m1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
m2)) Integer -> Integer -> Integer
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 = Int -> Integer -> ba
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ (PrivateKey -> Int
private_size PrivateKey
pk) (PrivateKey -> Integer -> Integer -> Integer
crtChecked PrivateKey
pk Integer
iC (Integer
m2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
h Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (PrivateKey -> Integer
private_q PrivateKey
pk)))
  where
    iC :: Integer
iC = ba -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ba
c
    (Integer
m1, Integer
m2) = Integer -> PrivateKey -> (Integer, Integer)
crtHalves Integer
iC PrivateKey
pk
    h :: Integer
h = ((PrivateKey -> Integer
private_qinv PrivateKey
pk) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
m1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
m2)) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (PrivateKey -> Integer
private_p PrivateKey
pk)

-- | The CRT answer m for c, raised back to e before it is let out: a fault
-- in one half gives an m whose gcd with n is the other prime (Boneh, DeMillo
-- and Lipton).  On a mismatch it is computed again without CRT, as OpenSSL does.
crtChecked :: PrivateKey -> Integer -> Integer -> Integer
crtChecked :: PrivateKey -> Integer -> Integer -> Integer
crtChecked PrivateKey
pk Integer
c Integer
m
    | Integer -> Integer -> Integer -> Integer
expFast Integer
m (PublicKey -> Integer
public_e (PrivateKey -> PublicKey
private_pub PrivateKey
pk)) Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
c Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
n = Integer
m
    | PrivateKey -> Integer
private_d PrivateKey
pk Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 = Integer -> Integer -> Integer -> Integer
expSafe Integer
c (PrivateKey -> Integer
private_d PrivateKey
pk) Integer
n
    | Bool
otherwise = Integer
m
  where
    n :: Integer
n = PrivateKey -> Integer
private_n PrivateKey
pk

-- | c^dP mod p and c^dQ mod q, the halves of the private-key operation: both
-- at once where the C can (AVX-512 IFMA, and the sizes of RSA-2048, -3072 and
-- -4096), one after the other where it declines.
crtHalves :: Integer -> PrivateKey -> (Integer, Integer)
crtHalves :: Integer -> PrivateKey -> (Integer, Integer)
crtHalves Integer
c PrivateKey
pk = case Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Maybe (Integer, Integer)
expSafeX2 (Integer
c Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
p) Integer
dP Integer
p (Integer
c Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
q) Integer
dQ Integer
q of
    Just (Integer, Integer)
r -> (Integer, Integer)
r
    Maybe (Integer, Integer)
Nothing -> (Integer -> Integer -> Integer -> Integer
expSafe Integer
c Integer
dP Integer
p, Integer -> Integer -> Integer -> Integer
expSafe Integer
c Integer
dQ Integer
q)
  where
    p :: Integer
p = PrivateKey -> Integer
private_p PrivateKey
pk
    q :: Integer
q = PrivateKey -> Integer
private_q PrivateKey
pk
    dP :: Integer
dP = PrivateKey -> Integer
private_dP PrivateKey
pk
    dQ :: Integer
dQ = PrivateKey -> Integer
private_dQ PrivateKey
pk

-- | Two secure exponentiations in one call.  The bases are reduced already
-- and the moduli are the same length; both exponents go in at that length,
-- so the length the C sees is the modulus', as 'expSafe' pads to whole words.
expSafeX2 :: Integer -> Integer -> Integer -> Integer -> Integer -> Integer -> Maybe (Integer, Integer)
expSafeX2 :: Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Maybe (Integer, Integer)
expSafeX2 Integer
b1 Integer
e1 Integer
m1 Integer
b2 Integer
e2 Integer
m2
    | Integer -> Int
numBytes Integer
m2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
len Bool -> Bool -> Bool
|| Bool -> Bool
not (Integer -> Bool
forall a. Integral a => a -> Bool
odd Integer
m1 Bool -> Bool -> Bool
&& Integer -> Bool
forall a. Integral a => a -> Bool
odd Integer
m2) = Maybe (Integer, Integer)
forall a. Maybe a
Nothing
    | Integer
e1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
e2 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer -> Int
numBytes Integer
e1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len Bool -> Bool -> Bool
|| Integer -> Int
numBytes Integer
e2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len = Maybe (Integer, Integer)
forall a. Maybe a
Nothing
    | Bool
otherwise = IO (Maybe (Integer, Integer)) -> Maybe (Integer, Integer)
forall a. IO a -> a
unsafeDoIO (IO (Maybe (Integer, Integer)) -> Maybe (Integer, Integer))
-> IO (Maybe (Integer, Integer)) -> Maybe (Integer, Integer)
forall a b. (a -> b) -> a -> b
$
        Int
-> (Ptr Word8 -> IO (Maybe (Integer, Integer)))
-> IO (Maybe (Integer, Integer))
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len) ((Ptr Word8 -> IO (Maybe (Integer, Integer)))
 -> IO (Maybe (Integer, Integer)))
-> (Ptr Word8 -> IO (Maybe (Integer, Integer)))
-> IO (Maybe (Integer, Integer))
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
start -> case Int -> [Ptr Word8] -> [Ptr Word8]
forall a. Int -> [a] -> [a]
take Int
8 ((Ptr Word8 -> Ptr Word8) -> Ptr Word8 -> [Ptr Word8]
forall a. (a -> a) -> a -> [a]
iterate (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len) Ptr Word8
start) of
            [Ptr Word8
o1, Ptr Word8
pb1, Ptr Word8
pe1, Ptr Word8
pm1, Ptr Word8
o2, Ptr Word8
pb2, Ptr Word8
pe2, Ptr Word8
pm2] -> do
                ((Integer, Ptr Word8) -> IO Int) -> [(Integer, Ptr Word8)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
                    (\(Integer
v, Ptr Word8
ptr) -> Integer -> Ptr Word8 -> Int -> IO Int
Internal.i2ospOf Integer
v Ptr Word8
ptr Int
len)
                    [(Integer
b1, Ptr Word8
pb1), (Integer
e1, Ptr Word8
pe1), (Integer
m1, Ptr Word8
pm1), (Integer
b2, Ptr Word8
pb2), (Integer
e2, Ptr Word8
pe2), (Integer
m2, Ptr Word8
pm2)]
                CInt
r <- Ptr Word8
-> Ptr Word8
-> Word32
-> Ptr Word8
-> Word32
-> Ptr Word8
-> Word32
-> Ptr Word8
-> Ptr Word8
-> Word32
-> Ptr Word8
-> Word32
-> Ptr Word8
-> Word32
-> IO CInt
c_powm_sec_x2 Ptr Word8
o1 Ptr Word8
pb1 Word32
l Ptr Word8
pe1 Word32
l Ptr Word8
pm1 Word32
l Ptr Word8
o2 Ptr Word8
pb2 Word32
l Ptr Word8
pe2 Word32
l Ptr Word8
pm2 Word32
l
                -- the exponents are the caller's secrets
                Ptr Word8 -> Word8 -> Int -> IO ()
memSet Ptr Word8
pe1 Word8
0 Int
len
                Ptr Word8 -> Word8 -> Int -> IO ()
memSet Ptr Word8
pe2 Word8
0 Int
len
                if CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
                    then Maybe (Integer, Integer) -> IO (Maybe (Integer, Integer))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Integer, Integer)
forall a. Maybe a
Nothing
                    else do
                        !Integer
v1 <- Ptr Word8 -> Int -> IO Integer
Internal.os2ip Ptr Word8
o1 Int
len
                        !Integer
v2 <- Ptr Word8 -> Int -> IO Integer
Internal.os2ip Ptr Word8
o2 Int
len
                        Maybe (Integer, Integer) -> IO (Maybe (Integer, Integer))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Integer
v1, Integer
v2))
            [Ptr Word8]
_ -> Maybe (Integer, Integer) -> IO (Maybe (Integer, Integer))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Integer, Integer)
forall a. Maybe a
Nothing
  where
    !len :: Int
len = Integer -> Int
numBytes Integer
m1
    l :: Word32
l = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len :: Word32

foreign import ccall safe "crypton_powm_sec_x2"
    c_powm_sec_x2
        :: Ptr Word8 -> Ptr Word8 -> Word32 -> Ptr Word8 -> Word32 -> Ptr Word8 -> Word32
        -> Ptr Word8 -> Ptr Word8 -> Word32 -> Ptr Word8 -> Word32 -> Ptr Word8 -> Word32
        -> IO CInt

-- | 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 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 Bool -> Bool -> Bool
&& PrivateKey -> Integer
private_q PrivateKey
pk Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 =
        (PrivateKey -> ba -> ba)
-> (Blinder -> PrivateKey -> ba -> ba)
-> Maybe Blinder
-> PrivateKey
-> ba
-> ba
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PrivateKey -> ba -> ba
forall ba. ByteArray ba => PrivateKey -> ba -> ba
dpFastNoBlinder Blinder -> PrivateKey -> ba -> ba
forall ba. ByteArray ba => Blinder -> PrivateKey -> ba -> ba
dpFast Maybe Blinder
blinder (PrivateKey -> ba -> ba) -> PrivateKey -> ba -> ba
forall a b. (a -> b) -> a -> b
$ PrivateKey
pk
    | Bool
otherwise = PrivateKey -> ba -> ba
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 = case Integer -> Integer -> ba -> Maybe ba
forall bi bo.
(ByteArrayAccess bi, ByteArray bo) =>
Integer -> Integer -> bi -> Maybe bo
expPubBytes (PublicKey -> Integer
public_e PublicKey
pk) (PublicKey -> Integer
public_n PublicKey
pk) ba
m of
    Just ba
r -> ba
r
    Maybe ba
Nothing -> Int -> Integer -> ba
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ (PublicKey -> Int
public_size PublicKey
pk) (Integer -> ba) -> Integer -> ba
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer
expFast (ba -> Integer
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 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
b) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
m