From 7909c13a18e260af68819be7444829f799cb7c38 Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Fri, 26 Aug 2016 01:21:22 -0400
Subject: WIP: support for cryptonite.

---
 Data/OpenPGP/Util/Gen.hs | 67 ++++++++++++++++++++++++------------------------
 1 file changed, 33 insertions(+), 34 deletions(-)

(limited to 'Data/OpenPGP/Util/Gen.hs')

diff --git a/Data/OpenPGP/Util/Gen.hs b/Data/OpenPGP/Util/Gen.hs
index b64517f..c5d0159 100644
--- a/Data/OpenPGP/Util/Gen.hs
+++ b/Data/OpenPGP/Util/Gen.hs
@@ -8,13 +8,17 @@ import Control.Applicative
 import qualified Data.ByteString.Lazy as B
 import qualified Data.ByteString as S
 
-import qualified Crypto.Random as Vincent
+import 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
+#if defined(VERSION_cryptonite)
+import Control.Arrow (second)
+import Data.Binary
+#endif
 
-import qualified Data.Time.Clock.POSIX
+import Data.OpenPGP.Util.Base
 
 data GenerateKeyParams = GenRSA Int -- keysize
                        | GenDSA (Maybe DSAParams)
@@ -34,20 +38,10 @@ 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)
+    now <- currentTime
+    g <- makeGen Nothing
+    let (fields,g') = generateKey' params g
+    return $ buildPacket (genKeyAlg params) now fields
 
 rsaFields priv = [ ('n', MPI $ Vincent.RSA.public_n (Vincent.RSA.private_pub priv))
                  , ('e', MPI $ Vincent.RSA.public_e (Vincent.RSA.private_pub priv))
@@ -66,6 +60,17 @@ dsaFields priv = [ ('p', MPI p)
     g = Vincent.DSA.params_g $ Vincent.DSA.private_params priv
     p = Vincent.DSA.params_p $ Vincent.DSA.private_params priv
 
+
+#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)
+
 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
@@ -93,33 +98,27 @@ makeGen :: Maybe FilePath -> IO RNG
 makeGen noisefile = do
     drg <- fromMaybe (Left <$> getSystemDRG) $ do
         path <- noisefile 
-        Just $ Right . drgNewTest . decodeSeed <$> L.readFile path
+        Just $ Right . drgNewTest . decodeSeed <$> B.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
+    decodeSeed :: B.ByteString -> (Word64, Word64, Word64, Word64, Word64)
+    decodeSeed bs | B.null bs = (0,0,0,0,0)
+                  | otherwise = decode $  B.cycle bs
 
-generateKey' :: GenerateKeyParams -> RNG -> (PrivateKey,RNG)
+generateKey' :: GenerateKeyParams -> RNG -> ([(Char,MPI)],RNG)
 generateKey' (GenRSA keysize) g =
     let rsa_exponent = 65537
-        ((_,priv),g') = withDRG g $ RSA.generate keysize rsa_exponent
-    in ( PrivateRSA priv, g' )
+        ((_,priv),g') = withDRG g $ Vincent.RSA.generate keysize rsa_exponent
+    in ( rsaFields 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' )
+    let dsa_params = maybe defaultDSAParams vincent mbparams
+        vincent (DSAParams p g q) = Vincent.DSA.Params p g q
+        (priv,g') = withDRG g $ Vincent.DSA.generatePrivate dsa_params
+    in ( dsaFields (Vincent.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 =
@@ -133,7 +132,7 @@ buildPacket alg stamp fields =
         symmetric_algorithm = Unencrypted :: SymmetricAlgorithm,
         encrypted_data = B.empty          :: B.ByteString,
         is_subkey = True                  :: Bool
-	  }
+      }
 
 defaultDSAParams :: Vincent.DSA.Params
 defaultDSAParams = Vincent.DSA.Params
-- 
cgit v1.2.3