RSA 1.2.2.0 → 2.4.1
raw patch · 8 files changed
Files
- Codec/Crypto/RSA.hs +0/−701
- LICENSE +23/−22
- RSA.cabal +34/−52
- Setup.hs +1/−24
- Test.hs +244/−183
- src/Codec/Crypto/RSA.hs +6/−0
- src/Codec/Crypto/RSA/Exceptions.hs +375/−0
- src/Codec/Crypto/RSA/Pure.hs +787/−0
− Codec/Crypto/RSA.hs
@@ -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{} = "<rsa/OAEP hashLen=" ++ show hashLen ++ ">"- where hashLen = BS.length $ oaep_hash opt BS.empty- show UsePKCS1_v1_5 = "<rsa/PKCS1_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))
LICENSE view
@@ -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.
RSA.cabal view
@@ -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 <awick@galois.com> maintainer: Adam Wick <awick@galois.com> 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
Setup.hs view
@@ -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
Test.hs view
@@ -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 _ = "<randomGen>"--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 = "<SHA1>"+ | ident == algorithmIdent hashSHA224 = "<SHA224>"+ | ident == algorithmIdent hashSHA256 = "<SHA256>"+ | ident == algorithmIdent hashSHA384 = "<SHA384>"+ | ident == algorithmIdent hashSHA512 = "<SHA512>"+ | otherwise = "<unknownHASH>" -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 = "<hash: len=" ++ (show $ BS.length $ hashFunction h BS.empty) ++ ">"+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
+ src/Codec/Crypto/RSA.hs view
@@ -0,0 +1,6 @@+module Codec.Crypto.RSA(+ module Codec.Crypto.RSA.Exceptions+ )+ where++import Codec.Crypto.RSA.Exceptions
+ src/Codec/Crypto/RSA/Exceptions.hs view
@@ -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
+ src/Codec/Crypto/RSA/Pure.hs view
@@ -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+ }