diff --git a/Codec/Crypto/RSA.hs b/Codec/Crypto/RSA.hs deleted file mode 100644 --- a/Codec/Crypto/RSA.hs +++ /dev/null @@ -1,701 +0,0 @@ -{-# LANGUAGE CPP #-} - --- |An implementation of RSA (PKCS #1) Cryptography, as described by the --- RSA standard and RFC 3447. -module Codec.Crypto.RSA( - -- * Keys and key generations - generateKeyPair - , PrivateKey - , PublicKey - -- * High-level encryption and signing functions - , encrypt - , decrypt - , sign - , verify - , EncryptionOptions(..) - , encrypt' - , decrypt' - -- * Core OAEP Routines - , MGF - , rsaes_oaep_encrypt - , rsaes_oaep_decrypt - , generate_MGF1 - -- * Core PSS Routines - -- $pss - - -- * Core PKCS1 (v1.5) Routines - , rsaes_pkcs1_v1_5_encrypt - , rsaes_pkcs1_v1_5_decrypt - , rsassa_pkcs1_v1_5_sign - , rsassa_pkcs1_v1_5_verify - -- * Hashing algorithm declarations for use in RSA functions - , HashFunction - , HashInfo(..) -#ifdef INCLUDE_MD5 - , ha_MD5 -#endif - , ha_SHA1, ha_SHA256, ha_SHA384, ha_SHA512 -#ifdef RSA_TEST - , large_random_prime - , generate_pq - , chunkify - , os2ip, i2osp - , rsa_dp, rsa_ep - , rsa_vp1, rsa_sp1 - , modular_inverse - , modular_exponentiation -#endif - ) - where - -import Data.Bits -import Data.ByteString.Lazy(ByteString) -import qualified Data.ByteString.Lazy as BS -import Data.Digest.Pure.SHA -import Data.Int -import Data.Word -import Crypto.Random -import Crypto.Types.PubKey.RSA -import Control.Monad.CryptoRandom - -#ifdef USE_BINARY -import Data.Binary -import Data.Binary.Put -import Data.Binary.Get -#endif - -#ifdef INCLUDE_MD5 -import Data.Digest.Pure.MD5 -#endif - -#ifdef USE_BINARY -instance Binary PublicKey where - put pk = do putLazyByteString $ i2osp (public_size pk) 8 - putLazyByteString $ i2osp (public_n pk) (public_size pk) - get = do len <- (fromIntegral . os2ip) `fmap` getLazyByteString 8 - n <- os2ip `fmap` getLazyByteString len - return $ PublicKey (fromIntegral len) n 65537 - -instance Binary PrivateKey where - put pk = do put (private_pub pk) - putLazyByteString $ i2osp (private_d pk) (public_size $ private_pub pk) - get = do pub <- get - d <- os2ip `fmap` getLazyByteString (fromIntegral $ public_size pub) - return $ PrivateKey { private_pub = pub - , private_d = d - , private_p = 0 - , private_q = 0 - , private_qinv = 0 - , private_dP = 0 - , private_dQ = 0 } -#endif - -type HashFunction = ByteString -> ByteString -data HashInfo = HashInfo { - algorithmIdent :: ByteString -- ^The ASN.1 DER encoding - -- of the hash function - -- identifier. - , hashFunction :: HashFunction -- ^The hash function. - } - --- |A 'mask generation function'. The input is a bytestring, and the output --- is a hash of the given length. Unless you know what you're doing, you --- should probably use a MGF1 formulation created with generate_MGF1. -type MGF = ByteString -> Int64 -> ByteString - --- -------------------------------------------------------------------------- --- --- EASY TO USE PUBLIC FUNCTIONS --- --- -------------------------------------------------------------------------- - --- |Randomly generate a key pair of the given modulus length (in bits) to --- use in any of the following functions. Use of a good random number --- generator is of considerable importance when using this function; the --- input CryptoRandomGen should never be used again for any other purpose. -generateKeyPair :: CryptoRandomGen g => g -> Int -> (PublicKey, PrivateKey, g) -generateKeyPair g sizeBits = (publicKey, privateKey, g') - where - kLen = fromIntegral $ sizeBits `div` 8 - (p, q, g') = generate_pq g kLen - n = p * q - phi = (p - 1) * (q - 1) - e = 65537 - d = modular_inverse e phi - publicKey = PublicKey kLen n e - privateKey = PrivateKey { private_pub = publicKey - , private_d = d - , private_p = 0 - , private_q = 0 - , private_qinv = 0 - , private_dP = 0 - , private_dQ = 0 } - -data EncryptionOptions = - UseOAEP { - -- |The hash function to use. - oaep_hash :: HashFunction - -- |The mask generation function to use. - , oaep_mgf :: MGF - -- |The label to annotate items with. - , oaep_label :: ByteString - } - | UsePKCS1_v1_5 - -instance Show EncryptionOptions where - show opt@UseOAEP{} = "" - where hashLen = BS.length $ oaep_hash opt BS.empty - show UsePKCS1_v1_5 = "" - --- |Encrypt an arbitrarily-sized message using the defaults for RSA --- encryption (specifically, using MGF1, SHA-256 as the hash --- function, and not adding a label). If the message is longer than the --- underlying encryption function can support, it is broken up into parts --- and each part is encrypted. -encrypt :: CryptoRandomGen g => g -> PublicKey -> ByteString -> (ByteString, g) -encrypt = encrypt' (UseOAEP sha256' (generate_MGF1 sha256') BS.empty) - --- |Decrypt an arbitrarily-sized message using the defaults for RSA --- decryption (specifically, using MGF1, SHA-256 as the hash function, --- and not adding a label). If the message is longer than the underlying --- decryption function supports, it is assumed that the message was --- generated by concatenating a series of blocks. --- --- While the encryption function, above, can take an arbitrarily-sized --- message, this function cannot. The message passed must be a multiple --- of the modulus length. -decrypt :: PrivateKey -> ByteString -> ByteString -decrypt = decrypt' (UseOAEP sha256' (generate_MGF1 sha256') BS.empty) - --- |Compute a signature for the given ByteString, using the SHA256 algorithm --- in the computation. This is currently defined as rsassa_pkcs1_v1_5_sign --- ha_SHA256. If you want to use a different function, simply use the pkcs --- function, below; it will accept arbitrary-length messages. -sign :: PrivateKey -> ByteString -> ByteString -sign = rsassa_pkcs1_v1_5_sign ha_SHA256 - --- |Verity a signature for the given ByteString, using the SHA256 algorithm --- in the computation. Again, if you'd like to use a different algorithm, --- use the rsassa_pkcs1_v1_5_verify function. --- --- The first bytestring is the message, the second is the signature to check. -verify :: PublicKey -> ByteString -> ByteString -> Bool -verify = rsassa_pkcs1_v1_5_verify ha_SHA256 - --- |Encrypt an arbitrarily-sized message using the given options. -encrypt' :: CryptoRandomGen g => - EncryptionOptions -> g -> PublicKey -> ByteString -> - (ByteString, g) -encrypt' (UseOAEP hash mgf l) gen pub m = foldl enc1 (BS.empty, gen) chunks - where - hLen = BS.length $ hash BS.empty - chunkSize = (fromIntegral $ public_size pub) - (2 * hLen) - 2 - chunks = chunkify chunkSize m - enc1 (!res, !g) !cur = let !(!newc,!g') = rsaes_oaep_encrypt g hash mgf pub l cur - in (res `BS.append` newc, g') -encrypt' UsePKCS1_v1_5 gen pub m = foldl enc1 (BS.empty, gen) chunks - where - chunkSize = public_size pub - 11 - chunks = chunkify (fromIntegral chunkSize) m - enc1 (!res, !g) !cur = let (!newc, g')=rsaes_pkcs1_v1_5_encrypt g pub cur - in (res `BS.append` newc, g') - --- |Decrypt an arbitrarily-sized message using the given options. Well, sort --- of arbitrarily sized; the message should be a multiple of the modulus --- length. -decrypt' :: EncryptionOptions -> PrivateKey -> ByteString -> ByteString -decrypt' opts priv cipher = BS.concat $ map decryptor chunks - where - chunks = chunkify (fromIntegral $ private_size priv) cipher - decryptor = case opts of - UseOAEP hash mgf l -> rsaes_oaep_decrypt hash mgf priv l - UsePKCS1_v1_5 -> rsaes_pkcs1_v1_5_decrypt priv - --- -------------------------------------------------------------------------- --- --- EXPORTED FUNCTIONS FROM THE SPEC --- --- -------------------------------------------------------------------------- - --- |The generalized implementation of RSAES-OAEP-ENCRYPT. Using the default --- instantiontion of this, provided by the 'encrypt' function, is a pretty --- good plan if this makes no sense to you, as it is instantiated with --- reasonable defaults. --- --- The arguments to this function are, in order: the hash function to use, --- the mask generation function (MGF), the recipient's RSA public key, a --- random seed, a label to associate with the message, and the message to --- be encrypted. --- --- The message to be encrypted may not be longer then (k - 2*hLen - 2), --- where k is the length of the RSA modulus in bytes and hLen is the length --- of a hash in bytes. Passing in a larger message will generate an error. --- --- I have not put in a check for the length of the label, because I don't --- expect you to use more than 2^32 bytes. So don't make me regret that, eh? --- -rsaes_oaep_encrypt :: CryptoRandomGen g => g -> HashFunction -> MGF -> - PublicKey -> ByteString -> ByteString -> - (ByteString,g) -rsaes_oaep_encrypt g hash mgf k l m - | message_too_long = error "message too long (rsaes_oaep_encrypt)" - | otherwise = (c,g') - where - mLen = BS.length m -- Int64 - hLen = BS.length $ hash BS.empty -- Int64 - kLen = fromIntegral $ public_size k - (seedStrict,g') = throwLeft $ genBytes (fromIntegral hLen) g - seed = BS.fromChunks [seedStrict] - -- Step 1 - message_too_long = mLen > (kLen - (2 * hLen) - 2) - -- Step 2 - lHash = hash l - ps = BS.take (kLen - mLen - (2 * hLen) - 2) (BS.repeat 0) - db = BS.concat [lHash, ps, BS.singleton 1, m] - dbMask = mgf seed (kLen - hLen - 1) - maskedDB = db `xorBS` dbMask - seedMask = mgf maskedDB hLen - maskedSeed = seed `xorBS` seedMask - em = BS.concat [BS.singleton 0, maskedSeed, maskedDB] - -- Step 3 - m_ip = os2ip em - c_ip = rsa_ep (public_n k) (public_e k) m_ip - c = i2osp c_ip (fromIntegral kLen) - --- |The generalized implementation of RSAES-OAEP-DECRYPT. Again, 'decrypt' --- initializes this with a pretty good set of defaults if you don't understand --- what all of the arguments involve. --- --- The ciphertext message passed to this function must be k bytes long, where --- k is the size of the modulus in bytes. If it is not, this function will --- generate an error. --- --- Futher, k (the length of the ciphertext in bytes) must be greater than or --- equal to (2 * hLen + 2), where hLen is the length of the output of the --- hash function in bytes. If this equation does not hold, a (different) --- error will be generated. --- --- Finally, there are any number of internal situations that may generate --- an error indicating that decryption failed. --- --- The arguments to this function are the hash function to use, the mask --- generation function (MGF), the recipient's private key, the optional --- label whose association with this message should be verified, and the --- ciphertext message. --- -rsaes_oaep_decrypt :: HashFunction -> MGF -> - PrivateKey -> ByteString -> ByteString -> - ByteString -rsaes_oaep_decrypt hash mgf k l c - | bad_message_len = error "message too short" - | bad_hash_len = error "bad hash length" - | signal_error = error $ "decryption error " ++ (show $ BS.any (/= 1) one) ++ " " ++ (show $ lHash /= lHash') ++ " " ++ (show $ BS.any (/= 0) y) - | otherwise = m - where - hLen = BS.length $ hash BS.empty - kLen = private_size k - -- Step 1 - bad_message_len = BS.length c /= fromIntegral kLen - bad_hash_len = fromIntegral kLen < ((2 * hLen) + 2) - -- Step 2 - c_ip = os2ip c - m_ip = rsa_dp (private_n k) (private_d k) c_ip - em = i2osp m_ip kLen - -- Step 3 - lHash = hash l - (y, msandmdb) = BS.splitAt 1 em - (maskedSeed, maskedDB) = BS.splitAt hLen msandmdb - seedMask = mgf maskedDB hLen - seed = maskedSeed `xorBS` seedMask - dbMask = mgf seed (fromIntegral kLen - hLen - 1) - db = maskedDB `xorBS` dbMask - (lHash', ps1m) = BS.splitAt hLen db - one_m = BS.dropWhile (== 0) ps1m - (one, m) = BS.splitAt 1 one_m - -- Error Checking - signal_error = (BS.any (/= 1) one) || (lHash /= lHash') || (BS.any (/= 0) y) - --- |Implements RSAES-PKCS1-v1.5-Encrypt, as defined by the spec, for --- completeness and possible backward compatibility. Also because I've already --- written everything else, so why not? --- --- This encryption / padding mechanism has several known attacks, which are --- described in the literature. So unless you absolutely need to use this --- for some historical reason, you shouldn't. --- --- The message to be encrypted must be less then or equal to (k - 11) bytes --- long, where k is the length of the key modulus in bytes. --- --- Because this function uses an unknown amount of randomly-generated data, --- it takes an instance of RandomGen rather than taking a random number as --- input, and returns the resultant generator as output. You should take care --- that you (a) do not reuse the input generator, thus losing important --- randomness, and (b) choose a decent instance of RandomGen for passing to --- this function. --- -rsaes_pkcs1_v1_5_encrypt :: CryptoRandomGen g => - g -> PublicKey -> ByteString -> - (ByteString, g) -rsaes_pkcs1_v1_5_encrypt rGen k m - | message_too_long = error "message too long" - | otherwise = (c, rGen') - where - mLen = fromIntegral $ BS.length m - kLen = public_size k - -- Step 1 - message_too_long = mLen > (kLen - 11) - -- Step2 - (ps, rGen') = generate_random_bytestring rGen (kLen - mLen - 3) - em = BS.concat [BS.singleton 0, BS.singleton 2, ps, - BS.singleton 0, m] - m' = os2ip em - c_i = rsa_ep (public_n k) (public_e k) m' - c = i2osp c_i kLen - --- |Implements RSAES-PKCS1-v1.5-Decrypt, as defined by the spec, for --- completeness and possible backward compatibility. Please see the notes --- for rsaes_pkcs1_v1_5_encrypt regarding use of this function in new --- applications without historical algorithm requirements --- --- The ciphertext message passed to this function must be of length k, --- where k is the length of the key modulus in bytes. --- -rsaes_pkcs1_v1_5_decrypt :: PrivateKey -> ByteString -> ByteString -rsaes_pkcs1_v1_5_decrypt k c - | wrong_size = error "message size incorrect" - | signal_error = error "decryption error" - | otherwise = m - where - mLen = fromIntegral $ BS.length c - kLen = private_size k - -- Step 1 - wrong_size = mLen /= kLen - -- Step 2 - c_i = os2ip c - m_i = rsa_dp (private_n k) (private_d k) c_i - em = i2osp m_i kLen - -- Step 3 - (zt, ps0m) = BS.splitAt 2 em - (ps, zm) = BS.span (/= 0) ps0m - (z, m) = BS.splitAt 1 zm - -- Step 4 - signal_error = (BS.unpack zt /= [0, 2]) || (BS.unpack z /= [0]) || - (BS.length ps < 8) - - --- $pss --- |RSASSA-PSS-Sign, RSASSA-PSS-Verify, and the related functions are not --- included because they are covered by U.S. Patent 7036014, and it's not --- clear what the restrictions on implementations are. - --- |Generates a signature for the given message using the given private --- key. This is obviously based on RSASSA-PKCS1-v1.5-Sign from the --- specification. Note that in researching what was required for this --- project, several independent sources suggested not using the same --- key across sign/validate and encrypt/decrypt contexts. --- --- The output of this function is the signature only, not the message and --- signature. --- -rsassa_pkcs1_v1_5_sign :: HashInfo -> PrivateKey -> ByteString -> ByteString -rsassa_pkcs1_v1_5_sign hi k m = sig - where - kLen = private_size k - -- - em = emsa_pkcs1_v1_5_encode hi m kLen - m_i = os2ip em - s = rsa_sp1 (private_n k) (private_d k) m_i - sig = i2osp s kLen - --- |Validates a signature for the given message using the given public --- key. The arguments are, in order: the hash function to use, the public key, --- the message, and the signature. The signature must be exactly k bytes long, --- where k is the size of the RSA modulus in bytes. -rsassa_pkcs1_v1_5_verify :: HashInfo -> PublicKey -> - ByteString -> ByteString -> - Bool -rsassa_pkcs1_v1_5_verify hi k m s - | bad_size = False - | otherwise = res - where - kLen = public_size k - -- Step 1 - bad_size = BS.length s /= fromIntegral kLen - -- Step 2 - s_i = os2ip s - m_i = rsa_vp1 (public_n k) (public_e k) s_i - em = i2osp m_i kLen - -- Step 3 - em' = emsa_pkcs1_v1_5_encode hi m kLen - -- Step 4 - res = em == em' - --- |Generate a mask generation function for the rsaes_oaep_*. As --- suggested by the name, the generated function is an instance of the MGF1 --- function. The arguments are the underlying hash function to use and the --- size of a hash in bytes. --- --- The bytestring passed to the generated function cannot be longer than --- 2^32 * hLen, where hLen is the passed length of the hash. -generate_MGF1 :: HashFunction -> MGF -generate_MGF1 hash mgfSeed maskLen - | BS.length mgfSeed > ((2 ^ (32::Int)) * hLen) = error "mask too long" - | otherwise = loop BS.empty 0 - where - hLen = BS.length $ hash BS.empty - end_counter = (maskLen `divCeil` hLen) - 1 - loop t counter - | counter > end_counter = BS.take maskLen t - | otherwise = let c = i2osp counter 4 - bs = mgfSeed `BS.append` c - t' = t `BS.append` hash bs - in loop t' (counter + 1) - --- -------------------------------------------------------------------------- --- --- HASH FUNCTIONS AND IDENTIFIERS --- --- -------------------------------------------------------------------------- - -#ifdef INCLUDE_MD5 -ha_MD5 :: HashInfo -ha_MD5 = HashInfo { - algorithmIdent = BS.pack [0x30,0x20,0x30,0x0c,0x06,0x08,0x2a,0x86,0x48, - 0x86,0xf7,0x0d,0x02,0x05,0x05,0x00,0x04,0x10] - , hashFunction = encode . md5 - } -#endif - -ha_SHA1 :: HashInfo -ha_SHA1 = HashInfo { - algorithmIdent = BS.pack [0x30,0x21,0x30,0x09,0x06,0x05,0x2b,0x0e,0x03, - 0x02,0x1a,0x05,0x00,0x04,0x14] - , hashFunction = bytestringDigest . sha1 - } - -ha_SHA256 :: HashInfo -ha_SHA256 = HashInfo { - algorithmIdent = BS.pack [0x30,0x31,0x30,0x0d,0x06,0x09,0x60,0x86,0x48, - 0x01,0x65,0x03,0x04,0x02,0x01,0x05,0x00,0x04, - 0x20] - , hashFunction = bytestringDigest . sha256 - } - -ha_SHA384 :: HashInfo -ha_SHA384 = HashInfo { - algorithmIdent = BS.pack [0x30,0x41,0x30,0x0d,0x06,0x09,0x60,0x86,0x48, - 0x01,0x65,0x03,0x04,0x02,0x02,0x05,0x00,0x04, - 0x30] - , hashFunction = bytestringDigest . sha384 - } - -ha_SHA512 :: HashInfo -ha_SHA512 = HashInfo { - algorithmIdent = BS.pack [0x30,0x51,0x30,0x0d,0x06,0x09,0x60,0x86,0x48, - 0x01,0x65,0x03,0x04,0x02,0x03,0x05,0x00,0x04, - 0x40] - , hashFunction = bytestringDigest . sha512 - } - -sha256' :: HashFunction -sha256' = bytestringDigest . sha256 - --- -------------------------------------------------------------------------- --- --- INTERNAL FUNCTIONS FROM THE SPEC --- --- -------------------------------------------------------------------------- - --- "i2osp converts a nonnegative integer to an octet string of a specified --- length" -- RFC 3447 -i2osp :: Integral a => a -> Int -> ByteString -i2osp x len | isTooLarge = error "RSA internal error: integer too large" - | otherwise = padding `BS.append` digits - where - isTooLarge = xAsInt >= (256 ^ lenAsInt) - xAsInt, lenAsInt :: Integer - xAsInt = fromIntegral x - lenAsInt = fromIntegral len - -- - padding = BS.replicate (fromIntegral len - BS.length digits) 0 - digits = BS.pack $ reverse $ digits256 x - digits256 v - | v <= 255 = [fromIntegral v] - | otherwise = (fromIntegral $ v `mod` 256) : (digits256 $ v `div` 256) - --- 'osp2i converts an octet string to a nonnegative integer' - RFC 3447 -os2ip :: ByteString -> Integer -os2ip x = BS.foldl (\ a b -> (256 * a) + (fromIntegral b)) 0 x - --- the RSA encryption function -rsa_ep :: Integer -> Integer -> Integer -> Integer -rsa_ep n _ m | (m < 0) || (m >= n) = error "message representative out of range" -rsa_ep n e m = modular_exponentiation m e n -- (m ^ e) `mod` n - --- the RSA decryption function -rsa_dp :: Integer -> Integer -> Integer -> Integer -rsa_dp n _ c | (c < 0) || (c >= n) = error "ciphertext rep out of range" -rsa_dp n d c = modular_exponentiation c d n -- (c ^ d) `mod` n - --- the rsa signature generation function -rsa_sp1 :: Integer -> Integer -> Integer -> Integer -rsa_sp1 n d m - | (m < 0) || (m >= n) = error "message representative out of range" - | otherwise = modular_exponentiation m d n -- (m ^ d) `mod` n - --- the rsa signature verification function -rsa_vp1 :: Integer -> Integer -> Integer -> Integer -rsa_vp1 n e s - | (s < 0) || (s >= n) = error "signature representative out of range" - | otherwise = modular_exponentiation s e n -- (s ^ e) `mod` n - -emsa_pkcs1_v1_5_encode :: HashInfo -> ByteString -> Int -> ByteString -emsa_pkcs1_v1_5_encode (HashInfo hash_ident hash) m emLen - | (fromIntegral emLen) < (tLen + 1) = error "intended encoded message length too short" - | otherwise = em - where - h = hash m - t = hash_ident `BS.append` h - tLen = BS.length t - ps = BS.replicate (fromIntegral emLen - tLen - 3) 0xFF - em = BS.concat [BS.singleton 0x00, BS.singleton 0x01, ps, - BS.singleton 0x00, t] - --- -------------------------------------------------------------------------- --- --- HANDY HELPER FUNCTIONS --- --- -------------------------------------------------------------------------- - --- Perform XOR on every byte in the two bytestrings. -xorBS :: ByteString -> ByteString -> ByteString -xorBS bs1 bs2 = BS.pack $ BS.zipWith xor bs1 bs2 - --- Split a ByteString into chunks of this size or less. -chunkify :: Int64 -> ByteString -> [ByteString] -chunkify len bstr - | BS.length bstr <= len = [bstr] - | otherwise = (BS.take len bstr):(chunkify len $ BS.drop len bstr) - -generate_random_bytestring :: CryptoRandomGen g => g -> Int -> (ByteString, g) -generate_random_bytestring g 0 = (BS.empty, g) -generate_random_bytestring g x = (BS.cons' first rest, g'') - where - (rest, g') = generate_random_bytestring g (x - 1) - (first, g'') = throwLeft $ crandomR (1,255) g' - --- Divide a by b, rounding towards positive infinity. -divCeil :: Integral a => a -> a -> a -divCeil a b = - let (q, r) = divMod a b - in if r /= 0 then (q + 1) else q - --- Generate p and q. This is not necessarily the best way to do this, but the --- ANSI standard dealing with this cost money, and I was in a hurry. -generate_pq :: CryptoRandomGen g => g -> Int -> (Integer, Integer, g) -generate_pq g len - | len < 2 = error "length to short for generate_pq" - | p == q = generate_pq g'' len - | otherwise = (p, q, g'') - where - (baseP, g') = large_random_prime g (len `div` 2) - (baseQ, g'') = large_random_prime g' (len - (len `div` 2)) - (p, q) = if baseP < baseQ then (baseQ, baseP) else (baseP, baseQ) - -large_random_prime :: CryptoRandomGen g => g -> Int -> (Integer, g) -large_random_prime g len = (prime, g''') - where - ([startH, startT], g') = random8s g 2 - (startMids, g'') = random8s g' (len - 2) - start_ls = [startH .|. 0xc0] ++ startMids ++ [startT .|. 1] - start = os2ip $ BS.pack start_ls - (prime, g''') = find_next_prime g'' start - -random8s :: CryptoRandomGen g => g -> Int -> ([Word8], g) -random8s g 0 = ([], g) -random8s g x = - let (rest, g') = random8s g (x - 1) - (next8, g'') = throwLeft (crandom g') - in (next8:rest, g'') - -find_next_prime :: CryptoRandomGen g => g -> Integer -> (Integer, g) -find_next_prime g n - | even n = error "Even number sent to find_next_prime" - | n `mod` 65537 == 1 = find_next_prime g (n + 2) - | got_a_prime = (n, g') - | otherwise = find_next_prime g' (n + 2) - where - (got_a_prime, g') = is_probably_prime g n - -is_probably_prime :: CryptoRandomGen g => g -> Integer -> (Bool, g) -is_probably_prime !g !n - | any (\ x -> n `mod` x == 0) small_primes = (False, g) - | otherwise = miller_rabin g n 20 - where - small_primes = [ 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, - 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, - 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, - 127, 131, 137, 139, 149, 151, 157, 163, 167, 173, - 179, 181, 191, 193, 197, 199, 211, 223, 227, 229, - 233, 239, 241, 251, 257, 263, 269, 271, 277, 281, - 283, 293, 307, 311, 313, 317, 331, 337, 347, 349, - 353, 359, 367, 373, 379, 383, 389, 397, 401, 409, - 419, 421, 431, 433, 439, 443, 449, 457, 461, 463, - 467, 479, 487, 491, 499, 503, 509, 521, 523, 541, - 547, 557, 563, 569, 571, 577, 587, 593, 599, 601, - 607, 613, 617, 619, 631, 641, 643, 647, 653, 659, - 661, 673, 677, 683, 691, 701, 709, 719, 727, 733, - 739, 743, 751, 757, 761, 769, 773, 787, 797, 809, - 811, 821, 823, 827, 829, 839, 853, 857, 859, 863, - 877, 881, 883, 887, 907, 911, 919, 929, 937, 941, - 947, 953, 967, 971, 977, 983, 991, 997, 1009, 1013 ] - -miller_rabin :: CryptoRandomGen g => g -> Integer -> Int -> (Bool, g) -miller_rabin g _ 0 = (True, g) -miller_rabin g n k | test a n = (False, g') - | otherwise = miller_rabin g' n (k - 1) - where - (a, g') = throwLeft (crandomR (2, n - 2) g) - base_b = tail $ reverse $ toBinary (n - 1) - -- - test a' n' = pow base_b a - where - pow _ 1 = False - pow [] _ = True - pow !xs !d = pow' xs d $ (d * d) `mod` n' - where - pow' _ !d1 !d2 | d2==1 && d1 /= (n'-1) = True - pow' (False:ys) _ !d2 = pow ys d2 - pow' (True :ys) _ !d2 = pow ys $ (d2*a')`mod`n' - pow' _ _ _ = error "bad case" - -- - toBinary 0 = [] - toBinary x = (testBit x 0) : (toBinary $ x `shiftR` 1) - -modular_exponentiation :: Integer -> Integer -> Integer -> Integer -modular_exponentiation x y m = m_e_loop x y 1 - where - m_e_loop _ 0 !result = result - m_e_loop !b !e !result = m_e_loop b' e' result' - where - !b' = (b * b) `mod` m - !e' = e `shiftR` 1 - !result' = if testBit e 0 then (result * b) `mod` m else result - --- Compute the modular inverse (d = e^-1 mod phi) via the extended --- euclidean algorithm. And if you think I understand the math behind this, --- I have a bridge to sell you. -modular_inverse :: Integer -> Integer -> Integer -modular_inverse e phi = x `mod` phi - where - (_, x, _) = gcde e phi - -gcde :: Integer -> Integer -> (Integer, Integer, Integer) -gcde a b | d < 0 = (-d, -x, -y) - | otherwise = (d, x, y) - where - (d, x, y) = gcd_f (a,1,0) (b,0,1) - gcd_f (r1, x1, y1) (r2, x2, y2) - | r2 == 0 = (r1, x1, y1) - | otherwise = let (q, r) = r1 `divMod` r2 - in gcd_f (r2, x2, y2) (r, x1 - (q * x2), y1 - (q * y2)) diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,29 +1,30 @@ -Copyright (c) 2008, Galois, Inc. +Copyright (c) 2013, Adam Wick + All rights reserved. Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met: +modification, are permitted provided that the following conditions are met: - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - * Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in - the documentation and/or other materials provided with the - distribution. - * Neither the name of the Galois, Inc. nor the names of its - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Adam Wick nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS -FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, -INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, -BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; -LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN -ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/RSA.cabal b/RSA.cabal --- a/RSA.cabal +++ b/RSA.cabal @@ -1,14 +1,14 @@ name: RSA category: Cryptography, Codec -version: 1.2.2.0 +version: 2.4.1 license: BSD3 license-file: LICENSE author: Adam Wick maintainer: Adam Wick stability: stable build-type: Simple -cabal-version: >= 1.6 -tested-with: GHC ==6.8.0 +cabal-version: >= 1.8 +tested-with: GHC ==7.8.0 synopsis: Implementation of RSA, using the padding schemes of PKCS#1 v2.1. description: This library implements the RSA encryption and signature algorithms for arbitrarily-sized ByteStrings. While the @@ -17,57 +17,39 @@ included are based of RFC 3447, or the Public-Key Cryptography Standard for RSA, version 2.1 (a.k.a, PKCS#1 v2.1). -Flag test - Default: False - Description: Building the test program - -Flag IncludeMD5 - Description: Include support for using MD5 in the various crypto routines. - -Flag UseBinary - Description: Use the binary package for serializing keys. - -Flag OldBase - Description: Whether or not to use base 3 (default: no) - Default: False - Library - build-depends: bytestring, crypto-api >= 0.10, monadcryptorandom, crypto-pubkey-types >= 0.2 - GHC-Options: -O2 -Wall -fno-ignore-asserts -fno-warn-orphans - if flag(OldBase) - build-depends: base >= 3 && < 4, SHA < 1.4.1 - else - build-depends: base >= 4 && < 5, SHA - if flag(UseBinary) - build-depends: binary - CPP-Options: -DUSE_BINARY - if flag(IncludeMD5) && flag(UseBinary) - if flag(OldBase) - build-depends: pureMD5 < 1.1 - else - build-depends: pureMD5 - CPP-Options: -DINCLUDE_MD5 - exposed-modules: Codec.Crypto.RSA - extensions: CPP, BangPatterns, ScopedTypeVariables + hs-source-dirs: src + build-depends: base >= 4.6 && < 7.0, + binary > 0.7 && < 1.0, + bytestring > 0.8 && < 0.12, + crypto-api >= 0.10 && < 0.14, + crypto-pubkey-types >= 0.2 && < 0.6, + SHA >= 1.6.4.1 && < 2.0 + if impl(ghc < 8.0) + build-depends: cipher-aes128 < 0.7.0.4 + exposed-modules: Codec.Crypto.RSA, + Codec.Crypto.RSA.Exceptions, + Codec.Crypto.RSA.Pure + GHC-Options: -Wall -fno-warn-orphans + extensions: DeriveDataTypeable, MultiWayIf -Executable test_rsa - if flag(test) - if flag(OldBase) - build-depends: base >= 3 && < 4, SHA < 1.4.1 - else - build-depends: base >= 4 && < 5, SHA - build-depends: bytestring, test-framework >= 0.3 && < 0.7, - QuickCheck >= 2 && < 3, - test-framework-quickcheck2 >= 0.2 && < 0.7, - DRBG >= 0.2.3 && < 0.4, - tagged >= 0.2.3 && < 0.5 - else - Buildable: False - GHC-Options: -O2 -Wall -fno-ignore-asserts -fno-warn-orphans - CPP-Options: -DRSA_TEST - Main-Is: Test.hs - Other-Modules: Codec.Crypto.RSA - extensions: CPP, BangPatterns, ScopedTypeVariables +test-suite test-rsa + type: exitcode-stdio-1.0 + Main-Is: Test.hs + hs-source-dirs: src,. + other-modules: Codec.Crypto.RSA.Pure + build-depends: base >= 4.6 && < 7.0, + binary > 0.7 && < 1.0, + bytestring > 0.8 && < 0.12, + crypto-api >= 0.10 && < 0.14, + crypto-pubkey-types >= 0.4 && < 0.6, + QuickCheck >= 2.5 && < 3, + tagged >= 0.2 && < 0.9, + test-framework >= 0.8.0.3 && < 0.10, + test-framework-quickcheck2 >= 0.3.0.2 && < 0.5, + SHA >= 1.6.4.1 && < 2.0 + GHC-Options: -Wall -fno-warn-orphans + extensions: DeriveDataTypeable, MultiWayIf, ScopedTypeVariables source-repository head type: git diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,25 +1,2 @@ -import Distribution.PackageDescription import Distribution.Simple -import Distribution.Simple.LocalBuildInfo -import System.Cmd -import System.FilePath - -main :: IO () -main = defaultMainWithHooks rsaUserHooks - where - rsaUserHooks = simpleUserHooks { - runTests = runLMTests - , instHook = filter_test $ instHook defaultUserHooks - } - -type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO () - -filter_test :: Hook a -> Hook a -filter_test f pd lbi uhs x = f pd' lbi uhs x - where - pd' = pd { executables = [] } - -runLMTests :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO () -runLMTests _args _unknown descr _lbi = system test_exe >> return () - where - test_exe = "dist" "build" "test_rsa" (exeName $ head $ executables descr) +main = defaultMain diff --git a/Test.hs b/Test.hs --- a/Test.hs +++ b/Test.hs @@ -1,229 +1,290 @@ -{-# LANGUAGE FlexibleInstances #-} -import Codec.Crypto.RSA +import Codec.Crypto.RSA.Pure import Control.Monad -import Data.ByteString(pack) +import Data.Binary import Data.ByteString.Lazy(ByteString) import qualified Data.ByteString.Lazy as BS import Data.Digest.Pure.SHA -import Data.Tagged +import System.IO import Test.QuickCheck import Crypto.Random -import Crypto.Random.DRBG -import Crypto.Types -import Crypto.Types.PubKey.RSA -import Test.Framework (defaultMain, testGroup, Test) +import Test.Framework (defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) --- -------------------------------------------------------------------------- - -buildGen :: Gen (GenAutoReseed HashDRBG HashDRBG) -buildGen = do - let len = genSeedLength :: Tagged (GenAutoReseed HashDRBG HashDRBG) ByteLength - bytes <- pack `fmap` replicateM (unTagged len) arbitrary - let Right seed = newGen bytes - return seed - -instance Show (GenAutoReseed HashDRBG HashDRBG) where - show _ = "" - -instance Arbitrary (GenAutoReseed HashDRBG HashDRBG) where - arbitrary = buildGen - --- -------------------------------------------------------------------------- - -data KeyPair = KP1K PublicKey PrivateKey - deriving (Show) - -data KeyPair2048 = KP2K PublicKey PrivateKey - deriving (Show) - -instance Arbitrary KeyPair where - arbitrary = do g <- buildGen - let (pub, priv, _) = generateKeyPair g 1024 - return $ KP1K pub priv - -instance Arbitrary KeyPair2048 where - arbitrary = do g <- buildGen - let (pub, priv, _) = generateKeyPair g 2048 - return $ KP2K pub priv +type KeyPairs = [(PublicKey, PrivateKey)] --- -------------------------------------------------------------------------- +numRandomKeyPairs :: Int +numRandomKeyPairs = length keySizes * 2 -newtype LargePrime = LP Integer +keySizes :: [Int] +keySizes = [128,256,512,1024,2048,4096] -instance Show LargePrime where - show (LP x) = show x +main :: IO () +main = do + putStr "Generating testing keys ... " + hFlush stdout + g :: SystemRandom <- 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') + ] + , testGroup "Testing basic helper functions" [ + testProperty "ByteString chunking works" prop_chunkifyWorks + , testProperty "Modular exponentiation works" prop_modExpWorks + , testProperty "Modular inversion works" (prop_modInvWorks g') + ] + , 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 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 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 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) + ] + ] -instance Arbitrary LargePrime where - arbitrary = do g <- buildGen - let (res, _) = large_random_prime g 64 - return (LP res) +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'') -- -------------------------------------------------------------------------- -newtype PositiveInteger = PI Integer - -instance Show PositiveInteger where - show (PI x) = show x - -instance Arbitrary PositiveInteger where - arbitrary = (PI . (+1) . abs) `fmap` arbitrary +instance Arbitrary ByteString where + arbitrary = BS.pack `fmap` arbitrary --- -------------------------------------------------------------------------- +instance Show HashInfo where + show (HashInfo ident _) + | ident == algorithmIdent hashSHA1 = "" + | ident == algorithmIdent hashSHA224 = "" + | ident == algorithmIdent hashSHA256 = "" + | ident == algorithmIdent hashSHA384 = "" + | ident == algorithmIdent hashSHA512 = "" + | otherwise = "" -newtype NonEmptyByteString = NEBS ByteString +instance Arbitrary HashInfo where + arbitrary = elements [hashSHA1, hashSHA224, + hashSHA256, hashSHA384, hashSHA512] -instance Show NonEmptyByteString where - show (NEBS x) = show x +data KeyPairIdx = KPI Int + deriving (Show) -instance Arbitrary ByteString where - arbitrary = BS.pack `fmap` arbitrary +instance Arbitrary KeyPairIdx where + arbitrary = KPI `fmap` choose (0, numRandomKeyPairs - 1) -instance Arbitrary NonEmptyByteString where - arbitrary = (NEBS . BS.pack) `fmap` (return(:)`ap`arbitrary`ap`arbitrary) +data HashFun = HF String (ByteString -> ByteString) --- -------------------------------------------------------------------------- +instance Show HashFun where + show (HF s _) = "<" ++ s ++ ">" -instance Arbitrary EncryptionOptions where - arbitrary = arbitrary >>= \ lbl -> elements [ - UsePKCS1_v1_5 - , UseOAEP sha1' (generate_MGF1 sha1') lbl - , UseOAEP sha256' (generate_MGF1 sha256') lbl - , UseOAEP sha384' (generate_MGF1 sha384') lbl - , UseOAEP sha512' (generate_MGF1 sha512') lbl - ] - where - sha1' = bytestringDigest . sha1 - sha256' = bytestringDigest . sha256 - sha384' = bytestringDigest . sha384 - sha512' = bytestringDigest . sha512 +instance Arbitrary HashFun where + arbitrary = elements [HF "SHA1" (bytestringDigest . sha1), + HF "SHA256" (bytestringDigest . sha256), + HF "SHA384" (bytestringDigest . sha384), + HF "SHA512" (bytestringDigest . sha512)] -instance Show HashInfo where - show h = "" +prop_randomBSLen :: CryptoRandomGen g => g -> Positive Word16 -> Bool +prop_randomBSLen g x = + case randomBS g (fromIntegral (getPositive x)) of + Left _ -> False + Right (bstr, _) -> fromIntegral (BS.length bstr) == getPositive x -instance Arbitrary HashInfo where - arbitrary = elements [ha_SHA1, ha_SHA256, ha_SHA384, ha_SHA512] +prop_randomNZBS :: CryptoRandomGen g => g -> Positive Word16 -> Bool +prop_randomNZBS g x = + case randomNZBS g (fromIntegral (getPositive x)) of + Left _ -> False + Right (bstr, _) -> + (fromIntegral (BS.length bstr) == getPositive x) && BS.all (/= 0) bstr --- -------------------------------------------------------------------------- +prop_chunkifyWorks :: ByteString -> Positive Integer -> Bool +prop_chunkifyWorks x l = all (\ bs -> BS.length bs <= l') chunks && + (sum (map BS.length chunks) == BS.length x) + where + l' = fromIntegral (getPositive l) + chunks = chunkify x (fromIntegral l') -prop_chunkify_works :: NonEmptyByteString -> PositiveInteger -> Bool -prop_chunkify_works (NEBS x) (PI l) = - all (\ bs -> BS.length bs <= (fromIntegral l)) (chunkify (fromIntegral l) x) +prop_modExpWorks :: Positive Integer -> Positive Integer -> Positive Integer -> + Bool +prop_modExpWorks b e m = ((b' ^ e') `mod` m') == modular_exponentiation b' e' m' + where + b' = getPositive b + e' = getPositive e + m' = getPositive m -prop_mod_exp_works :: PositiveInteger -> PositiveInteger -> PositiveInteger -> - Bool -prop_mod_exp_works (PI b) (PI e) (PI m) = - ((b ^ e) `mod` m) == (modular_exponentiation b e m) +prop_modInvWorks :: CryptoRandomGen g => g -> Word16 -> Bool +prop_modInvWorks g0 x = + let (p, g1) = primeGen (x `mod` 512) g0 + (q, _) = primeGen (x `mod` 512) g1 + e = 65537 + phi = (p - 1) * (q - 1) + d = modular_inverse e phi + in (e * d) `mod` phi == 1 + where + primeGen pre g = + case randomBS g (fromIntegral pre) of + Left e -> error ("Error prefetching bytestring:" ++ show e) + Right (_, g') -> + case largeRandomPrime g' 64 of + Left _ -> error "Large prime generation failure." + Right res -> res -prop_mod_inv_works :: LargePrime -> LargePrime -> Bool -prop_mod_inv_works (LP p) (LP q) = (e * d) `mod` phi == 1 - where - e = 65537 - phi = (p - 1) * (q - 1) - d = modular_inverse e phi +prop_i2o2iIdent :: Positive Integer -> Bool +prop_i2o2iIdent px = + case i2osp x l of + Left _ -> False + Right x' -> os2ip x' == x + where + x = getPositive px + l = findLen 1 256 + -- + findLen b t | t > x = b + | otherwise = findLen (b + 1) (t * 256) --- -------------------------------------------------------------------------- +prop_o2i2oIdent :: ByteString -> Bool +prop_o2i2oIdent bs = + case i2osp (os2ip bs) (fromIntegral (BS.length bs)) of + Left _ -> False + Right bs' -> bs == bs' -prop_i2o2i_identity :: PositiveInteger -> Bool -prop_i2o2i_identity (PI x) = x == (os2ip $ i2osp x 16) +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 + m = getPositive x `mod` n + ep <- rsa_ep n e m + m' <- rsa_dp n d ep + return (m == m') + where (pub, priv) = kps !! idx -prop_o2i2o_identity :: NonEmptyByteString -> Bool -prop_o2i2o_identity (NEBS x) = x == (i2osp (os2ip x) (fromIntegral $ BS.length x)) +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 + m = getPositive x `mod` n + sp <- rsa_sp1 n d m + m' <- rsa_vp1 n e sp + return (m == m') + where (pub, priv) = kps !! idx -prop_ep_dp_identity :: KeyPair -> PositiveInteger -> Bool -prop_ep_dp_identity (KP1K pub priv) (PI x) = m == m' +prop_oaepInverts :: CryptoRandomGen g => + KeyPairs -> g -> + HashFun -> KeyPairIdx -> + ByteString -> ByteString -> + Property +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 - n = public_n pub - e = public_e pub - d = private_d priv - m = x `mod` n - m' = rsa_dp n d $ rsa_ep n e m + (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_sp_vp_identity :: KeyPair -> PositiveInteger -> Bool -prop_sp_vp_identity (KP1K pub priv) (PI x) = m == m' +prop_pkcsInverts :: CryptoRandomGen g => + KeyPairs -> g -> KeyPairIdx -> + ByteString -> + Property +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 - n = public_n pub - e = public_e pub - d = private_d priv - m = x `mod` n - m' = rsa_vp1 n e $ rsa_sp1 n d m - --- -------------------------------------------------------------------------- + (pub, priv) = kps !! idx + wellSized = (fromIntegral (BS.length m) < (public_size pub - 11)) && + (BS.length m > 0) -prop_oaep_inverts :: GenAutoReseed HashDRBG HashDRBG -> - HashInfo -> KeyPair2048 -> PositiveInteger -> - ByteString -> NonEmptyByteString -> - Bool -prop_oaep_inverts g hi (KP2K pub priv) (PI seed) l (NEBS x) = m == m' +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 - hash = hashFunction hi - kLen = public_size pub - hLen = BS.length $ hash BS.empty - mgf = generate_MGF1 hash - m = BS.take (fromIntegral kLen - (2 * hLen) - 2) x - (c,_) = rsaes_oaep_encrypt g hash mgf pub l m - m' = rsaes_oaep_decrypt hash mgf priv l c + (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_pkcs_inverts :: CryptoRandomGen g => g -> KeyPair -> NonEmptyByteString -> Bool -prop_pkcs_inverts g (KP1K pub priv) (NEBS x) = m == m' - where - kLen = fromIntegral $ public_size pub - m = BS.take (kLen - 11) x - (c,_) = rsaes_pkcs1_v1_5_encrypt g pub m - m' = rsaes_pkcs1_v1_5_decrypt priv c +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 (pub, priv) = findKeySized 66 kps idx -prop_sign_works :: HashInfo -> KeyPair -> NonEmptyByteString -> Bool -prop_sign_works hi (KP1K pub priv) (NEBS m) = - rsassa_pkcs1_v1_5_verify hi pub m $ rsassa_pkcs1_v1_5_sign hi priv m +prop_encDecO :: CryptoRandomGen g => + KeyPairs -> g -> + HashFun -> KeyPairIdx -> ByteString -> ByteString -> + Property +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 + (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 => + 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 (pub, priv) = findKeySized 11 kps idx -prop_encrypt_inverts :: CryptoRandomGen g => - g -> KeyPair2048 -> NonEmptyByteString -> - Bool -prop_encrypt_inverts g (KP2K pub priv) (NEBS m) = - m == decrypt priv (fst $ encrypt g pub m) +propSignVerifies :: KeyPairs -> KeyPairIdx -> ByteString -> Bool +propSignVerifies kps (KPI idx) m = fromEither $ + do sig <- sign priv m + verify pub m sig + where (pub, priv) = findKeySized 64 kps idx -prop_encrypt_plus_inverts :: CryptoRandomGen g => - g -> EncryptionOptions -> KeyPair2048 -> - NonEmptyByteString -> - Bool -prop_encrypt_plus_inverts g opts (KP2K pub priv) (NEBS m) = - m == decrypt' opts priv (fst $ encrypt' opts g pub m) +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) -- -------------------------------------------------------------------------- -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" - - g <- newGenIO :: IO SystemRandom - defaultMain $ tests g - -tests :: SystemRandom -> [Test] -tests g = [ - testGroup "Testing basic helper functions" [ - testProperty "prop_chunkify_works" prop_chunkify_works, - testProperty "prop_mod_exp_works" prop_mod_exp_works, - testProperty "prop_mod_inv_works" prop_mod_inv_works - ], - testGroup "Testing RSA core functions" [ - testProperty "prop_i2o2i_identity" prop_i2o2i_identity, - testProperty "prop_o2i2o_identity" prop_o2i2o_identity, - testProperty "prop_ep_dp_identity" prop_ep_dp_identity, - testProperty "prop_sp_vp_identity" prop_sp_vp_identity - ], - testGroup "Testing fixed-width RSA padding functions" [ - testProperty "prop_oaep_inverts" prop_oaep_inverts, - testProperty "prop_pkcs_inverts" $ prop_pkcs_inverts g, - testProperty "prop_sign_works" prop_sign_works - ], - testGroup "Testing top-level functions" [ - testProperty "prop_encrypt_inverts" $ prop_encrypt_inverts g, - testProperty "prop_encrypt_plus_inverts" $ prop_encrypt_plus_inverts g - ] - ] +fromEither :: Either a Bool -> Bool +fromEither (Left _) = False +fromEither (Right res) = res diff --git a/src/Codec/Crypto/RSA.hs b/src/Codec/Crypto/RSA.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Crypto/RSA.hs @@ -0,0 +1,6 @@ +module Codec.Crypto.RSA( + module Codec.Crypto.RSA.Exceptions + ) + where + +import Codec.Crypto.RSA.Exceptions diff --git a/src/Codec/Crypto/RSA/Exceptions.hs b/src/Codec/Crypto/RSA/Exceptions.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Crypto/RSA/Exceptions.hs @@ -0,0 +1,375 @@ +module Codec.Crypto.RSA.Exceptions( + RSAError(..) + , HashInfo(..) + -- * Keys and key generation + , PrivateKey(..) + , PublicKey(..) + , generateKeyPair + -- * High-level encryption and signature functions + , encrypt + , encryptOAEP + , encryptPKCS + , decrypt + , decryptOAEP + , decryptPKCS + , sign + , verify + -- * Core routines for OAEP + , MGF + , generateMGF1 + , rsaes_oaep_encrypt + , rsaes_oaep_decrypt + -- * Core PSS routines + -- $pss + -- * Core PKCS1 (v1.5) Routines + , rsaes_pkcs1_v1_5_encrypt + , rsaes_pkcs1_v1_5_decrypt + , rsassa_pkcs1_v1_5_sign + , rsassa_pkcs1_v1_5_verify + -- * Hashing algorithm declarations for use in RSA functions + , hashSHA1 + , hashSHA224, hashSHA256, hashSHA384, hashSHA512 + -- * Other mathematical functions that are handy for implementing + -- other RSA primitives. + , largeRandomPrime + , generatePQ + , chunkify + , os2ip, i2osp + , rsa_dp, rsa_ep + , rsa_vp1, rsa_sp1 + , modular_inverse + , modular_exponentiation + , randomBS, randomNZBS + ) + where + +import qualified Codec.Crypto.RSA.Pure as Pure +import Codec.Crypto.RSA.Pure(HashInfo,RSAError) +import Crypto.Random +import Crypto.Types.PubKey.RSA +import Data.ByteString.Lazy(ByteString) +import Data.Int + +-- |Randomly generate a key pair of the given modules length (in bits) to use +-- in any of the following functions. Use of a good random number generator is +-- of considerable importance when using this function. The input +-- CryptoRandomGen should never be used again for any other purpose; either +-- use the output'd generator or throw it all away. +generateKeyPair :: CryptoRandomGen g => + g -> Int -> + (PublicKey, PrivateKey, g) +generateKeyPair g sizeBits = throwLeft (Pure.generateKeyPair g sizeBits) + +-- ---------------------------------------------------------------------------- + +-- |Compute a signature for the given ByteString, using the SHA256 algorithm +-- in the computation. This is currently defined as rsassa_pkcs1_v1_5_sign +-- hashSHA256. If you want to use a different function, simply use the PKCS +-- function, below; it will accept arbitrarily-length messages. +sign :: PrivateKey -> ByteString -> ByteString +sign pk bs = throwLeft (Pure.sign pk bs) + +-- |Verify a signature for the given ByteString, using the SHA25 algorithm in +-- the computation. Again, if you'd like to use a different algorithm, use the +-- rsassa_pkcs1_v1_5_verify function. +verify :: PublicKey {- ^The key of the signer -} -> + ByteString {- ^The message -} -> + ByteString {- ^The purported signature -} -> + Bool +verify pk m s = throwLeft (Pure.verify pk m s) + +-- ---------------------------------------------------------------------------- + +-- |Encrypt an arbitrarily-sized message given the public key and reasonable +-- options. This is equivalent to calling encryptOAEP with SHA-256 as the +-- hash function, MGF1(SHA-256) as the mask generation function, and no label. +-- NOTE: This hash choice means that your key size must be 1024 bits or larger. +encrypt :: CryptoRandomGen g => + g -> PublicKey -> ByteString -> + (ByteString, g) +encrypt g k m = throwLeft (Pure.encrypt g k m) + +-- |Encrypt an arbitrarily-sized message using OAEP encoding. This is the +-- encouraged encoding for doing RSA encryption. Note that your key size +-- must be greater than (2 * hash length + 2) * 8. (For example, the +-- 'encrypt' convenience function uses a 256 bit / 32 byte hash function. +-- Thus, its key must be greater than (2 * 32 + 2) * 8 = 528 bits long, +-- and we suggest 1024 as a lower bound.) +encryptOAEP :: CryptoRandomGen g => + g -> + (ByteString -> ByteString) {- ^The hash function to use -} -> + MGF {- ^The mask generation function to use -} -> + ByteString {- ^An optional label to include -} -> + PublicKey {- ^The public key to encrypt with -} -> + ByteString {- ^The message to encrypt -} -> + (ByteString, g) +encryptOAEP g hash mgf l k m = throwLeft (Pure.encryptOAEP g hash mgf l k m) + +-- |Encrypt an arbitrarily-sized message using PKCS1 v1.5 encoding. This +-- encoding is deprecated, and should only be used when interacting with +-- legacy software that cannot be modified. +encryptPKCS :: CryptoRandomGen g => + g -> PublicKey -> ByteString -> + (ByteString, g) +encryptPKCS g k m = throwLeft (Pure.encryptPKCS g k m) + +-- ---------------------------------------------------------------------------- + +-- |Decrypt an arbitrarily-sized message given the public key and reasonable +-- options. This is equivalent to calling encryptOAEP with SHA-256 as the +-- hash function, MGF1(SHA-256) as the mask generation function, and no label. +decrypt :: PrivateKey -> ByteString -> ByteString +decrypt k m = throwLeft (Pure.decrypt k m) + +-- |Decrypt an arbitrarily-sized message using OAEP encoding. This is the +-- encouraged encoding for doing RSA encryption. +decryptOAEP :: (ByteString -> ByteString) {- ^The hash function to use -} -> + MGF {- ^The mask generation function to use -} -> + ByteString {- ^An optional label to include -} -> + PrivateKey {- ^The public key to encrypt with -} -> + ByteString {- ^The message to decrypt -} -> + ByteString +decryptOAEP hash mgf l k m = throwLeft (Pure.decryptOAEP hash mgf l k m) + +-- |Decrypt an arbitrarily-sized message using PKCS1 v1.5 encoding. This +-- encoding is deprecated, and should only be used when interacting with +-- legacy software that cannot be modified. +decryptPKCS :: PrivateKey -> ByteString -> ByteString +decryptPKCS k m = throwLeft (Pure.decryptPKCS k m) + +-- ---------------------------------------------------------------------------- + +chunkify :: ByteString -> Int64 -> [ByteString] +chunkify = Pure.chunkify + +-- ---------------------------------------------------------------------------- + +-- |The generalized implementation of RSAES-OAEP-ENCRYPT. Using the default +-- instantiontion of this, provided by the 'encrypt' function, is a pretty +-- good plan if this makes no sense to you, as it is instantiated with +-- reasonable defaults. +-- +-- The message to be encrypted may not be longer then (k - 2*hLen - 2), +-- where k is the length of the RSA modulus in bytes and hLen is the length +-- of a hash in bytes. Passing in a larger message will generate an error, +-- represented by the Left constructor. Note that this means that OAEP +-- encryption cannot be used with keys smaller than 512 bits. +-- +-- I have not put in a check for the length of the label, because I don't +-- expect you to use more than 2^32 bytes. So don't make me regret that, eh? +-- +rsaes_oaep_encrypt :: CryptoRandomGen g => + g -> + (ByteString->ByteString) {-^The hash function to use-} -> + MGF {- ^An appropriate mask genereation function -} -> + PublicKey {- ^The recipient's public key -} -> + ByteString {- ^A label to associate with the message + (feel free to use BS.empty) -} -> + ByteString {- ^The message to encrypt -} -> + (ByteString, g) +rsaes_oaep_encrypt g hash mgf k l m = + throwLeft (Pure.rsaes_oaep_encrypt g hash mgf k l m) + +-- |The generalized implementation of RSAES-OAEP-DECRYPT. Again, 'decrypt' +-- initializes this with a pretty good set of defaults if you don't understand +-- what all of the arguments involve. +-- +-- The ciphertext message passed to this function must be k bytes long, where +-- k is the size of the modulus in bytes. If it is not, this function will +-- generate an error, represented by the Left constructor. +-- +-- Futher, k (the length of the ciphertext in bytes) must be greater than or +-- equal to (2 * hLen + 2), where hLen is the length of the output of the +-- hash function in bytes. If this equation does not hold, a (different) +-- error will be generated. +-- +-- Finally, there are any number of internal situations that may generate +-- an error indicating that decryption failed. +-- +rsaes_oaep_decrypt :: (ByteString->ByteString) {-^The hash function to use-} -> + MGF {- ^A mask generation function -} -> + PrivateKey {- ^The private key to use -} -> + ByteString {- ^An optional label whose + association with the message + should be verified. -} -> + ByteString {- ^The ciphertext to decrypt -} -> + ByteString +rsaes_oaep_decrypt hash mgf k l c = + throwLeft (Pure.rsaes_oaep_decrypt hash mgf k l c) + +-- ---------------------------------------------------------------------------- + +-- |Implements RSAES-PKCS1-v1.5-Encrypt, for completeness and backward +-- compatibility. Also because I've already written everything else, so why not? +-- +-- This encryption / padding mechanism has several known attacks, which are +-- described in the literature. So unless you absolutely need to use this +-- for some historical reason, you should avoid it. +-- +-- The message to be encrypted must be less then or equal to (k - 11) bytes +-- long, where k is the length of the key modulus in bytes. +-- +-- Because this function uses an unknown amount of randomly-generated data, +-- it takes an instance of RandomGen rather than taking a random number as +-- input, and returns the resultant generator as output. You should take care +-- that you (a) do not reuse the input generator, thus losing important +-- randomness, and (b) choose a decent instance of RandomGen for passing to +-- this function. +rsaes_pkcs1_v1_5_encrypt :: CryptoRandomGen g => + g -> + PublicKey -> + ByteString -> + (ByteString, g) +rsaes_pkcs1_v1_5_encrypt g k m = + throwLeft (Pure.rsaes_pkcs1_v1_5_encrypt g k m) + +-- |Implements RSAES-PKCS1-v1.5-Decrypt, for completeness and possible backward +-- compatibility. Please see the notes for rsaes_pkcs_v1_5_encrypt regarding +-- use of this function in new applications without backwards compatibility +-- requirements. +-- +-- The ciphertext message passed to this function must be of length k, where +-- k is the length of the key modulus in bytes. +rsaes_pkcs1_v1_5_decrypt :: PrivateKey -> ByteString -> ByteString +rsaes_pkcs1_v1_5_decrypt k c = throwLeft (Pure.rsaes_pkcs1_v1_5_decrypt k c) + +-- ---------------------------------------------------------------------------- + +-- $pss +-- |RSASSA-PSS-Sign, RSASSA-PSS-Verify, and the related functions are not +-- included because they are covered by U.S. Patent 7036014, and it's not clear +-- what the restrictions on implementation are. Sorry. + +-- ---------------------------------------------------------------------------- + +-- |Generate a signature for the given message using the given private key, +-- using the RSASSA-PKCS1-v1.5-Sign algorithm. Note that in researching the +-- requirements for this project, several independent sources suggested not +-- using the same key across sign/validate and encrypt/decrypt contexts. You've +-- been warned. +-- +-- The output of this function is the signature only, not the message and +-- the signature. +-- +-- SIZE CONSTRAINT: The size of the public key (in bytes) must be greater +-- than or equal to the length of the hash identifier plus the length of +-- a hash plus 1. Thus, for example, you cannot use a 256 bit RSA key with +-- MD5: 32 (the size of a 256-bit RSA key in bytes) is less than 18 (the +-- size of MD5's identier) + 16 (the size of an MD5 hash in bytes) + 1, +-- or 35. +-- +-- Thus, +-- * for SHA1 and SHA256, use 512+ bit keys +-- * for SHA384 and SHA512, use 1024+ bit keys +-- +rsassa_pkcs1_v1_5_sign :: HashInfo {- ^The hash function to use -} -> + PrivateKey {- ^The private key to sign with -} -> + ByteString {- ^The message to sign -} -> + ByteString -- ^ The signature +rsassa_pkcs1_v1_5_sign hi k m = + throwLeft (Pure.rsassa_pkcs1_v1_5_sign hi k m) + +-- |Validate a signature for the given message using the given public key. The +-- signature must be exactly k bytes long, where k is the size of the RSA +-- modulus IN BYTES. +rsassa_pkcs1_v1_5_verify :: HashInfo {- ^The hash function to use -} -> + PublicKey {-^The public key to validate against-} -> + ByteString {- ^The message that was signed -} -> + ByteString {- ^The purported signature -} -> + Bool +rsassa_pkcs1_v1_5_verify hi k m s = + throwLeft (Pure.rsassa_pkcs1_v1_5_verify hi k m s) + +-- ---------------------------------------------------------------------------- + +-- |A 'mask generation function'. The input is a bytestring, and the output +-- is a hash of the given length. Unless you know what you're doing, you +-- should probably use a MGF1 formulation created with generate_MGF1. +type MGF = ByteString -> Int64 -> Either RSAError ByteString + +-- |Generate a mask generation function for the rsaes_oaep_*. As +-- suggested by the name, the generated function is an instance of the MGF1 +-- function. The arguments are the underlying hash function to use and the +-- size of a hash in bytes. +-- +-- The bytestring passed to the generated function cannot be longer than +-- 2^32 * hLen, where hLen is the passed length of the hash. +generateMGF1 :: (ByteString -> ByteString) -> MGF +generateMGF1 = Pure.generateMGF1 + +-- ---------------------------------------------------------------------------- + +-- "i2osp converts a nonnegative integer to an octet string of a specified +-- length" -- RFC 3447 +i2osp :: Integral a => a -> Int -> ByteString +i2osp x len = throwLeft (Pure.i2osp x len) + +-- "os2ip converts an octet string to a nonnegative integer" - RFC 3447 +os2ip :: ByteString -> Integer +os2ip = Pure.os2ip + +-- the RSA encryption function +rsa_ep :: Integer -> Integer -> Integer -> Integer +rsa_ep n e m = throwLeft (Pure.rsa_ep n e m) + +-- the RSA decryption function +rsa_dp :: Integer -> Integer -> Integer -> Integer +rsa_dp n d c = throwLeft (Pure.rsa_dp n d c) + +-- the RSA signature generation function +rsa_sp1 :: Integer -> Integer -> Integer -> Integer +rsa_sp1 n d m = throwLeft (Pure.rsa_sp1 n d m) + +-- the RSA signature verification function +rsa_vp1 :: Integer -> Integer -> Integer -> Integer +rsa_vp1 n e s = throwLeft (Pure.rsa_vp1 n e s) + +-- ---------------------------------------------------------------------------- + +-- Generate p and q. This is not necessarily the best way to do this, but it +-- appears to work. +generatePQ :: CryptoRandomGen g => + g -> + Int -> + (Integer, Integer, g) +generatePQ g len = throwLeft (Pure.generatePQ g len) + +-- |Generate a large random prime of a given length in bytes. +largeRandomPrime :: CryptoRandomGen g => g -> Int -> (Integer, g) +largeRandomPrime g len = throwLeft (Pure.largeRandomPrime g len) + +-- |Generate a random ByteString of the given length +randomBS :: CryptoRandomGen g => g -> Int -> (ByteString, g) +randomBS g n = throwLeft (Pure.randomBS g n) + +-- |Create a random bytestring of non-zero bytes of the given length. +randomNZBS :: CryptoRandomGen g => g -> Int -> (ByteString, g) +randomNZBS gen size = throwLeft (Pure.randomNZBS gen size) + +-- |Computes a^b mod c using a moderately good algorithm. +modular_exponentiation :: Integer -> Integer -> Integer -> Integer +modular_exponentiation = Pure.modular_exponentiation + +-- |Compute the modular inverse (d = e^-1 mod phi) via the extended euclidean +-- algorithm. +modular_inverse :: Integer {- ^e -} -> + Integer {- ^phi -} -> + Integer +modular_inverse = Pure.modular_inverse + +-- ---------------------------------------------------------------------------- + +hashSHA1 :: HashInfo +hashSHA1 = Pure.hashSHA1 + +hashSHA224 :: HashInfo +hashSHA224 = Pure.hashSHA224 + +hashSHA256 :: HashInfo +hashSHA256 = Pure.hashSHA256 + +hashSHA384 :: HashInfo +hashSHA384 = Pure.hashSHA384 + +hashSHA512 :: HashInfo +hashSHA512 = Pure.hashSHA512 diff --git a/src/Codec/Crypto/RSA/Pure.hs b/src/Codec/Crypto/RSA/Pure.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Crypto/RSA/Pure.hs @@ -0,0 +1,787 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE MultiWayIf #-} +module Codec.Crypto.RSA.Pure( + RSAError(..) + , HashInfo(..) + -- * Keys and key generation + , PrivateKey(..) + , PublicKey(..) + , generateKeyPair + -- * High-level encryption and signature functions + , encrypt + , encryptOAEP + , encryptPKCS + , decrypt + , decryptOAEP + , decryptPKCS + , sign + , verify + -- * Core routines for OAEP + , MGF + , generateMGF1 + , rsaes_oaep_encrypt + , rsaes_oaep_decrypt + -- * Core PSS routines + -- $pss + -- * Core PKCS1 (v1.5) Routines + , rsaes_pkcs1_v1_5_encrypt + , rsaes_pkcs1_v1_5_decrypt + , rsassa_pkcs1_v1_5_sign + , rsassa_pkcs1_v1_5_verify + -- * Hashing algorithm declarations for use in RSA functions + , hashSHA1 + , hashSHA224, hashSHA256, hashSHA384, hashSHA512 + -- * Other mathematical functions that are handy for implementing + -- other RSA primitives. + , largeRandomPrime + , generatePQ + , chunkify + , os2ip, i2osp + , rsa_dp, rsa_ep + , rsa_vp1, rsa_sp1 + , modular_inverse + , modular_exponentiation + , randomBS, randomNZBS + ) + where + + +import Control.Exception +import Control.Monad +import Crypto.Random +import Crypto.Types.PubKey.RSA +import Data.Binary +import Data.Binary.Get +import Data.Binary.Put +import Data.Bits +import Data.ByteString.Lazy(ByteString) +import qualified Data.ByteString.Lazy as BS +import Data.Digest.Pure.SHA +import Data.Int +import Data.Typeable + +data RSAError = RSAError String + | RSAKeySizeTooSmall + | RSAIntegerTooLargeToPack + | RSAMessageRepOutOfRange + | RSACipherRepOutOfRange + | RSAMessageTooShort + | RSAMessageTooLong + | RSAMaskTooLong + | RSAIncorrectSigSize + | RSAIncorrectMsgSize + | RSADecryptionError + | RSAGenError GenError + deriving (Eq, Show, Typeable) + +instance Exception RSAError + +data HashInfo = HashInfo { + algorithmIdent :: ByteString -- ^The ASN.1 DER encoding of the hash function + -- identifier. + , hashFunction :: ByteString -> ByteString -- ^The hash function + } + +instance Show SystemRandom where + show _ = "SystemRandom" + +class RSAKey a where + genKeySize :: a -> Int + +instance RSAKey PublicKey where + genKeySize = public_size + +instance RSAKey PrivateKey where + genKeySize = private_size + +instance Binary PublicKey where + put pk = do sizeBS <- failOnError (i2osp (public_size pk) 8) + nBS <- failOnError (i2osp (public_n pk) (public_size pk)) + putLazyByteString sizeBS + putLazyByteString nBS + get = do len <- (fromIntegral . os2ip) `fmap` getLazyByteString 8 + n <- os2ip `fmap` getLazyByteString len + return (PublicKey (fromIntegral len) n 65537) + +instance Binary PrivateKey where + put pk = do put (private_pub pk) + dBS <- failOnError (i2osp (private_d pk) (public_size (private_pub pk))) + putLazyByteString dBS + get = do pub <- get + d <- os2ip `fmap` getLazyByteString (fromIntegral (public_size pub)) + return (PrivateKey pub d 0 0 0 0 0) + +failOnError :: (Monad m, Show a) => Either a b -> m b +failOnError (Left e) = error (show e) +failOnError (Right b) = return b + +-- ---------------------------------------------------------------------------- + +-- |Randomly generate a key pair of the given modules length (in bits) to use +-- in any of the following functions. Use of a good random number generator is +-- of considerable importance when using this function. The input +-- CryptoRandomGen should never be used again for any other purpose; either +-- use the output'd generator or throw it all away. +generateKeyPair :: CryptoRandomGen g => + g -> Int -> + Either RSAError (PublicKey, PrivateKey, g) +generateKeyPair g sizeBits = do + let keyLength = fromIntegral (sizeBits `div` 8) + (p, q, g') <- generatePQ g keyLength + let n = p * q + phi = (p - 1) * (q - 1) + e = 65537 + d = modular_inverse e phi + let publicKey = PublicKey keyLength n e + privateKey = PrivateKey publicKey d p q 0 0 0 + return (publicKey, privateKey, g') + +-- ---------------------------------------------------------------------------- + +-- |Compute a signature for the given ByteString, using the SHA256 algorithm +-- in the computation. This is currently defined as rsassa_pkcs1_v1_5_sign +-- hashSHA256. If you want to use a different function, simply use the PKCS +-- function, below; it will accept arbitrarily-length messages. +sign :: PrivateKey -> ByteString -> Either RSAError ByteString +sign = rsassa_pkcs1_v1_5_sign hashSHA256 + +-- |Verify a signature for the given ByteString, using the SHA25 algorithm in +-- the computation. Again, if you'd like to use a different algorithm, use the +-- rsassa_pkcs1_v1_5_verify function. +verify :: PublicKey {- ^The key of the signer -} -> + ByteString {- ^The message -} -> + ByteString {- ^The purported signature -} -> + Either RSAError Bool +verify = rsassa_pkcs1_v1_5_verify hashSHA256 + +-- ---------------------------------------------------------------------------- + +-- |Encrypt an arbitrarily-sized message given the public key and reasonable +-- options. This is equivalent to calling encryptOAEP with SHA-256 as the +-- hash function, MGF1(SHA-256) as the mask generation function, and no label. +-- NOTE: This hash choice means that your key size must be 1024 bits or larger. +encrypt :: CryptoRandomGen g => + g -> PublicKey -> ByteString -> + Either RSAError (ByteString, g) +encrypt g k m = encryptOAEP g sha256' (generateMGF1 sha256') BS.empty k m + where sha256' = bytestringDigest . sha256 + +-- |Encrypt an arbitrarily-sized message using OAEP encoding. This is the +-- encouraged encoding for doing RSA encryption. Note that your key size +-- must be greater than (2 * hash length + 2) * 8. (For example, the +-- 'encrypt' convenience function uses a 256 bit / 32 byte hash function. +-- Thus, its key must be greater than (2 * 32 + 2) * 8 = 528 bits long, +-- and we suggest 1024 as a lower bound.) +encryptOAEP :: CryptoRandomGen g => + g -> + (ByteString -> ByteString) {- ^The hash function to use -} -> + MGF {- ^The mask generation function to use -} -> + ByteString {- ^An optional label to include -} -> + PublicKey {- ^The public key to encrypt with -} -> + ByteString {- ^The message to encrypt -} -> + Either RSAError (ByteString, g) +encryptOAEP g hash mgf l k m = + do unless ((keySize - (2 * hashLength) - 2) > 0) $ Left RSAKeySizeTooSmall + let chunks = chunkBSForOAEP k hash m + (chunks', g') <- mapM' g chunks (\ x -> rsaes_oaep_encrypt x hash mgf k l) + return (BS.concat chunks', g') + where + keySize = public_size k + hashLength = fromIntegral (BS.length (hash BS.empty)) + +-- |Encrypt an arbitrarily-sized message using PKCS1 v1.5 encoding. This +-- encoding is deprecated, and should only be used when interacting with +-- legacy software that cannot be modified. +encryptPKCS :: CryptoRandomGen g => + g -> PublicKey -> ByteString -> + Either RSAError (ByteString, g) +encryptPKCS g k m = + do let chunks = chunkBSForPKCS k m + (chunks', g') <- mapM' g chunks (\ x -> rsaes_pkcs1_v1_5_encrypt x k) + return (BS.concat chunks', g') + +-- this is just handy +mapM' :: CryptoRandomGen g => + g -> [ByteString] -> + (g -> ByteString -> Either RSAError (ByteString, g)) -> + Either RSAError ([ByteString], g) +mapM' g [] _ = Right ([], g) +mapM' g (x:rest) f = + do (x', g') <- f g x + (rest', g'') <- mapM' g' rest f + return (x':rest', g'') + +-- ---------------------------------------------------------------------------- + +-- |Decrypt an arbitrarily-sized message given the public key and reasonable +-- options. This is equivalent to calling encryptOAEP with SHA-256 as the +-- hash function, MGF1(SHA-256) as the mask generation function, and no label. +decrypt :: PrivateKey -> ByteString -> Either RSAError ByteString +decrypt k m = decryptOAEP sha256' (generateMGF1 sha256') BS.empty k m + where sha256' = bytestringDigest . sha256 + +-- |Decrypt an arbitrarily-sized message using OAEP encoding. This is the +-- encouraged encoding for doing RSA encryption. +decryptOAEP :: (ByteString -> ByteString) {- ^The hash function to use -} -> + MGF {- ^The mask generation function to use -} -> + ByteString {- ^An optional label to include -} -> + PrivateKey {- ^The public key to encrypt with -} -> + ByteString {- ^The message to decrypt -} -> + Either RSAError ByteString +decryptOAEP hash mgf l k m = + do let chunks = chunkify m (fromIntegral (private_size k)) + chunks' <- forM chunks (rsaes_oaep_decrypt hash mgf k l) + return (BS.concat chunks') + +-- |Decrypt an arbitrarily-sized message using PKCS1 v1.5 encoding. This +-- encoding is deprecated, and should only be used when interacting with +-- legacy software that cannot be modified. +decryptPKCS :: PrivateKey -> ByteString -> Either RSAError ByteString +decryptPKCS k m = + do let chunks = chunkify m (fromIntegral (private_size k)) + chunks' <- forM chunks (rsaes_pkcs1_v1_5_decrypt k) + return (BS.concat chunks') + +-- ---------------------------------------------------------------------------- + +-- |Chunk an aribitrarily-sized message into a series of chunks that can be +-- encrypted by an OAEP encryption / decryption function. +chunkBSForOAEP :: RSAKey k => + k {- ^The key being used -} -> + (ByteString -> ByteString) {- ^The hash function in use -} -> + ByteString {- ^The ByteString to chunk -} -> + [ByteString] +chunkBSForOAEP k hash bs = chunkify bs chunkSize + where + chunkSize = fromIntegral (genKeySize k) - (2 * hashLen) - 2 + hashLen = BS.length (hash BS.empty) + +-- |Chunk an arbitrarily-sized message into a series of chunks that can be +-- encrypted by a PKCS1 1.5 encryption / decryption function. +chunkBSForPKCS :: RSAKey k => k -> ByteString -> [ByteString] +chunkBSForPKCS k bstr = chunkify bstr (fromIntegral (genKeySize k) - 11) + +chunkify :: ByteString -> Int64 -> [ByteString] +chunkify bs size + | BS.length bs == 0 = [] + | otherwise = let (start, end) = BS.splitAt size bs + in start : chunkify end size + +-- ---------------------------------------------------------------------------- + +-- |The generalized implementation of RSAES-OAEP-ENCRYPT. Using the default +-- instantiontion of this, provided by the 'encrypt' function, is a pretty +-- good plan if this makes no sense to you, as it is instantiated with +-- reasonable defaults. +-- +-- The message to be encrypted may not be longer then (k - 2*hLen - 2), +-- where k is the length of the RSA modulus in bytes and hLen is the length +-- of a hash in bytes. Passing in a larger message will generate an error, +-- represented by the Left constructor. Note that this means that OAEP +-- encryption cannot be used with keys smaller than 512 bits. +-- +-- I have not put in a check for the length of the label, because I don't +-- expect you to use more than 2^32 bytes. So don't make me regret that, eh? +-- +rsaes_oaep_encrypt :: CryptoRandomGen g => + g -> + (ByteString->ByteString) {-^The hash function to use-} -> + MGF {- ^An appropriate mask genereation function -} -> + PublicKey {- ^The recipient's public key -} -> + ByteString {- ^A label to associate with the message + (feel free to use BS.empty) -} -> + ByteString {- ^The message to encrypt -} -> + Either RSAError (ByteString, g) +rsaes_oaep_encrypt g hash mgf k l m = + do let hashLength = fromIntegral (BS.length (hash BS.empty)) + keySize = public_size k + msgLength = fromIntegral (BS.length m) + -- WARNING: Step 1a is missing + when (msgLength > (keySize - (2 * hashLength) - 2)) $ -- Step 1b + Left RSAMessageTooLong + let lHash = hash l -- Step 2a + let zeros = BS.repeat 0 -- Step 2b + numZeros = keySize - msgLength - (2 * hashLength) - 2 + ps = BS.take (fromIntegral numZeros) zeros + let db = BS.concat [lHash, ps, BS.singleton 1, m] -- Step 2c + (seed, g') <- randomBS g hashLength -- Step 2d + dbMask <- mgf seed (fromIntegral (keySize - hashLength - 1)) -- Step 2e + let maskedDB = db `xorBS` dbMask -- Step 2f + seedMask <- mgf maskedDB (fromIntegral hashLength) -- Step 2g + let maskedSeed = seed `xorBS` seedMask -- Step 2h + let em = BS.concat [BS.singleton 0, maskedSeed, maskedDB] -- Step 2i + let m_i = os2ip em -- Step 3a + c_i <- rsa_ep (public_n k) (public_e k) m_i -- Step 3b + c <- i2osp c_i (public_size k) -- Step 3c + return (c, g') + +-- |The generalized implementation of RSAES-OAEP-DECRYPT. Again, 'decrypt' +-- initializes this with a pretty good set of defaults if you don't understand +-- what all of the arguments involve. +-- +-- The ciphertext message passed to this function must be k bytes long, where +-- k is the size of the modulus in bytes. If it is not, this function will +-- generate an error, represented by the Left constructor. +-- +-- Futher, k (the length of the ciphertext in bytes) must be greater than or +-- equal to (2 * hLen + 2), where hLen is the length of the output of the +-- hash function in bytes. If this equation does not hold, a (different) +-- error will be generated. +-- +-- Finally, there are any number of internal situations that may generate +-- an error indicating that decryption failed. +-- +rsaes_oaep_decrypt :: (ByteString->ByteString) {-^The hash function to use-} -> + MGF {- ^A mask generation function -} -> + PrivateKey {- ^The private key to use -} -> + ByteString {- ^An optional label whose + association with the message + should be verified. -} -> + ByteString {- ^The ciphertext to decrypt -} -> + Either RSAError ByteString +rsaes_oaep_decrypt hash mgf k l c = + do let hashLength = BS.length (hash BS.empty) + keySize = private_size k + -- WARNING: Step 1a is missing! + unless (BS.length c == fromIntegral keySize) $ -- Step 1b + Left RSADecryptionError + unless (fromIntegral keySize >= ((2 * hashLength) + 2)) $ -- Step 1c + Left RSADecryptionError + let c_ip = os2ip c -- Step 2a + m_ip <- rsa_dp (private_n k) (private_d k) c_ip -- Step 2b + em <- i2osp m_ip keySize -- Step 2c + let lHash = hash l -- Step 3a + let (y, seed_db) = BS.splitAt 1 em -- Step 3b + (maskedSeed, maskedDB) = BS.splitAt (fromIntegral hashLength) seed_db + seedMask <- mgf maskedDB hashLength -- Step 3c + let seed = maskedSeed `xorBS` seedMask -- Step 3d + dbMask <- mgf seed (fromIntegral keySize - hashLength - 1) -- Step 3e + let db = maskedDB `xorBS` dbMask -- Step 3f + let (lHash', ps_o_m) = BS.splitAt hashLength db -- Step 3g + (ps, o_m) = BS.span (== 0) ps_o_m + (o, m) = BS.splitAt 1 o_m + unless (BS.unpack o == [1]) $ Left RSADecryptionError + unless (lHash' == lHash) $ Left RSADecryptionError + unless (BS.unpack y == [0]) $ Left RSADecryptionError + unless (BS.all (== 0) ps) $ Left RSADecryptionError + return m + +-- ---------------------------------------------------------------------------- + +-- |Implements RSAES-PKCS1-v1.5-Encrypt, for completeness and backward +-- compatibility. Also because I've already written everything else, so why not? +-- +-- This encryption / padding mechanism has several known attacks, which are +-- described in the literature. So unless you absolutely need to use this +-- for some historical reason, you should avoid it. +-- +-- The message to be encrypted must be less then or equal to (k - 11) bytes +-- long, where k is the length of the key modulus in bytes. +-- +-- Because this function uses an unknown amount of randomly-generated data, +-- it takes an instance of RandomGen rather than taking a random number as +-- input, and returns the resultant generator as output. You should take care +-- that you (a) do not reuse the input generator, thus losing important +-- randomness, and (b) choose a decent instance of RandomGen for passing to +-- this function. +rsaes_pkcs1_v1_5_encrypt :: CryptoRandomGen g => + g -> + PublicKey -> + ByteString -> + Either RSAError (ByteString, g) +rsaes_pkcs1_v1_5_encrypt g k m = + do unless (fromIntegral (BS.length m) <= (public_size k - 11)) $ -- Step 1 + Left RSAIncorrectMsgSize + (ps, g') <- randomNZBS g (public_size k - fromIntegral (BS.length m) - 3) + let em = BS.concat [BS.singleton 0, BS.singleton 2, ps, BS.singleton 0, m] + let m' = os2ip em + c_i <- rsa_ep (public_n k) (public_e k) m' + res <- i2osp c_i (fromIntegral (public_size k)) + return (res, g') + +-- |Implements RSAES-PKCS1-v1.5-Decrypt, for completeness and possible backward +-- compatibility. Please see the notes for rsaes_pkcs_v1_5_encrypt regarding +-- use of this function in new applications without backwards compatibility +-- requirements. +-- +-- The ciphertext message passed to this function must be of length k, where +-- k is the length of the key modulus in bytes. +rsaes_pkcs1_v1_5_decrypt :: PrivateKey -> ByteString -> + Either RSAError ByteString +rsaes_pkcs1_v1_5_decrypt k c = + do unless (fromIntegral (BS.length c) == private_size k) $ -- Step 1 + Left RSAIncorrectMsgSize + let c_i = os2ip c -- Step 2a + m_i <- rsa_dp (private_n k) (private_d k) c_i -- Step 2b + em <- i2osp m_i (private_size k) -- Step 2c + let (zt, ps_z_m) = BS.splitAt 2 em -- Step 3... + (ps, z_m) = BS.span (/= 0) ps_z_m + (z, m) = BS.splitAt 1 z_m + when (BS.unpack zt /= [0,2]) $ Left RSADecryptionError + when (BS.unpack z /= [0]) $ Left RSADecryptionError + when (BS.length ps < 8 ) $ Left RSADecryptionError + return m + +-- ---------------------------------------------------------------------------- + +-- $pss +-- |RSASSA-PSS-Sign, RSASSA-PSS-Verify, and the related functions are not +-- included because they are covered by U.S. Patent 7036014, and it's not clear +-- what the restrictions on implementation are. Sorry. + +-- ---------------------------------------------------------------------------- + +-- |Generate a signature for the given message using the given private key, +-- using the RSASSA-PKCS1-v1.5-Sign algorithm. Note that in researching the +-- requirements for this project, several independent sources suggested not +-- using the same key across sign/validate and encrypt/decrypt contexts. You've +-- been warned. +-- +-- The output of this function is the signature only, not the message and +-- the signature. +-- +-- SIZE CONSTRAINT: The size of the public key (in bytes) must be greater +-- than or equal to the length of the hash identifier plus the length of +-- a hash plus 1. Thus, for example, you cannot use a 256 bit RSA key with +-- MD5: 32 (the size of a 256-bit RSA key in bytes) is less than 18 (the +-- size of MD5's identier) + 16 (the size of an MD5 hash in bytes) + 1, +-- or 35. +-- +-- Thus, +-- * for SHA1 and SHA256, use 512+ bit keys +-- * for SHA384 and SHA512, use 1024+ bit keys +-- +rsassa_pkcs1_v1_5_sign :: HashInfo {- ^The hash function to use -} -> + PrivateKey {- ^The private key to sign with -} -> + ByteString {- ^The message to sign -} -> + Either RSAError ByteString -- ^ The signature +rsassa_pkcs1_v1_5_sign hi k m = + do em <- emsa_pkcs1_v1_5_encode hi m (private_size k) -- Step 1 + let m_i = os2ip em -- Step 2a + s <- rsa_sp1 (private_n k) (private_d k) m_i -- Step 2b + sig <- i2osp s (private_size k) -- Step 2c + return sig + +-- |Validate a signature for the given message using the given public key. The +-- signature must be exactly k bytes long, where k is the size of the RSA +-- modulus IN BYTES. +rsassa_pkcs1_v1_5_verify :: HashInfo {- ^The hash function to use -} -> + PublicKey {-^The public key to validate against-} -> + ByteString {- ^The message that was signed -} -> + ByteString {- ^The purported signature -} -> + Either RSAError Bool +rsassa_pkcs1_v1_5_verify hi k m s + | BS.length s /= fromIntegral (public_size k) = Left RSAIncorrectSigSize + | otherwise = + do let s_i = os2ip s -- Step 2a + m_i <- rsa_vp1 (public_n k) (public_e k) s_i -- Step 2b + em <- i2osp m_i (public_size k) -- Step 2c + em' <- emsa_pkcs1_v1_5_encode hi m (public_size k) -- Step 3 + return (em == em') + +-- ---------------------------------------------------------------------------- + +-- |A 'mask generation function'. The input is a bytestring, and the output +-- is a hash of the given length. Unless you know what you're doing, you +-- should probably use a MGF1 formulation created with generate_MGF1. +type MGF = ByteString -> Int64 -> Either RSAError ByteString + +-- |Generate a mask generation function for the rsaes_oaep_*. As +-- suggested by the name, the generated function is an instance of the MGF1 +-- function. The arguments are the underlying hash function to use and the +-- size of a hash in bytes. +-- +-- The bytestring passed to the generated function cannot be longer than +-- 2^32 * hLen, where hLen is the passed length of the hash. +generateMGF1 :: (ByteString -> ByteString) -> MGF +generateMGF1 hash mgfSeed maskLen + | BS.length mgfSeed > ((2 ^ (32::Integer)) * hLen) = Left RSAMaskTooLong + | otherwise = loop BS.empty 0 + where + hLen = BS.length (hash BS.empty) + endCounter = (maskLen `divCeil` hLen) - 1 + loop t counter + | counter > endCounter = Right (BS.take maskLen t) + | otherwise = do c <- i2osp counter 4 + let bs = mgfSeed `BS.append` c + t' = t `BS.append` hash bs + loop t' (counter + 1) + +-- ---------------------------------------------------------------------------- + +-- "i2osp converts a nonnegative integer to an octet string of a specified +-- length" -- RFC 3447 +i2osp :: Integral a => a -> Int -> Either RSAError ByteString +i2osp x len | isTooLarge = Left RSAIntegerTooLargeToPack + | otherwise = Right (padding `BS.append` digits) + where + isTooLarge = (fromIntegral x :: Integer) >= + (256 ^ (fromIntegral len :: Integer)) + padding = BS.replicate (fromIntegral len - BS.length digits) 0 + digits = BS.reverse (BS.unfoldr digitize x) + digitize 0 = Nothing + digitize v = let (q, r) = divMod v 256 + in Just (fromIntegral r, q) + +-- "os2ip converts an octet string to a nonnegative integer" - RFC 3447 +os2ip :: ByteString -> Integer +os2ip = BS.foldl (\ a b -> (256 * a) + (fromIntegral b)) 0 + +-- the RSA encryption function +rsa_ep :: Integer -> Integer -> Integer -> Either RSAError Integer +rsa_ep n _ m | (m < 0) || (m >= n) = Left RSAMessageRepOutOfRange +rsa_ep n e m = Right (modular_exponentiation m e n) + +-- the RSA decryption function +rsa_dp :: Integer -> Integer -> Integer -> Either RSAError Integer +rsa_dp n _ c | (c < 0) || (c >= n) = Left RSACipherRepOutOfRange +rsa_dp n d c = Right (modular_exponentiation c d n) + +-- the RSA signature generation function +rsa_sp1 :: Integer -> Integer -> Integer -> Either RSAError Integer +rsa_sp1 n _ m | (m < 0) || (m >= n) = Left RSAMessageRepOutOfRange +rsa_sp1 n d m = Right (modular_exponentiation m d n) + +-- the RSA signature verification function +rsa_vp1 :: Integer -> Integer -> Integer -> Either RSAError Integer +rsa_vp1 n _ s | (s < 0) || (s >= n) = Left RSACipherRepOutOfRange +rsa_vp1 n e s = Right (modular_exponentiation s e n) + +-- EMSA PKCS1 1.5 encoding +emsa_pkcs1_v1_5_encode :: HashInfo -> ByteString -> Int -> + Either RSAError ByteString +emsa_pkcs1_v1_5_encode (HashInfo ident hash) m emLen + | fromIntegral emLen < (tLen + 1) = Left RSAMessageTooShort + | otherwise = Right em + where + h = hash m + t = ident `BS.append` h + tLen = BS.length t + ps = BS.replicate (fromIntegral emLen - tLen - 3) 0xFF + em = BS.concat [BS.singleton 0x00,BS.singleton 0x01,ps,BS.singleton 0x00,t] + +-- ---------------------------------------------------------------------------- + +-- Perform pair-wise xor of all the bytes in a bytestring +xorBS :: ByteString -> ByteString -> ByteString +xorBS a b = BS.pack (BS.zipWith xor a b) + +-- Divide a by b, rounding towards positive infinity +divCeil :: Integral a => a -> a -> a +divCeil a b = let (q, r) = divMod a b + in if r /= 0 then (q + 1) else q + +-- Generate p and q. This is not necessarily the best way to do this, but it +-- appears to work. +generatePQ :: CryptoRandomGen g => + g -> + Int -> + Either RSAError (Integer, Integer, g) +generatePQ g len + | len < 2 = Left RSAKeySizeTooSmall + | otherwise = do (baseP, g') <- largeRandomPrime g (len `div` 2) + (baseQ, g'') <- largeRandomPrime g' (len - (len `div` 2)) + case () of + () | baseP == baseQ -> generatePQ g'' len + | baseP < baseQ -> return (baseQ, baseP, g'') + | otherwise -> return (baseP, baseQ, g'') + +-- |Generate a large random prime of a given length in bytes. +largeRandomPrime :: CryptoRandomGen g => + g -> Int -> + Either RSAError (Integer, g) +largeRandomPrime g len = + do (h_t, g') <- randomBS g 2 + let [startH, startT] = BS.unpack h_t + (startMids, g'') <- randomBS g' (len - 2) + let bstr = BS.concat [BS.singleton (startH .|. 0xc0), + startMids, BS.singleton (startT .|. 1)] + findNextPrime g'' (os2ip bstr) + +-- |Generate a random ByteString of the given length +randomBS :: CryptoRandomGen g => g -> Int -> Either RSAError (ByteString, g) +randomBS g n = + case genBytes n g of + Left e -> Left (RSAGenError e) + Right (bs, g') -> Right (BS.fromChunks [bs], g') + +-- |Create a random bytestring of non-zero bytes of the given length. +randomNZBS :: CryptoRandomGen g => g -> Int -> Either RSAError (ByteString, g) +randomNZBS gen 0 = return (BS.empty, gen) +randomNZBS gen size = + do (bstr, gen') <- randomBS gen size + let nzbstr = BS.filter (/= 0) bstr + (rest, gen'') <- randomNZBS gen' (size - fromIntegral (BS.length nzbstr)) + return (nzbstr `BS.append` rest, gen'') + +-- |Given a number, probabalistically find the first prime number that occurs +-- after it. +findNextPrime :: CryptoRandomGen g => + g -> Integer -> + Either RSAError (Integer, g) +findNextPrime g n + | even n = findNextPrime g (n + 1) + | n `mod` 65537 == 1 = findNextPrime g (n + 2) + | otherwise = case isProbablyPrime g n of + Left e -> Left e + Right (True, g') -> Right (n, g') + Right (False, g') -> findNextPrime g' (n + 2) + +-- |Probabilistically test whether or not a given number is prime by first +-- checking some obvious factors and then defaulting to the Miller-Rabin +-- test. Should save time for numbers that are trivially composite. +isProbablyPrime :: CryptoRandomGen g => + g {- ^a good random number generator -} -> + Integer {- ^the number to test -} -> + Either RSAError (Bool, g) +isProbablyPrime g n + | n < 541 = Right (n `elem` small_primes, g) + | any (\ x -> n `mod` x == 0) small_primes = Right (False, g) + | otherwise = millerRabin g n 100 + +-- the first 200 prime numbers +small_primes :: [Integer] +small_primes = [ + 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, + 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, + 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, + 127, 131, 137, 139, 149, 151, 157, 163, 167, 173, + 179, 181, 191, 193, 197, 199, 211, 223, 227, 229, + 233, 239, 241, 251, 257, 263, 269, 271, 277, 281, + 283, 293, 307, 311, 313, 317, 331, 337, 347, 349, + 353, 359, 367, 373, 379, 383, 389, 397, 401, 409, + 419, 421, 431, 433, 439, 443, 449, 457, 461, 463, + 467, 479, 487, 491, 499, 503, 509, 521, 523, 541, + 547, 557, 563, 569, 571, 577, 587, 593, 599, 601, + 607, 613, 617, 619, 631, 641, 643, 647, 653, 659, + 661, 673, 677, 683, 691, 701, 709, 719, 727, 733, + 739, 743, 751, 757, 761, 769, 773, 787, 797, 809, + 811, 821, 823, 827, 829, 839, 853, 857, 859, 863, + 877, 881, 883, 887, 907, 911, 919, 929, 937, 941, + 947, 953, 967, 971, 977, 983, 991, 997, 1009, 1013, + 1019, 1021, 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069, + 1087, 1091, 1093, 1097, 1103, 1109, 1117, 1123, 1129, 1151, + 1153, 1163, 1171, 1181, 1187, 1193, 1201, 1213, 1217, 1223 + ] + +-- |Probabilistically test whether or not a given number is prime using +-- the Miller-Rabin test. +millerRabin :: CryptoRandomGen g => + g {- ^a good random number generator -} -> + Integer {- ^the number to test -} -> + Int {- ^the accuracy of the test -} -> + Either RSAError (Bool, g) +millerRabin g n k + | n <= 0 = Left (RSAError "Primality test on negative number or 0.") + | n == 1 = Right (False, g) + | n == 2 = Right (True, g) + | n == 3 = Right (True, g) + | otherwise = + -- write (n-1) as 2^s*d with d odd by factoring powers of 2 from n-1 + let (s, d) = oddify 0 (n - 1) + in checkLoop g s d k + where + generateSize = bitsize (n - 2) 8 `div` 8 + -- k times, pick a random integer in [2, n-2] and see if you can find + -- a witness suggesting that it's not prime. + checkLoop :: CryptoRandomGen g => + g -> Integer -> Integer -> Int -> + Either RSAError (Bool, g) + checkLoop g' _ _ 0 = Right (True, g') + checkLoop g' s d c = + case genBytes generateSize g' of + Left e -> Left (RSAGenError e) + Right (bstr, g'') -> + let a = os2ip (BS.fromStrict bstr) + x = modular_exponentiation a d n + in if | (a < 2) -> checkLoop g'' s d c + | (a > (n - 2)) -> checkLoop g'' s d c + | x == 1 -> checkLoop g'' s d (c - 1) + | x == (n - 1) -> checkLoop g'' s d (c - 1) + | otherwise -> checkWitnesses g'' s d x c (s - 1) + -- s times, where n-1 = 2^s*d, check to see if the given number is a + -- witness of something not being prime. + checkWitnesses g'' _ _ _ _ 0 = Right (False, g'') + checkWitnesses g'' s d x c1 c2 = + case (x * x) `mod` n of + 1 -> Right (False, g'') + y | y == (n - 1) -> checkLoop g'' s d (c1 - 1) + _ -> checkWitnesses g'' s d x c1 (c2 - 1) + -- given n, compute s and d such that 2^s*d = n. + oddify s x | testBit x 0 = (s, x) + | otherwise = oddify (s + 1) (x `shiftR` 1) + -- given n, compute the number of bits required to hold it. + bitsize v x | (1 `shiftL` x) > v = x + | otherwise = bitsize v (x + 8) + +-- |Computes a^b mod c using a moderately good algorithm. +modular_exponentiation :: Integer -> Integer -> Integer -> Integer +modular_exponentiation x y m = m_e_loop x y 1 + where + m_e_loop _ 0 result = result + m_e_loop b e result = m_e_loop b' e' result' + where + b' = (b * b) `mod` m + e' = e `shiftR` 1 + result' = if testBit e 0 then (result * b) `mod` m else result + +-- |Compute the modular inverse (d = e^-1 mod phi) via the extended euclidean +-- algorithm. +modular_inverse :: Integer {- ^e -} -> + Integer {- ^phi -} -> + Integer +modular_inverse e phi = x `mod` phi + where (_, x, _) = extended_euclidean e phi + +-- Compute the extended euclidean algorithm +extended_euclidean :: Integer -> Integer -> (Integer, Integer, Integer) +extended_euclidean a b | d < 0 = (-d, -x, -y) + | otherwise = (d, x, y) + where + (d, x, y) = egcd a b + +egcd :: Integer -> Integer -> (Integer, Integer, Integer) +egcd 0 b = (b, 0, 1) +egcd a b = let (g, y, x) = egcd (b `mod` a) a + in (g, x - ((b `div` a) * y), y) + +-- ---------------------------------------------------------------------------- + +hashSHA1 :: HashInfo +hashSHA1 = HashInfo { + algorithmIdent = BS.pack [0x30,0x21,0x30,0x09,0x06,0x05,0x2b,0x0e,0x03, + 0x02,0x1a,0x05,0x00,0x04,0x14] + , hashFunction = bytestringDigest . sha1 + } + +hashSHA224 :: HashInfo +hashSHA224 = HashInfo { + algorithmIdent = BS.pack [0x30,0x2d,0x30,0x0d,0x06,0x09,0x60,0x86,0x48, + 0x01,0x65,0x03,0x04,0x02,0x04,0x05,0x00,0x04, + 0x1c] + , hashFunction = bytestringDigest . sha224 + } + +hashSHA256 :: HashInfo +hashSHA256 = HashInfo { + algorithmIdent = BS.pack [0x30,0x31,0x30,0x0d,0x06,0x09,0x60,0x86,0x48, + 0x01,0x65,0x03,0x04,0x02,0x01,0x05,0x00,0x04, + 0x20] + , hashFunction = bytestringDigest . sha256 + } + +hashSHA384 :: HashInfo +hashSHA384 = HashInfo { + algorithmIdent = BS.pack [0x30,0x41,0x30,0x0d,0x06,0x09,0x60,0x86,0x48, + 0x01,0x65,0x03,0x04,0x02,0x02,0x05,0x00,0x04, + 0x30] + , hashFunction = bytestringDigest . sha384 + } + +hashSHA512 :: HashInfo +hashSHA512 = HashInfo { + algorithmIdent = BS.pack [0x30,0x51,0x30,0x0d,0x06,0x09,0x60,0x86,0x48, + 0x01,0x65,0x03,0x04,0x02,0x03,0x05,0x00,0x04, + 0x40] + , hashFunction = bytestringDigest . sha512 + }