RSA 2.1.0.1 → 2.1.0.2
raw patch · 2 files changed
+100/−63 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
RSA.cabal view
@@ -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 <awick@galois.com>
Test.hs view
@@ -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) -- --------------------------------------------------------------------------