From b556bdb6491915547d2213c10117062f11427d0a Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Mon, 30 Mar 2015 14:09:18 +0100 Subject: [PATCH] add missing modules --- Crypto/PubKey/RSA.hs | 52 -------------------------- Crypto/PubKey/RSA/OAEP.hs | 34 ++++++++--------- Crypto/PubKey/RSA/PKCS15.hs | 74 ++++++++++++++++++------------------- Crypto/PubKey/RSA/PSS.hs | 28 +++++++------- Crypto/PubKey/RSA/Prim.hs | 3 +- Crypto/PubKey/RSA/Types.hs | 60 ++++++++++++++++++++++++++++++ cryptonite.cabal | 4 ++ 7 files changed, 132 insertions(+), 123 deletions(-) diff --git a/Crypto/PubKey/RSA.hs b/Crypto/PubKey/RSA.hs index 381a110..f2749e3 100644 --- a/Crypto/PubKey/RSA.hs +++ b/Crypto/PubKey/RSA.hs @@ -5,7 +5,6 @@ -- Stability : experimental -- Portability : Good -- -{-# LANGUAGE DeriveDataTypeable #-} module Crypto.PubKey.RSA ( Error(..) , PublicKey(..) @@ -18,7 +17,6 @@ module Crypto.PubKey.RSA ) where import Data.Bits -import Data.Data import Data.Word import Control.Applicative import Crypto.Random.Types @@ -27,56 +25,6 @@ import Crypto.Number.Generate (generateMax) import Crypto.Number.Prime (generatePrime) import Crypto.PubKey.RSA.Types --- | Represent a RSA public key -data PublicKey = PublicKey - { public_size :: Int -- ^ size of key in bytes - , public_n :: Integer -- ^ public p*q - , public_e :: Integer -- ^ public exponant e - } deriving (Show,Read,Eq,Data,Typeable) - --- | Represent a RSA private key. --- --- Only the pub, d fields are mandatory to fill. --- --- p, q, dP, dQ, qinv are by-product during RSA generation, --- but are useful to record here to speed up massively --- the decrypt and sign operation. --- --- implementations can leave optional fields to 0. --- -data PrivateKey = PrivateKey - { private_pub :: PublicKey -- ^ public part of a private key (size, n and e) - , private_d :: Integer -- ^ private exponant d - , private_p :: Integer -- ^ p prime number - , private_q :: Integer -- ^ q prime number - , private_dP :: Integer -- ^ d mod (p-1) - , private_dQ :: Integer -- ^ d mod (q-1) - , private_qinv :: Integer -- ^ q^(-1) mod p - } deriving (Show,Read,Eq,Data,Typeable) - --- | get the size in bytes from a private key -private_size = public_size . private_pub - --- | get n from a private key -private_n = public_n . private_pub - --- | get e from a private key -private_e = public_e . private_pub - --- | Represent RSA KeyPair --- --- note the RSA private key contains already an instance of public key for efficiency -newtype KeyPair = KeyPair PrivateKey - deriving (Show,Read,Eq,Data,Typeable) - --- | Public key of a RSA KeyPair -toPublicKey :: KeyPair -> PublicKey -toPublicKey (KeyPair priv) = private_pub priv - --- | Private key of a RSA KeyPair -toPrivateKey :: KeyPair -> PrivateKey -toPrivateKey (KeyPair priv) = priv - -- some bad implementation will not serialize ASN.1 integer properly, leading -- to negative modulus. -- TODO : Find a better place for this diff --git a/Crypto/PubKey/RSA/OAEP.hs b/Crypto/PubKey/RSA/OAEP.hs index 9a80dd5..fe742cb 100644 --- a/Crypto/PubKey/RSA/OAEP.hs +++ b/Crypto/PubKey/RSA/OAEP.hs @@ -21,12 +21,11 @@ module Crypto.PubKey.RSA.OAEP , decryptSafer ) where -import Crypto.Random -import Crypto.Types.PubKey.RSA +import Crypto.Random.Types +import Crypto.PubKey.RSA.Types import Crypto.PubKey.HashDescr import Crypto.PubKey.MaskGenFunction import Crypto.PubKey.RSA.Prim -import Crypto.PubKey.RSA.Types import Crypto.PubKey.RSA (generateBlinder) import Crypto.PubKey.Internal (and') import Data.ByteString (ByteString) @@ -77,16 +76,17 @@ encryptWithSeed seed oaep pk msg em = B.concat [B.singleton 0x0,maskedSeed,maskedDB] -- | Encrypt a message using OAEP -encrypt :: CPRG g - => g -- ^ random number generator. - -> OAEPParams -- ^ OAEP params to use for encryption. +encrypt :: MonadRandom m + => OAEPParams -- ^ OAEP params to use for encryption. -> PublicKey -- ^ Public key. -> ByteString -- ^ Message to encrypt - -> (Either Error ByteString, g) -encrypt g oaep pk msg = (encryptWithSeed seed oaep pk msg, g') - where hashF = oaepHash oaep - hashLen = B.length (hashF B.empty) - (seed, g') = cprgGenerate hashLen g + -> m (Either Error ByteString) +encrypt oaep pk msg = do + seed <- getRandomBytes hashLen + return (encryptWithSeed seed oaep pk msg) + where + hashF = oaepHash oaep + hashLen = B.length (hashF B.empty) -- | un-pad a OAEP encoded message. -- @@ -141,11 +141,11 @@ decrypt blinder oaep pk cipher hashLen = B.length (hashF B.empty) -- | Decrypt a ciphertext using OAEP and by automatically generating a blinder. -decryptSafer :: CPRG g - => g -- ^ random number generator - -> OAEPParams -- ^ OAEP params to use for decryption +decryptSafer :: MonadRandom m + => OAEPParams -- ^ OAEP params to use for decryption -> PrivateKey -- ^ Private key -> ByteString -- ^ Cipher text - -> (Either Error ByteString, g) -decryptSafer rng oaep pk cipher = (decrypt (Just blinder) oaep pk cipher, rng') - where (blinder, rng') = generateBlinder rng (private_n pk) + -> m (Either Error ByteString) +decryptSafer oaep pk cipher = do + blinder <- generateBlinder (private_n pk) + return (decrypt (Just blinder) oaep pk cipher) diff --git a/Crypto/PubKey/RSA/PKCS15.hs b/Crypto/PubKey/RSA/PKCS15.hs index cc33fa4..29cbfe0 100644 --- a/Crypto/PubKey/RSA/PKCS15.hs +++ b/Crypto/PubKey/RSA/PKCS15.hs @@ -22,34 +22,33 @@ module Crypto.PubKey.RSA.PKCS15 , verify ) where -import Crypto.Random +import Crypto.Random.Types import Crypto.PubKey.Internal (and') -import Crypto.Types.PubKey.RSA +import Crypto.PubKey.RSA.Types import Data.ByteString (ByteString) import qualified Data.ByteString as B import Crypto.PubKey.RSA.Prim -import Crypto.PubKey.RSA.Types import Crypto.PubKey.RSA (generateBlinder) import Crypto.PubKey.HashDescr -- | This produce a standard PKCS1.5 padding for encryption -pad :: CPRG g => g -> Int -> ByteString -> Either Error (ByteString, g) -pad rng len m - | B.length m > len - 11 = Left MessageTooLong - | otherwise = - let (padding, rng') = getNonNullRandom rng (len - B.length m - 3) - in Right (B.concat [ B.singleton 0, B.singleton 2, padding, B.singleton 0, m ], rng') +pad :: MonadRandom m => Int -> ByteString -> m (Either Error ByteString) +pad len m + | B.length m > len - 11 = return (Left MessageTooLong) + | otherwise = do + padding <- getNonNullRandom (len - B.length m - 3) + return $ Right $ B.concat [ B.singleton 0, B.singleton 2, padding, B.singleton 0, m ] - where {- get random non-null bytes -} - getNonNullRandom :: CPRG g => g -> Int -> (ByteString, g) - getNonNullRandom g n = - let (bs0,g') = cprgGenerate n g - bytes = B.pack $ filter (/= 0) $ B.unpack $ bs0 - left = (n - B.length bytes) - in if left == 0 - then (bytes, g') - else let (bend, g'') = getNonNullRandom g' left - in (bytes `B.append` bend, g'') + where {- get random non-null bytes -} + getNonNullRandom :: MonadRandom m => Int -> m ByteString + getNonNullRandom n = do + bs0 <- getRandomBytes n + let bytes = B.pack $ filter (/= 0) $ B.unpack $ bs0 + left = n - B.length bytes + if left == 0 + then return bytes + else do bend <- getNonNullRandom left + return (bytes `B.append` bend) -- | Produce a standard PKCS1.5 padding for signature padSignature :: Int -> ByteString -> Either Error ByteString @@ -89,23 +88,23 @@ decrypt blinder pk c | otherwise = unpad $ dp blinder pk c -- | decrypt message using the private key and by automatically generating a blinder. -decryptSafer :: CPRG g - => g -- ^ random generator - -> PrivateKey -- ^ RSA private key +decryptSafer :: MonadRandom m + => PrivateKey -- ^ RSA private key -> ByteString -- ^ cipher text - -> (Either Error ByteString, g) -decryptSafer rng pk b = - let (blinder, rng') = generateBlinder rng (private_n pk) - in (decrypt (Just blinder) pk b, rng') + -> m (Either Error ByteString) +decryptSafer pk b = do + blinder <- generateBlinder (private_n pk) + return (decrypt (Just blinder) pk b) -- | encrypt a bytestring using the public key and a CPRG random generator. -- -- the message need to be smaller than the key size - 11 -encrypt :: CPRG g => g -> PublicKey -> ByteString -> (Either Error ByteString, g) -encrypt rng pk m = do - case pad rng (public_size pk) m of - Left err -> (Left err, rng) - Right (em, rng') -> (Right (ep pk em), rng') +encrypt :: MonadRandom m => PublicKey -> ByteString -> m (Either Error ByteString) +encrypt pk m = do + r <- pad (public_size pk) m + case r of + Left err -> return $ Left err + Right em -> return $ Right (ep pk em) -- | sign message using private key, a hash and its ASN1 description -- @@ -121,15 +120,14 @@ sign :: Maybe Blinder -- ^ optional blinder sign blinder hashDescr pk m = dp blinder pk `fmap` makeSignature hashDescr (private_size pk) m -- | sign message using the private key and by automatically generating a blinder. -signSafer :: CPRG g - => g -- ^ random generator - -> HashDescr -- ^ Hash descriptor +signSafer :: MonadRandom m + => HashDescr -- ^ Hash descriptor -> PrivateKey -- ^ private key -> ByteString -- ^ message to sign - -> (Either Error ByteString, g) -signSafer rng hashDescr pk m = - let (blinder, rng') = generateBlinder rng (private_n pk) - in (sign (Just blinder) hashDescr pk m, rng') + -> m (Either Error ByteString) +signSafer hashDescr pk m = do + blinder <- generateBlinder (private_n pk) + return (sign (Just blinder) hashDescr pk m) -- | verify message with the signed message verify :: HashDescr -> PublicKey -> ByteString -> ByteString -> Bool diff --git a/Crypto/PubKey/RSA/PSS.hs b/Crypto/PubKey/RSA/PSS.hs index 42ad20b..7007fba 100644 --- a/Crypto/PubKey/RSA/PSS.hs +++ b/Crypto/PubKey/RSA/PSS.hs @@ -16,8 +16,8 @@ module Crypto.PubKey.RSA.PSS , verify ) where -import Crypto.Random -import Crypto.Types.PubKey.RSA +import Crypto.Random.Types +import Crypto.PubKey.RSA.Types import Data.ByteString (ByteString) import Data.Byteable import qualified Data.ByteString as B @@ -78,25 +78,25 @@ signWithSalt salt blinder params pk m em = B.concat [maskedDB, h, B.singleton (pssTrailerField params)] -- | Sign using the PSS Parameters -sign :: CPRG g - => g -- ^ random generator to use to generate the salt - -> Maybe Blinder -- ^ optional blinder to use +sign :: MonadRandom m + => Maybe Blinder -- ^ optional blinder to use -> PSSParams -- ^ PSS Parameters to use -> PrivateKey -- ^ RSA Private Key -> ByteString -- ^ Message to sign - -> (Either Error ByteString, g) -sign rng blinder params pk m = (signWithSalt salt blinder params pk m, rng') - where (salt,rng') = cprgGenerate (pssSaltLength params) rng + -> m (Either Error ByteString) +sign blinder params pk m = do + salt <- getRandomBytes (pssSaltLength params) + return (signWithSalt salt blinder params pk m) -- | Sign using the PSS Parameters and an automatically generated blinder. -signSafer :: CPRG g - => g -- ^ random generator - -> PSSParams -- ^ PSS Parameters to use +signSafer :: MonadRandom m + => PSSParams -- ^ PSS Parameters to use -> PrivateKey -- ^ private key -> ByteString -- ^ message to sign - -> (Either Error ByteString, g) -signSafer rng params pk m = sign rng' (Just blinder) params pk m - where (blinder, rng') = generateBlinder rng (private_n pk) + -> m (Either Error ByteString) +signSafer params pk m = do + blinder <- generateBlinder (private_n pk) + sign (Just blinder) params pk m -- | Verify a signature using the PSS Parameters verify :: PSSParams -- ^ PSS Parameters to use to verify, diff --git a/Crypto/PubKey/RSA/Prim.hs b/Crypto/PubKey/RSA/Prim.hs index b0c42e0..26f38c2 100644 --- a/Crypto/PubKey/RSA/Prim.hs +++ b/Crypto/PubKey/RSA/Prim.hs @@ -14,8 +14,7 @@ module Crypto.PubKey.RSA.Prim ) where import Data.ByteString (ByteString) -import Crypto.PubKey.RSA.Types (Blinder(..)) -import Crypto.Types.PubKey.RSA +import Crypto.PubKey.RSA.Types import Crypto.Number.ModArithmetic (expFast, expSafe) import Crypto.Number.Serialize (os2ip, i2ospOf_) diff --git a/Crypto/PubKey/RSA/Types.hs b/Crypto/PubKey/RSA/Types.hs index 56b6c99..0af5ca0 100644 --- a/Crypto/PubKey/RSA/Types.hs +++ b/Crypto/PubKey/RSA/Types.hs @@ -5,11 +5,21 @@ -- Stability : experimental -- Portability : Good -- +{-# LANGUAGE DeriveDataTypeable #-} module Crypto.PubKey.RSA.Types ( Error(..) , Blinder(..) + , PublicKey(..) + , PrivateKey(..) + , KeyPair(..) + , private_size + , private_n + , private_e ) where +import Data.Data +import Data.Typeable + -- | Blinder which is used to obfuscate the timing -- of the decryption primitive (used by decryption and signing). data Blinder = Blinder !Integer !Integer @@ -24,3 +34,53 @@ data Error = | InvalidParameters -- ^ some parameters lead to breaking assumptions. deriving (Show,Eq) +-- | Represent a RSA public key +data PublicKey = PublicKey + { public_size :: Int -- ^ size of key in bytes + , public_n :: Integer -- ^ public p*q + , public_e :: Integer -- ^ public exponant e + } deriving (Show,Read,Eq,Data,Typeable) + +-- | Represent a RSA private key. +-- +-- Only the pub, d fields are mandatory to fill. +-- +-- p, q, dP, dQ, qinv are by-product during RSA generation, +-- but are useful to record here to speed up massively +-- the decrypt and sign operation. +-- +-- implementations can leave optional fields to 0. +-- +data PrivateKey = PrivateKey + { private_pub :: PublicKey -- ^ public part of a private key (size, n and e) + , private_d :: Integer -- ^ private exponant d + , private_p :: Integer -- ^ p prime number + , private_q :: Integer -- ^ q prime number + , private_dP :: Integer -- ^ d mod (p-1) + , private_dQ :: Integer -- ^ d mod (q-1) + , private_qinv :: Integer -- ^ q^(-1) mod p + } deriving (Show,Read,Eq,Data,Typeable) + +-- | get the size in bytes from a private key +private_size = public_size . private_pub + +-- | get n from a private key +private_n = public_n . private_pub + +-- | get e from a private key +private_e = public_e . private_pub + +-- | Represent RSA KeyPair +-- +-- note the RSA private key contains already an instance of public key for efficiency +newtype KeyPair = KeyPair PrivateKey + deriving (Show,Read,Eq,Data,Typeable) + +-- | Public key of a RSA KeyPair +toPublicKey :: KeyPair -> PublicKey +toPublicKey (KeyPair priv) = private_pub priv + +-- | Private key of a RSA KeyPair +toPrivateKey :: KeyPair -> PrivateKey +toPrivateKey (KeyPair priv) = priv + diff --git a/cryptonite.cabal b/cryptonite.cabal index f096496..86af9dc 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -69,6 +69,10 @@ Library Crypto.PubKey.ECC.ECDSA Crypto.PubKey.ECC.Types Crypto.PubKey.RSA + Crypto.PubKey.RSA.PKCS15 + Crypto.PubKey.RSA.Prim + Crypto.PubKey.RSA.PSS + Crypto.PubKey.RSA.OAEP Crypto.PubKey.RSA.Types Crypto.Random Crypto.Random.Types