{-# LANGUAGE CPP #-}
module Data.OpenPGP.Util.Gen where

import Data.OpenPGP
import Data.Maybe
import Data.Word
import Control.Applicative
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString as S

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 qualified Crypto.PubKey.Curve25519 as Cv25519
import qualified Crypto.PubKey.Ed25519 as Ed25519
import Data.OpenPGP.Util.Cv25519
import Data.OpenPGP.Util.Ed25519
import Control.Arrow (second)
import Data.Binary
#endif

import Data.OpenPGP.Util.Base

data GenerateKeyParams = GenRSA Int -- keysize
                       | GenDSA (Maybe DSAParams)
                       | GenEd25519
                       | GenCv25519
 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
genKeyAlg (GenEd25519 {}) = Ed25519
genKeyAlg (GenCv25519 {}) = ECC

-- | Generate a secret key pgp packet from system entropy.
generateKey :: GenerateKeyParams -> IO Packet
generateKey params = do
    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))
                 , ('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


#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
        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 <$> B.readFile path
    return $ RNG drg
 where
    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 -> ([(Char,MPI)],RNG)
generateKey' (GenRSA keysize) g =
    let rsa_exponent = 65537
        ((_,priv),g') = withDRG g $ Vincent.RSA.generate keysize rsa_exponent
    in ( rsaFields priv, g' )
generateKey' (GenDSA mbparams) 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' )
generateKey' (GenEd25519 {}) g = withDRG g $ do
    k <- Ed25519.generateSecretKey
    return $ importSecretEd25519 k
generateKey' (GenCv25519 {}) g = withDRG g $ do
    k <- Cv25519.generateSecretKey
    return $ importSecretCv25519 SHA512 AES128 k


#endif



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
        aead_algorithm = Nothing          :: Maybe AEADAlgorithm,
        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
    }