diff --git a/RSA.cabal b/RSA.cabal --- a/RSA.cabal +++ b/RSA.cabal @@ -1,6 +1,6 @@ name: RSA category: Cryptography, Codec -version: 2.1.0.1 +version: 2.1.0.2 license: BSD3 license-file: LICENSE author: Adam Wick diff --git a/Test.hs b/Test.hs --- a/Test.hs +++ b/Test.hs @@ -6,6 +6,7 @@ import qualified Data.ByteString.Lazy as BS import qualified Data.Digest.Pure.MD5 as MD5 import Data.Digest.Pure.SHA +import System.IO import Test.QuickCheck import Crypto.Random import Crypto.Random.DRBG @@ -13,17 +14,26 @@ import Test.Framework (defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) +type KeyPairs = [(PublicKey, PrivateKey)] + +numRandomKeyPairs :: Int +numRandomKeyPairs = length keySizes * 2 + +keySizes :: [Int] +keySizes = [128,256,512,1024,2048,4096] + main :: IO () main = do - putStrLn "\nWARNING WARNING WARNING" - putStrLn "This test suite takes a very long time to run. If you're in a " - putStrLn "hurry, Control-C is your friend." - putStrLn "WARNING WARNING WARNING\n" + putStr "Generating testing keys ... " + hFlush stdout g :: GenAutoReseed HashDRBG HashDRBG <- newGenIO + let (keys, g') = buildRandomKeyPairs g (cycle keySizes) numRandomKeyPairs + unless (all ((> 5) . public_n . fst) keys) $ fail "Something odd." + putStrLn "done!" defaultMain [ testGroup "Random functions" [ - testProperty "RandomBS generates the right length" (prop_randomBSLen g) - , testProperty "RandomNZBS generates good data" (prop_randomNZBS g) + testProperty "RandomBS generates the right length" (prop_randomBSLen g') + , testProperty "RandomNZBS generates good data" (prop_randomNZBS g') ] , testGroup "Testing basic helper functions" [ testProperty "ByteString chunking works" prop_chunkifyWorks @@ -33,28 +43,37 @@ , testGroup "Testing RSA core functions" [ testProperty "Can roundtrip from Integer to BS and back" prop_i2o2iIdent , testProperty "Can roundtrip from BS to Integer and back" prop_o2i2oIdent - , testProperty "Can roundtrip RSA's EP and DP functions" prop_epDpIdent - , testProperty "Can roundtrip RSA's SP and VP functions" prop_spVpIdent + , testProperty "Can roundtrip RSA's EP and DP functions" + (prop_epDpIdent keys) + , testProperty "Can roundtrip RSA's SP and VP functions" + (prop_spVpIdent keys) ] , testGroup "Testing fixed-width RSA functions" [ - testProperty "RSA PKCS sign/verify works" prop_pkcsSignVerifies - , testProperty "RSA PKCS encrypt/decrypt works" (prop_pkcsInverts g) - , testProperty "RSA OAEP encrypt/decrypt works" (prop_oaepInverts g) - ] - , testGroup "Testing top-level, arbitrary-width RSA functions" [ - testProperty "Checking encrypt/decrypt roundtrips" (prop_encDec g) - , testProperty "Checking OAEP encrypt/decrypt roundtrips" (prop_encDecO g) - , testProperty "Checking PKCS encrypt/decrypt roundtrips" (prop_encDecP g) - , testProperty "Checking verify verifies sign" propSignVerifies + testProperty "RSA PKCS sign/verify works" + (prop_pkcsSignVerifies keys) + , testProperty "RSA PKCS encrypt/decrypt works" (prop_pkcsInverts keys g) + , testProperty "RSA OAEP encrypt/decrypt works" (prop_oaepInverts keys g) ] , testGroup "Testing top-level, arbitrary-width RSA functions" [ - testProperty "Checking encrypt/decrypt roundtrips" (prop_encDec g) - , testProperty "Checking OAEP encrypt/decrypt roundtrips" (prop_encDecO g) - , testProperty "Checking PKCS encrypt/decrypt roundtrips" (prop_encDecP g) - , testProperty "Checking verify verifies sign" propSignVerifies + testProperty "Checking encrypt/decrypt roundtrips" (prop_encDec keys g) + , testProperty "Checking OAEP encrypt/decrypt roundtrips" + (prop_encDecO keys g) + , testProperty "Checking PKCS encrypt/decrypt roundtrips" + (prop_encDecP keys g) + , testProperty "Checking verify verifies sign" (propSignVerifies keys) ] ] +buildRandomKeyPairs :: CryptoRandomGen g => g -> [Int] -> Int -> (KeyPairs, g) +buildRandomKeyPairs g _ 0 = ([], g) +buildRandomKeyPairs _ [] _ = error "The world has gone insane." +buildRandomKeyPairs g (keySize:rest) x = + case generateKeyPair g keySize of + Left _ -> error "Couldn't generate initial random key pairs! (1)" + Right (pub, priv, g') -> + let (acc, g'') = buildRandomKeyPairs g' rest (x - 1) + in ((pub, priv) : acc, g'') + -- -------------------------------------------------------------------------- instance Arbitrary ByteString where @@ -84,16 +103,11 @@ Left _ -> fail "Large prime generation failure." Right (i, _) -> return (LP i) -data KeyPair = KP PublicKey PrivateKey +data KeyPairIdx = KPI Int deriving (Show) -instance Arbitrary KeyPair where - arbitrary = - do keySize <- elements [128,256,512,1024,2048,4096] - Right (g :: HashDRBG) <- (newGen . BSS.pack) `fmap` replicateM 4096 arbitrary - case generateKeyPair g keySize of - Left _ -> fail "Random key generation failure." - Right (pub, priv, _) -> return (KP pub priv) +instance Arbitrary KeyPairIdx where + arbitrary = KPI `fmap` choose (0, numRandomKeyPairs - 1) data HashFun = HF String (ByteString -> ByteString) @@ -160,8 +174,10 @@ Left _ -> False Right bs' -> bs == bs' -prop_epDpIdent :: KeyPair -> Positive Integer -> Bool -prop_epDpIdent (KP pub priv) x = fromEither $ +prop_epDpIdent :: KeyPairs -> KeyPairIdx -> + Positive Integer -> + Bool +prop_epDpIdent kps (KPI idx) x = fromEither $ do let n = public_n pub e = public_e pub d = private_d priv @@ -169,9 +185,12 @@ ep <- rsa_ep n e m m' <- rsa_dp n d ep return (m == m') + where (pub, priv) = kps !! idx -prop_spVpIdent :: KeyPair -> Positive Integer -> Bool -prop_spVpIdent (KP pub priv) x = fromEither $ +prop_spVpIdent :: KeyPairs -> KeyPairIdx -> + Positive Integer -> + Bool +prop_spVpIdent kps (KPI idx) x = fromEither $ do let n = public_n pub e = public_e pub d = private_d priv @@ -179,77 +198,95 @@ sp <- rsa_sp1 n d m m' <- rsa_vp1 n e sp return (m == m') + where (pub, priv) = kps !! idx prop_oaepInverts :: CryptoRandomGen g => - g -> - HashFun -> KeyPair -> + KeyPairs -> g -> + HashFun -> KeyPairIdx -> ByteString -> ByteString -> Property -prop_oaepInverts g (HF _ hash) (KP pub priv) l m = wellSized ==> fromEither $ +prop_oaepInverts kps g (HF _ hash) (KPI idx) l m = wellSized ==> fromEither $ do let mgf = generateMGF1 hash (enc,_) <- rsaes_oaep_encrypt g hash mgf pub l m m' <- rsaes_oaep_decrypt hash mgf priv l enc return (m == m') where - hashLength = fromIntegral (BS.length (hash BS.empty)) - keySize = public_size pub - msgLength = fromIntegral (BS.length m) - wellSized = (msgLength <= (keySize - (2 * hashLength) - 2)) && (msgLength>0) + (pub, priv) = kps !! idx + hashLength = fromIntegral (BS.length (hash BS.empty)) + keySize = public_size pub + msgLength = fromIntegral (BS.length m) + wellSized = (msgLength <= (keySize - (2 * hashLength) - 2)) && (msgLength>0) prop_pkcsInverts :: CryptoRandomGen g => - g -> KeyPair -> ByteString -> + KeyPairs -> g -> KeyPairIdx -> + ByteString -> Property -prop_pkcsInverts g (KP pub priv) m = wellSized ==> fromEither $ +prop_pkcsInverts kps g (KPI idx) m = wellSized ==> fromEither $ do (enc,_) <- rsaes_pkcs1_v1_5_encrypt g pub m m' <- rsaes_pkcs1_v1_5_decrypt priv enc return (m == m') where - wellSized = (fromIntegral (BS.length m) < (public_size pub - 11)) && - (BS.length m > 0) + (pub, priv) = kps !! idx + wellSized = (fromIntegral (BS.length m) < (public_size pub - 11)) && + (BS.length m > 0) -prop_pkcsSignVerifies :: HashInfo -> KeyPair -> ByteString -> Property -prop_pkcsSignVerifies hash (KP pub priv) m = wellSized ==> fromEither $ +prop_pkcsSignVerifies :: KeyPairs -> KeyPairIdx -> + HashInfo -> ByteString -> + Property +prop_pkcsSignVerifies kps (KPI idx) hash m = wellSized ==> fromEither $ do sig <- rsassa_pkcs1_v1_5_sign hash priv m rsassa_pkcs1_v1_5_verify hash pub m sig where + (pub, priv) = kps !! idx wellSized = fromIntegral (public_size pub) > (algSize + hashLen + 1) algSize = BS.length (algorithmIdent hash) hashLen = BS.length (hashFunction hash BS.empty) -prop_encDec :: CryptoRandomGen g => g -> KeyPair -> ByteString -> Property -prop_encDec g (KP pub priv) m = wellSized ==> fromEither $ +prop_encDec :: CryptoRandomGen g => + KeyPairs -> g -> + KeyPairIdx -> ByteString -> + Bool +prop_encDec kps g (KPI idx) m = fromEither $ do (c, _) <- encrypt g pub m m' <- decrypt priv c return (m == m') - where wellSized = public_size pub > 66 + where (pub, priv) = findKeySized 66 kps idx prop_encDecO :: CryptoRandomGen g => - g -> HashFun -> KeyPair -> ByteString -> ByteString -> + KeyPairs -> g -> + HashFun -> KeyPairIdx -> ByteString -> ByteString -> Property -prop_encDecO g (HF _ hash) (KP pub priv) l m = wellSized ==> fromEither $ +prop_encDecO kps g (HF _ hash) (KPI idx) l m = wellSized ==> fromEither $ do (c, _) <- encryptOAEP g hash (generateMGF1 hash) l pub m m' <- decryptOAEP hash (generateMGF1 hash) l priv c return (m == m') where - hashLength = fromIntegral (BS.length (hash BS.empty)) - keySize = public_size pub - wellSized = (keySize - (2 * hashLength) - 2) > 0 + (pub, priv) = kps !! idx + hashLength = fromIntegral (BS.length (hash BS.empty)) + keySize = public_size pub + wellSized = (keySize - (2 * hashLength) - 2) > 0 prop_encDecP :: CryptoRandomGen g => - g -> KeyPair -> ByteString -> - Property -prop_encDecP g (KP pub priv) m = wellSized ==> fromEither $ + KeyPairs -> g -> KeyPairIdx -> ByteString -> + Bool +prop_encDecP kps g (KPI idx) m = fromEither $ do (c, _) <- encryptPKCS g pub m m' <- decryptPKCS priv c return (m == m') - where - wellSized = public_size pub > 11 + where (pub, priv) = findKeySized 11 kps idx -propSignVerifies :: KeyPair -> ByteString -> Property -propSignVerifies (KP pub priv) m = wellSized ==> fromEither $ +propSignVerifies :: KeyPairs -> KeyPairIdx -> ByteString -> Bool +propSignVerifies kps (KPI idx) m = fromEither $ do sig <- sign priv m verify pub m sig - where wellSized = public_size pub >= 64 + where (pub, priv) = findKeySized 64 kps idx + +findKeySized :: Int -> KeyPairs -> Int -> (PublicKey, PrivateKey) +findKeySized size kps idx = + let pair@(pub, _) = kps !! idx + in if public_size pub >= size + then pair + else findKeySized size kps ((idx + 1) `mod` length kps) -- --------------------------------------------------------------------------