From 12751d65b72b6f9325a0cf917c4be8a4750e2e8b Mon Sep 17 00:00:00 2001 From: joe Date: Sun, 24 Apr 2016 21:35:49 -0400 Subject: Key generation. --- Data/OpenPGP/Util/Gen.hs | 143 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 143 insertions(+) create mode 100644 Data/OpenPGP/Util/Gen.hs (limited to 'Data/OpenPGP/Util/Gen.hs') 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 + } + -- cgit v1.2.3