1-- |
2-- Module      : Crypto.PubKey.RSA
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : Good
7--
8module Crypto.PubKey.RSA
9    ( Error(..)
10    , PublicKey(..)
11    , PrivateKey(..)
12    , Blinder(..)
13    -- * Generation function
14    , generateWith
15    , generate
16    , generateBlinder
17    ) where
18
19import Crypto.Random.Types
20import Crypto.Number.ModArithmetic (inverse, inverseCoprimes)
21import Crypto.Number.Generate (generateMax)
22import Crypto.Number.Prime (generatePrime)
23import Crypto.PubKey.RSA.Types
24
25{-
26-- some bad implementation will not serialize ASN.1 integer properly, leading
27-- to negative modulus.
28-- TODO : Find a better place for this
29toPositive :: Integer -> Integer
30toPositive int
31    | int < 0   = uintOfBytes $ bytesOfInt int
32    | otherwise = int
33  where uintOfBytes = foldl (\acc n -> (acc `shiftL` 8) + fromIntegral n) 0
34        bytesOfInt :: Integer -> [Word8]
35        bytesOfInt n = if testBit (head nints) 7 then nints else 0xff : nints
36          where nints = reverse $ plusOne $ reverse $ map complement $ bytesOfUInt (abs n)
37                plusOne []     = [1]
38                plusOne (x:xs) = if x == 0xff then 0 : plusOne xs else (x+1) : xs
39                bytesOfUInt x = reverse (list x)
40                  where list i = if i <= 0xff then [fromIntegral i] else (fromIntegral i .&. 0xff) : list (i `shiftR` 8)
41-}
42
43-- | Generate a key pair given p and q.
44--
45-- p and q need to be distinct prime numbers.
46--
47-- e need to be coprime to phi=(p-1)*(q-1). If that's not the
48-- case, the function will not return a key pair.
49-- A small hamming weight results in better performance.
50--
51-- * e=0x10001 is a popular choice
52--
53-- * e=3 is popular as well, but proven to not be as secure for some cases.
54--
55generateWith :: (Integer, Integer) -- ^ chosen distinct primes p and q
56             -> Int                -- ^ size in bytes
57             -> Integer            -- ^ RSA public exponent 'e'
58             -> Maybe (PublicKey, PrivateKey)
59generateWith (p,q) size e =
60    case inverse e phi of
61        Nothing -> Nothing
62        Just d  -> Just (pub,priv d)
63  where n   = p*q
64        phi = (p-1)*(q-1)
65        -- q and p should be *distinct* *prime* numbers, hence always coprime
66        qinv = inverseCoprimes q p
67        pub = PublicKey { public_size = size
68                        , public_n    = n
69                        , public_e    = e
70                        }
71        priv d = PrivateKey { private_pub  = pub
72                            , private_d    = d
73                            , private_p    = p
74                            , private_q    = q
75                            , private_dP   = d `mod` (p-1)
76                            , private_dQ   = d `mod` (q-1)
77                            , private_qinv = qinv
78                            }
79
80-- | generate a pair of (private, public) key of size in bytes.
81generate :: MonadRandom m
82         => Int     -- ^ size in bytes
83         -> Integer -- ^ RSA public exponent 'e'
84         -> m (PublicKey, PrivateKey)
85generate size e = loop
86  where
87    loop = do -- loop until we find a valid key pair given e
88        pq <- generatePQ
89        case generateWith pq size e of
90            Nothing -> loop
91            Just pp -> return pp
92    generatePQ = do
93        p <- generatePrime (8 * (size `div` 2))
94        q <- generateQ p
95        return (p,q)
96    generateQ p = do
97        q <- generatePrime (8 * (size - (size `div` 2)))
98        if p == q then generateQ p else return q
99
100-- | Generate a blinder to use with decryption and signing operation
101--
102-- the unique parameter apart from the random number generator is the
103-- public key value N.
104generateBlinder :: MonadRandom m
105                => Integer -- ^ RSA public N parameter.
106                -> m Blinder
107generateBlinder n =
108    (\r -> Blinder r (inverseCoprimes r n)) <$> generateMax n
109