diff options
author | joe <joe@jerkface.net> | 2016-04-24 21:35:49 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2016-04-25 05:07:55 -0400 |
commit | 12751d65b72b6f9325a0cf917c4be8a4750e2e8b (patch) | |
tree | af97dafce1bbc02546d755d6fdfd0eaa8b0743bf | |
parent | 7f2bca77eedcd124e2fe37e900ba6b0876a4334e (diff) |
Key generation.
-rw-r--r-- | Data/OpenPGP/Util.hs | 4 | ||||
-rw-r--r-- | Data/OpenPGP/Util/Gen.hs | 143 | ||||
-rw-r--r-- | openpgp-util.cabal | 3 |
3 files changed, 147 insertions, 3 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 | |||
3 | , decryptSecretKey | 3 | , decryptSecretKey |
4 | , verify | 4 | , verify |
5 | , pgpSign | 5 | , pgpSign |
6 | , GenerateKeyParams(..) | ||
7 | , generateKey | ||
6 | ) where | 8 | ) where |
7 | 9 | ||
8 | import Data.OpenPGP.Util.Fingerprint | 10 | import Data.OpenPGP.Util.Fingerprint |
9 | import Data.OpenPGP.Util.Sign | 11 | import Data.OpenPGP.Util.Sign |
10 | import Data.OpenPGP.Util.Verify | 12 | import Data.OpenPGP.Util.Verify |
11 | import Data.OpenPGP.Util.DecryptSecretKey | 13 | import Data.OpenPGP.Util.DecryptSecretKey |
12 | 14 | 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 @@ | |||
1 | {-# LANGUAGE CPP #-} | ||
2 | module Data.OpenPGP.Util.Gen where | ||
3 | |||
4 | import Data.OpenPGP | ||
5 | import Data.Maybe | ||
6 | import Data.Word | ||
7 | import qualified Data.ByteString.Lazy as B | ||
8 | import qualified Data.ByteString as S | ||
9 | |||
10 | import qualified Crypto.Random as Vincent | ||
11 | import qualified Crypto.PubKey.DSA as Vincent.DSA | ||
12 | import qualified Crypto.PubKey.RSA as Vincent.RSA | ||
13 | import qualified Crypto.PubKey.RSA.PKCS15 as Vincent.RSA | ||
14 | import qualified Crypto.PubKey.ECC.ECDSA as Vincent.ECDSA | ||
15 | |||
16 | import qualified Data.Time.Clock.POSIX | ||
17 | |||
18 | data GenerateKeyParams = GenRSA Int -- keysize | ||
19 | | GenDSA (Maybe DSAParams) | ||
20 | |||
21 | deriving (Eq,Ord,Show) | ||
22 | |||
23 | data DSAParams = DSAParams | ||
24 | { dsa_params_p :: Integer | ||
25 | , dsa_params_g :: Integer | ||
26 | , dsa_params_q :: Integer } | ||
27 | deriving (Eq,Ord,Show) | ||
28 | |||
29 | genKeyAlg :: GenerateKeyParams -> KeyAlgorithm | ||
30 | genKeyAlg (GenRSA _) = RSA | ||
31 | genKeyAlg (GenDSA _) = DSA | ||
32 | |||
33 | -- | Generate a secret key pgp packet from system entropy. | ||
34 | generateKey :: GenerateKeyParams -> IO Packet | ||
35 | generateKey params = do | ||
36 | now <- currentTimeWord32 | ||
37 | g <- makeGen Nothing | ||
38 | let (fields,g') = generateKey' params g | ||
39 | return $ buildPacket (genKeyAlg params) now fields | ||
40 | |||
41 | #if defined(VERSION_crypto_random) | ||
42 | type RNG = Vincent.SystemRNG | ||
43 | |||
44 | makeGen :: Maybe FilePath -> IO RNG | ||
45 | makeGen noisefile = do | ||
46 | pool <- fromMaybe Vincent.createEntropyPool $ do | ||
47 | path <- noisefile | ||
48 | Just $ Vincent.createTestEntropyPool `fmap` S.readFile path | ||
49 | return (Vincent.cprgCreate pool :: Vincent.SystemRNG) | ||
50 | |||
51 | rsaFields priv = [ ('n', MPI $ Vincent.RSA.public_n (Vincent.RSA.private_pub priv)) | ||
52 | , ('e', MPI $ Vincent.RSA.public_e (Vincent.RSA.private_pub priv)) | ||
53 | , ('d', MPI $ Vincent.RSA.private_d priv) | ||
54 | , ('p', MPI $ Vincent.RSA.private_q priv) | ||
55 | , ('q', MPI $ Vincent.RSA.private_p priv) | ||
56 | , ('u', MPI $ Vincent.RSA.private_qinv priv)] | ||
57 | |||
58 | dsaFields priv = [ ('p', MPI p) | ||
59 | , ('q', MPI $ Vincent.DSA.params_q $ Vincent.DSA.private_params priv ) | ||
60 | , ('g', MPI g) | ||
61 | , ('y', MPI $ g^x `mod` p) | ||
62 | , ('x', MPI x)] | ||
63 | where | ||
64 | x = Vincent.DSA.private_x priv | ||
65 | g = Vincent.DSA.params_g $ Vincent.DSA.private_params priv | ||
66 | p = Vincent.DSA.params_p $ Vincent.DSA.private_params priv | ||
67 | |||
68 | generateKey' :: GenerateKeyParams -> RNG -> ([(Char,MPI)],RNG) | ||
69 | generateKey' (GenRSA keysize) g = | ||
70 | let -- http://crypto.stackexchange.com/questions/3110/impacts-of-not-using-rsa-exponent-of-65537 | ||
71 | rsa_exponent = 65537 | ||
72 | ((pub,priv),g') = Vincent.RSA.generate g keysize rsa_exponent | ||
73 | -- discarding private_dQ | ||
74 | -- discarding private_dP | ||
75 | in ( rsaFields priv, g' ) | ||
76 | generateKey' (GenDSA mbparams) g = | ||
77 | let dsa_params = fromMaybe defaultDSAParams $ fmap toVince mbparams | ||
78 | toVince (DSAParams p g q) = Vincent.DSA.Params p g q | ||
79 | (priv,g') = Vincent.DSA.generatePrivate g dsa_params | ||
80 | -- public_key_fields DSA = ['p', 'q', 'g', 'y'] | ||
81 | -- secret_key_fields DSA = ['x'] | ||
82 | in ( dsaFields (Vincent.DSA.PrivateKey dsa_params priv), g' ) | ||
83 | |||
84 | #else | ||
85 | newtype RNG = RNG (Either SystemDRG ChaChaDRG) | ||
86 | instance DRG RNG where | ||
87 | randomBytesGenerate n (RNG g) = | ||
88 | either (second (RNG . Left ) . randomBytesGenerate n) | ||
89 | (second (RNG . Right) . randomBytesGenerate n) g | ||
90 | |||
91 | makeGen :: Maybe FilePath -> IO RNG | ||
92 | makeGen noisefile = do | ||
93 | drg <- fromMaybe (Left <$> getSystemDRG) $ do | ||
94 | path <- noisefile | ||
95 | Just $ Right . drgNewTest . decodeSeed <$> L.readFile path | ||
96 | return $ RNG drg | ||
97 | where | ||
98 | decodeSeed :: L.ByteString -> (Word64, Word64, Word64, Word64, Word64) | ||
99 | decodeSeed bs | L.null bs = (0,0,0,0,0) | ||
100 | | otherwise = decode $ L.cycle bs | ||
101 | |||
102 | instance MonadRandom DB where | ||
103 | getRandomBytes n = DB 4 $ \DBParams { dbRNG=rngv } _ -> do | ||
104 | bs <- modifyMVar rngv (return . swap . randomBytesGenerate n) | ||
105 | return $ Right bs | ||
106 | |||
107 | generateKey' :: GenerateKeyParams -> RNG -> (PrivateKey,RNG) | ||
108 | generateKey' (GenRSA keysize) g = | ||
109 | let rsa_exponent = 65537 | ||
110 | ((_,priv),g') = withDRG g $ RSA.generate keysize rsa_exponent | ||
111 | in ( PrivateRSA priv, g' ) | ||
112 | generateKey' (GenDSA mbparams) g = | ||
113 | let dsa_params = fromMaybe defaultDSAParams mbparams | ||
114 | (priv,g') = withDRG g $ DSA.generatePrivate dsa_params | ||
115 | in ( PrivateDSA (DSA.PrivateKey dsa_params priv), g' ) | ||
116 | |||
117 | #endif | ||
118 | |||
119 | |||
120 | currentTimeWord32 :: IO Word32 | ||
121 | currentTimeWord32 = floor <$> Data.Time.Clock.POSIX.getPOSIXTime | ||
122 | |||
123 | buildPacket :: KeyAlgorithm -> Word32 -> [(Char,MPI)] -> Packet | ||
124 | buildPacket alg stamp fields = | ||
125 | SecretKeyPacket { | ||
126 | timestamp = stamp :: Word32, | ||
127 | version = 4 :: Word8, | ||
128 | key_algorithm = alg :: KeyAlgorithm, | ||
129 | key = fields :: [(Char,MPI)], | ||
130 | s2k_useage = 0 :: Word8, | ||
131 | s2k = S2K 100 B.empty :: S2K, -- Unencrypted so meaningless | ||
132 | symmetric_algorithm = Unencrypted :: SymmetricAlgorithm, | ||
133 | encrypted_data = B.empty :: B.ByteString, | ||
134 | is_subkey = True :: Bool | ||
135 | } | ||
136 | |||
137 | defaultDSAParams :: Vincent.DSA.Params | ||
138 | defaultDSAParams = Vincent.DSA.Params | ||
139 | { Vincent.DSA.params_p = 25016032990684888518988658620325126146216470517049479187156156734213376906219942961707957641401749519947125090638800516836972123148009221755073642581464845387235660414348889382008154731058786820730247996611955465863529460612040002991075529989397271247177642048614532123132310296005749599675664384673629073848636519328677230918100996732661901275340454155565768752980771336725651539837887289446847136557589393348919689634715419500097585479277479066450412377941277218532943901492329509956866134692951999522393506140918443671786722258878778178444946544570489542640773262151888089794659117142339310858339721084998689009113 | ||
140 | , Vincent.DSA.params_q = 24289205633892182261673754417007225086255920651423805093223058502897 | ||
141 | , Vincent.DSA.params_g = 14163516289631370671608698837927753143825670852934869718450850658283442975416133481761559479714034401583801628224741616560126187810551733284361046143315226067355563227860282174889634742169280269622671773116176523712230772457681507357681374615558206405969011913182779829876763280507794583263187213066680289675392841938777384288859684653238393939307768899246590677720387825052549466445990058620838747851535777836897369521109616233955046301358290724806298742875429454780763259982037236610786647541183309285037036036778584959871753945456209439667132114356168289377762491848873534919083413137563924214401854434599021748980 | ||
142 | } | ||
143 | |||
diff --git a/openpgp-util.cabal b/openpgp-util.cabal index 516b0f4..debc84e 100644 --- a/openpgp-util.cabal +++ b/openpgp-util.cabal | |||
@@ -19,8 +19,6 @@ description: | |||
19 | Fingerprint generation, signature generation, signature verification, | 19 | Fingerprint generation, signature generation, signature verification, |
20 | and secret key decryption for OpenPGP Packets. | 20 | and secret key decryption for OpenPGP Packets. |
21 | . | 21 | . |
22 | It is indended to be used with <http://hackage.haskell.org/package/openpgp> | ||
23 | . | ||
24 | It is intended that you use qualified imports with this library. | 22 | It is intended that you use qualified imports with this library. |
25 | . | 23 | . |
26 | > import qualified Data.OpenPGP.Util as OpenPGP | 24 | > import qualified Data.OpenPGP.Util as OpenPGP |
@@ -129,6 +127,7 @@ library | |||
129 | Data.OpenPGP.Util.Base | 127 | Data.OpenPGP.Util.Base |
130 | Data.OpenPGP.Util.Verify | 128 | Data.OpenPGP.Util.Verify |
131 | Data.OpenPGP.Util.Sign | 129 | Data.OpenPGP.Util.Sign |
130 | Data.OpenPGP.Util.Gen | ||
132 | Data.OpenPGP.Util.DecryptSecretKey | 131 | Data.OpenPGP.Util.DecryptSecretKey |
133 | build-depends: | 132 | build-depends: |
134 | base == 4.*, | 133 | base == 4.*, |