diff --git a/Codec/Crypto/RSA.hs b/Codec/Crypto/RSA.hs new file mode 100644 --- /dev/null +++ b/Codec/Crypto/RSA.hs @@ -0,0 +1,703 @@ +-- |An implementation of RSA (PKCS #1) Cryptography, as described by the +-- RSA standard and RFC 3447. +module Codec.Crypto.RSA( + -- * Keys and key generations + PublicKey(..), PrivateKey(..) + , generateKeyPair + -- * 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 System.Random + +#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 RSA_TEST +import Data.Word +#endif + +data PublicKey = PublicKey { + public_size :: Int64 -- ^The size of the RSA modulus, in bytes. + , public_n :: Integer -- ^The RSA modulus. + , public_e :: Integer -- ^The public exponent. + } + deriving (Show) + +data PrivateKey = PrivateKey { + private_size :: Int64 -- ^The size of the RSA modulus, in bytes. + , private_n :: Integer -- ^The RSA modulus. + , private_d :: Integer -- ^The private exponent. + } + deriving (Show) + +#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 len n 65537 + +instance Binary PrivateKey where + put pk = do putLazyByteString $ i2osp (private_size pk) 8 + putLazyByteString $ i2osp (private_n pk) (private_size pk) + putLazyByteString $ i2osp (private_d pk) (private_size pk) + get = do len <- (fromIntegral . os2ip) `fmap` getLazyByteString 8 + n <- os2ip `fmap` getLazyByteString len + d <- os2ip `fmap` getLazyByteString len + return $ PrivateKey len n d +#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 RandomGen should never be used again for any other purpose. +generateKeyPair :: RandomGen g => g -> Int -> (PublicKey, PrivateKey, g) +generateKeyPair g sizeBits = (PublicKey kLen n e, PrivateKey kLen n d, 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 + +data EncryptionOptions = + UseOAEP { + -- |The hash function to use. + oaep_hash :: HashFunction + -- |The mask generation function to use. + , oaep_mgf :: MGF + -- |The label to annotate items with. + , oaep_label :: ByteString + } + | UsePKCS1_v1_5 + +instance Show EncryptionOptions where + show opt@UseOAEP{} = "" + where hashLen = BS.length $ oaep_hash opt BS.empty + show UsePKCS1_v1_5 = "" + +-- |Encrypt an arbitrarily-sized message using the defaults for RSA +-- encryption (specifically, using MGF1, SHA-256 as the hash +-- function, and not adding a label). If the message is longer than the +-- underlying encryption function can support, it is broken up into parts +-- and each part is encrypted. +encrypt :: RandomGen 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' :: RandomGen 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 = public_size pub - (2 * hLen) - 2 + chunks = chunkify chunkSize m + enc1 (!res, !g) !cur = let (seed, g') = random g + !newc = rsaes_oaep_encrypt hash mgf pub seed 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 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 (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 :: HashFunction -> MGF -> + PublicKey -> Integer -> ByteString -> ByteString -> + ByteString +rsaes_oaep_encrypt hash mgf k seed_int l m + | message_too_long = error "message too long (rsaes_oaep_encrypt)" + | otherwise = c + where + mLen = BS.length m -- Int64 + hLen = BS.length $ hash BS.empty -- Int64 + kLen = public_size k + seed = i2osp seed_int hLen + -- 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 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 /= kLen + bad_hash_len = 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 (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 :: RandomGen 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 = 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 = 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 /= 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::Int64)) * 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 -> Int64 -> ByteString +i2osp x len | x >= (256 ^ len) = error "RSA internal error: integer too large" + | otherwise = padding `BS.append` digits + where + padding = BS.replicate (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 -> Int64 -> ByteString +emsa_pkcs1_v1_5_encode (HashInfo hash_ident hash) m emLen + | 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 (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) + +instance Random Word8 where + randomR (a,b) g = let aI::Int = fromIntegral a + bI::Int = fromIntegral b + (x, g') = randomR (aI, bI) g + in (fromIntegral x, g') + random = randomR (minBound, maxBound) + +generate_random_bytestring :: RandomGen g => g -> Int64 -> (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'') = randomR (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 :: RandomGen g => g -> Int64 -> (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 :: RandomGen g => g -> Int64 -> (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 :: RandomGen g => g -> Int64 -> ([Word8], g) +random8s g 0 = ([], g) +random8s g x = + let (rest, g') = random8s g (x - 1) + (next8, g'') = random g' + in (next8:rest, g'') + +find_next_prime :: RandomGen 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 :: RandomGen 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 :: RandomGen 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') = randomR (2, n - 2) g + base_b = tail $ reverse $ toBinary (n - 1) + -- + test a' n' = pow base_b a + where + pow _ 1 = False + pow [] _ = True + pow !xs !d = pow' xs d $ (d * d) `mod` n' + where + pow' _ !d1 !d2 | d2==1 && d1 /= (n'-1) = True + pow' (False:ys) _ !d2 = pow ys d2 + pow' (True :ys) _ !d2 = pow ys $ (d2*a')`mod`n' + pow' _ _ _ = error "bad case" + -- + toBinary 0 = [] + toBinary x = (testBit x 0) : (toBinary $ x `shiftR` 1) + +modular_exponentiation :: Integer -> Integer -> Integer -> Integer +modular_exponentiation x y m = m_e_loop x y 1 + where + m_e_loop _ 0 !result = result + m_e_loop !b !e !result = m_e_loop b' e' result' + where + !b' = (b * b) `mod` m + !e' = e `shiftR` 1 + !result' = if testBit e 0 then (result * b) `mod` m else result + +-- Compute the modular inverse (d = e^-1 mod phi) via the extended +-- euclidean algorithm. And if you think I understand the math behind this, +-- I have a bridge to sell you. +modular_inverse :: Integer -> Integer -> Integer +modular_inverse e phi = x `mod` phi + where + (_, x, _) = gcde e phi + +gcde :: Integer -> Integer -> (Integer, Integer, Integer) +gcde a b | d < 0 = (-d, -x, -y) + | otherwise = (d, x, y) + where + (d, x, y) = gcd_f (a,1,0) (b,0,1) + gcd_f (r1, x1, y1) (r2, x2, y2) + | r2 == 0 = (r1, x1, y1) + | otherwise = let (q, r) = r1 `divMod` r2 + in gcd_f (r2, x2, y2) (r, x1 - (q * x2), y1 - (q * y2)) diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +Copyright (c) 2008, Galois, Inc. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +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. + +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. diff --git a/RSA.cabal b/RSA.cabal new file mode 100644 --- /dev/null +++ b/RSA.cabal @@ -0,0 +1,44 @@ +name: RSA +category: Cryptography, Codec +version: 1.0.0 +license: BSD3 +license-file: LICENSE +author: Adam Wick +maintainer: Adam Wick +stability: stable +build-type: Simple +cabal-version: >= 1.2 +tested-with: GHC ==6.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 + implementations work, they are not necessarily the fastest ones + on the planet. Particularly key generation. The algorithms + 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 IncludeMD5 + Description: Include support for using MD5 in the various crypto routines. + +Flag UseBinary + Description: Use the binary package for serializing keys. + +Library + build-depends: base >= 3, bytestring, SHA, random + GHC-Options: -O2 -Wall -fno-ignore-asserts -fno-warn-orphans + if flag(UseBinary) + build-depends: binary + CPP-Options: -DUSE_BINARY + if flag(IncludeMD5) && flag(UseBinary) + build-depends: pureMD5 + CPP-Options: -DINCLUDE_MD5 + exposed-modules: Codec.Crypto.RSA + extensions: CPP, BangPatterns, PatternSignatures + +Executable test_rsa + build-depends: base >= 3, bytestring, QuickCheck, SHA + 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, PatternSignatures diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,25 @@ +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) diff --git a/Test.hs b/Test.hs new file mode 100644 --- /dev/null +++ b/Test.hs @@ -0,0 +1,214 @@ +import Codec.Crypto.RSA +import Control.Monad +import Data.ByteString.Lazy(ByteString) +import qualified Data.ByteString.Lazy as BS +import Data.Digest.Pure.SHA +import Data.Int +import Data.Word +import System.IO +import System.Random +import Test.QuickCheck + +-- -------------------------------------------------------------------------- + +data KeyPair = KP1K PublicKey PrivateKey + deriving (Show) + +data KeyPair2048 = KP2K PublicKey PrivateKey + deriving (Show) + +instance Arbitrary KeyPair where + arbitrary = do g <- rand + let (pub, priv, _) = generateKeyPair g 1024 + return $ KP1K pub priv + coarbitrary = undefined + +instance Arbitrary KeyPair2048 where + arbitrary = do g <- rand + let (pub, priv, _) = generateKeyPair g 2048 + return $ KP2K pub priv + coarbitrary = undefined + +-- -------------------------------------------------------------------------- + +newtype LargePrime = LP Integer + +instance Show LargePrime where + show (LP x) = show x + +instance Arbitrary LargePrime where + arbitrary = do g <- rand + let (res, _) = large_random_prime g 64 + return (LP res) + coarbitrary = undefined + +-- -------------------------------------------------------------------------- + +newtype PositiveInteger = PI Integer + +instance Show PositiveInteger where + show (PI x) = show x + +instance Arbitrary PositiveInteger where + arbitrary = (PI . (+1) . abs) `fmap` arbitrary + coarbitrary = undefined + +-- -------------------------------------------------------------------------- + +newtype NonEmptyByteString = NEBS ByteString + +instance Show NonEmptyByteString where + show (NEBS x) = show x + +instance Arbitrary Word8 where + arbitrary = fromIntegral `fmap` (arbitrary::(Gen Int)) + coarbitrary = undefined + +instance Arbitrary ByteString where + arbitrary = BS.pack `fmap` arbitrary + coarbitrary = undefined + +instance Arbitrary NonEmptyByteString where + arbitrary = (NEBS . BS.pack) `fmap` (return(:)`ap`arbitrary`ap`arbitrary) + coarbitrary = undefined + +-- -------------------------------------------------------------------------- + +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 + coarbitrary = undefined + +instance Show HashInfo where + show h = "" + +instance Arbitrary HashInfo where + arbitrary = elements [ha_SHA1, ha_SHA256, ha_SHA384, ha_SHA512] + coarbitrary = undefined + +-- -------------------------------------------------------------------------- + +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_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_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_i2o2i_identity :: PositiveInteger -> Bool +prop_i2o2i_identity (PI x) = x == (os2ip $ i2osp x 16) + +prop_o2i2o_identity :: NonEmptyByteString -> Bool +prop_o2i2o_identity (NEBS x) = x == (i2osp (os2ip x) (BS.length x)) + +prop_ep_dp_identity :: KeyPair -> PositiveInteger -> Bool +prop_ep_dp_identity (KP1K pub priv) (PI x) = 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 + +prop_sp_vp_identity :: KeyPair -> PositiveInteger -> Bool +prop_sp_vp_identity (KP1K pub priv) (PI x) = 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 + +-- -------------------------------------------------------------------------- + +prop_oaep_inverts :: HashInfo -> KeyPair2048 -> PositiveInteger -> + ByteString -> NonEmptyByteString -> + Bool +prop_oaep_inverts hi (KP2K pub priv) (PI seed) l (NEBS x) = m == m' + where + hash = hashFunction hi + kLen = public_size pub + hLen = BS.length $ hash BS.empty + mgf = generate_MGF1 hash + m = BS.take (kLen - (2 * hLen) - 2) x + c = rsaes_oaep_encrypt hash mgf pub seed l m + m' = rsaes_oaep_decrypt hash mgf priv l c + +prop_pkcs_inverts :: RandomGen g => g -> KeyPair -> NonEmptyByteString -> Bool +prop_pkcs_inverts g (KP1K pub priv) (NEBS x) = m == m' + where + kLen = 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_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_encrypt_inverts :: RandomGen g => + g -> KeyPair2048 -> NonEmptyByteString -> + Bool +prop_encrypt_inverts g (KP2K pub priv) (NEBS m) = + m == decrypt priv (fst $ encrypt g pub m) + +prop_encrypt_plus_inverts :: RandomGen 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) + +-- -------------------------------------------------------------------------- + +run_test :: Testable a => String -> a -> IO () +run_test n t = putStr (" " ++ n ++ " ... ") >> hFlush stdout >> quickCheck t + +main :: IO () +main = do + g <- getStdGen + 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" + putStrLn "\nTesting basic helper functions" + run_test "prop_chunkify_works" prop_chunkify_works + run_test "prop_mod_exp_works" prop_mod_exp_works + run_test "prop_mod_inv_works" prop_mod_inv_works + putStrLn "\nTesting RSA core functions" + run_test "prop_i2o2i_identity" prop_i2o2i_identity + run_test "prop_o2i2o_identity" prop_o2i2o_identity + run_test "prop_ep_dp_identity" prop_ep_dp_identity + run_test "prop_sp_vp_identity" prop_sp_vp_identity + putStrLn "\nTesting fixed-width RSA padding functions:" + run_test "prop_oaep_inverts" prop_oaep_inverts + run_test "prop_pkcs_inverts" $ prop_pkcs_inverts g + run_test "prop_sign_works" prop_sign_works + putStrLn "\nTesting top-level functions work:" + run_test "prop_encrypt_inverts" $ prop_encrypt_inverts g + run_test "prop_encrypt_plus_inverts" $ prop_encrypt_plus_inverts g + +