Key generation.

2 files changed, 146 insertions, 1 deletions

diff --git a/Data/OpenPGP/Util.hs b/Data/OpenPGP/Util.hs
index c675ec2..8a1a449 100644
--- a/Data/OpenPGP/Util.hs
+++ b/Data/OpenPGP/Util.hs
@@ -3,10 +3,12 @@ module Data.OpenPGP.Util
     , decryptSecretKey
     , verify
     , pgpSign
+    , GenerateKeyParams(..)
+    , generateKey
     ) where
 
 import Data.OpenPGP.Util.Fingerprint
 import Data.OpenPGP.Util.Sign
 import Data.OpenPGP.Util.Verify
 import Data.OpenPGP.Util.DecryptSecretKey
-
+import Data.OpenPGP.Util.Gen
diff --git a/Data/OpenPGP/Util/Gen.hs b/Data/OpenPGP/Util/Gen.hs
new file mode 100644
index 0000000..f7ab90f
--- /dev/null
+++ b/Data/OpenPGP/Util/Gen.hs
@@ -0,0 +1,143 @@
+{-# LANGUAGE CPP #-}
+module Data.OpenPGP.Util.Gen where
+
+import Data.OpenPGP
+import Data.Maybe
+import Data.Word
+import qualified Data.ByteString.Lazy as B
+import qualified Data.ByteString as S
+
+import qualified Crypto.Random as Vincent
+import qualified Crypto.PubKey.DSA as Vincent.DSA
+import qualified Crypto.PubKey.RSA as Vincent.RSA
+import qualified Crypto.PubKey.RSA.PKCS15 as Vincent.RSA
+import qualified Crypto.PubKey.ECC.ECDSA as Vincent.ECDSA
+
+import qualified Data.Time.Clock.POSIX
+
+data GenerateKeyParams = GenRSA Int -- keysize
+                       | GenDSA (Maybe DSAParams)
+
+ deriving (Eq,Ord,Show)
+
+data DSAParams = DSAParams
+                       { dsa_params_p :: Integer
+                       , dsa_params_g :: Integer
+                       , dsa_params_q :: Integer }
+ deriving (Eq,Ord,Show)
+
+genKeyAlg :: GenerateKeyParams -> KeyAlgorithm
+genKeyAlg (GenRSA _) = RSA
+genKeyAlg (GenDSA _) = DSA
+
+-- | Generate a secret key pgp packet from system entropy.
+generateKey :: GenerateKeyParams -> IO Packet
+generateKey params = do
+        now <- currentTimeWord32
+        g <- makeGen Nothing
+        let (fields,g') = generateKey' params g
+        return $ buildPacket (genKeyAlg params) now fields
+
+#if defined(VERSION_crypto_random)
+type RNG = Vincent.SystemRNG
+
+makeGen :: Maybe FilePath -> IO RNG
+makeGen noisefile = do
+    pool <- fromMaybe Vincent.createEntropyPool $ do
+        path <- noisefile
+        Just $ Vincent.createTestEntropyPool `fmap` S.readFile path
+    return (Vincent.cprgCreate pool :: Vincent.SystemRNG)
+
+rsaFields priv = [ ('n', MPI $ Vincent.RSA.public_n (Vincent.RSA.private_pub priv))
+                 , ('e', MPI $ Vincent.RSA.public_e (Vincent.RSA.private_pub priv))
+                 , ('d', MPI $ Vincent.RSA.private_d priv)
+                 , ('p', MPI $ Vincent.RSA.private_q priv)
+                 , ('q', MPI $ Vincent.RSA.private_p priv)
+                 , ('u', MPI $ Vincent.RSA.private_qinv priv)]
+
+dsaFields priv = [ ('p', MPI p)
+                 , ('q', MPI $ Vincent.DSA.params_q $ Vincent.DSA.private_params priv )
+                 , ('g', MPI g)
+                 , ('y', MPI $ g^x `mod` p)
+                 , ('x', MPI x)]
+ where
+    x = Vincent.DSA.private_x priv
+    g = Vincent.DSA.params_g $ Vincent.DSA.private_params priv
+    p = Vincent.DSA.params_p $ Vincent.DSA.private_params priv
+
+generateKey' :: GenerateKeyParams -> RNG -> ([(Char,MPI)],RNG)
+generateKey' (GenRSA keysize) g =
+    let -- http://crypto.stackexchange.com/questions/3110/impacts-of-not-using-rsa-exponent-of-65537
+        rsa_exponent = 65537
+        ((pub,priv),g') = Vincent.RSA.generate g keysize rsa_exponent
+    -- discarding private_dQ
+    -- discarding private_dP
+    in ( rsaFields priv, g' )
+generateKey' (GenDSA mbparams) g =
+    let dsa_params = fromMaybe defaultDSAParams $ fmap toVince mbparams
+        toVince (DSAParams p g q) = Vincent.DSA.Params p g q
+        (priv,g') = Vincent.DSA.generatePrivate g dsa_params
+    -- public_key_fields DSA     = ['p', 'q', 'g', 'y']
+    -- secret_key_fields DSA     = ['x']
+    in ( dsaFields (Vincent.DSA.PrivateKey dsa_params priv), g' )
+
+#else
+newtype RNG = RNG (Either SystemDRG ChaChaDRG)
+instance DRG RNG where
+    randomBytesGenerate n (RNG g) =
+        either (second (RNG . Left ) . randomBytesGenerate n)
+               (second (RNG . Right) . randomBytesGenerate n) g
+
+makeGen :: Maybe FilePath -> IO RNG
+makeGen noisefile = do
+    drg <- fromMaybe (Left <$> getSystemDRG) $ do
+        path <- noisefile 
+        Just $ Right . drgNewTest . decodeSeed <$> L.readFile path
+    return $ RNG drg
+ where
+    decodeSeed :: L.ByteString -> (Word64, Word64, Word64, Word64, Word64)
+    decodeSeed bs | L.null bs = (0,0,0,0,0)
+                  | otherwise = decode $  L.cycle bs
+
+instance MonadRandom DB where
+    getRandomBytes n = DB 4 $ \DBParams { dbRNG=rngv } _ -> do
+        bs <- modifyMVar rngv (return . swap . randomBytesGenerate n)
+        return $ Right bs
+
+generateKey' :: GenerateKeyParams -> RNG -> (PrivateKey,RNG)
+generateKey' (GenRSA keysize) g =
+    let rsa_exponent = 65537
+        ((_,priv),g') = withDRG g $ RSA.generate keysize rsa_exponent
+    in ( PrivateRSA priv, g' )
+generateKey' (GenDSA mbparams) g =
+    let dsa_params = fromMaybe defaultDSAParams mbparams
+        (priv,g') = withDRG g $ DSA.generatePrivate dsa_params
+    in ( PrivateDSA (DSA.PrivateKey dsa_params priv), g' )
+
+#endif
+
+
+currentTimeWord32 :: IO Word32
+currentTimeWord32 = floor <$> Data.Time.Clock.POSIX.getPOSIXTime
+
+buildPacket :: KeyAlgorithm -> Word32 -> [(Char,MPI)] -> Packet
+buildPacket alg stamp fields =
+      SecretKeyPacket {
+        timestamp = stamp                 :: Word32,
+        version = 4                       :: Word8,
+        key_algorithm = alg               :: KeyAlgorithm,
+        key = fields                      :: [(Char,MPI)],
+        s2k_useage = 0                    :: Word8,
+        s2k = S2K 100 B.empty             :: S2K, -- Unencrypted so meaningless
+        symmetric_algorithm = Unencrypted :: SymmetricAlgorithm,
+        encrypted_data = B.empty          :: B.ByteString,
+        is_subkey = True                  :: Bool
+          }
+
+defaultDSAParams :: Vincent.DSA.Params
+defaultDSAParams = Vincent.DSA.Params
+    { Vincent.DSA.params_p = 25016032990684888518988658620325126146216470517049479187156156734213376906219942961707957641401749519947125090638800516836972123148009221755073642581464845387235660414348889382008154731058786820730247996611955465863529460612040002991075529989397271247177642048614532123132310296005749599675664384673629073848636519328677230918100996732661901275340454155565768752980771336725651539837887289446847136557589393348919689634715419500097585479277479066450412377941277218532943901492329509956866134692951999522393506140918443671786722258878778178444946544570489542640773262151888089794659117142339310858339721084998689009113
+    , Vincent.DSA.params_q = 24289205633892182261673754417007225086255920651423805093223058502897
+    , Vincent.DSA.params_g = 14163516289631370671608698837927753143825670852934869718450850658283442975416133481761559479714034401583801628224741616560126187810551733284361046143315226067355563227860282174889634742169280269622671773116176523712230772457681507357681374615558206405969011913182779829876763280507794583263187213066680289675392841938777384288859684653238393939307768899246590677720387825052549466445990058620838747851535777836897369521109616233955046301358290724806298742875429454780763259982037236610786647541183309285037036036778584959871753945456209439667132114356168289377762491848873534919083413137563924214401854434599021748980
+    }
+