This week only. Pastebin PRO Accounts Christmas Special! Don't miss out!Want more features on Pastebin? Sign Up, it's FREE!
Guest

Untitled

By: a guest on Dec 17th, 2011  |  syntax: Haskell  |  size: 4.60 KB  |  views: 699  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. import Data.Bits
  2. import System.Random
  3. import Data.Char
  4.  
  5. --Keys, in the form n, k (where k is i for the public key, and j for the private key)
  6. data Key = Public Integer Integer | Private Integer Integer
  7.         deriving (Eq, Ord, Show)
  8.  
  9. -- Extended Euclidian algorithm using the recursive method, returning (gcd, x, y)
  10. eea :: (Integral a) => a -> a -> (a, a, a)
  11. eea a b
  12.         | b == 0        = (a, 1, 0)
  13.         | otherwise     = (d, t, s - q * t)
  14.         where
  15.                 (q, r) = a `divMod` b
  16.                 (d, s, t) = eea b r
  17.  
  18. -- Modular multiplicative inverse for a (mod m)
  19. mminv :: (Integral a) => a -> a-> a
  20. mminv a m
  21.         | gcd /= 1      = error "Number doesn't have a multiplicative inverse for this modulus!"
  22.         | otherwise     = x `mod` m
  23.         where
  24.                 (gcd, x, _) = eea a m
  25.  
  26. -- Modular exponentiation by squaring (using Montgomery's ladder to prevent side-channel (i.e. implementation based)
  27. -- attacks as discussed in http://www.sidechannelattacks.com/details/paper_details.aspx?fid=661
  28. mexp :: Integer -> Integer -> Integer -> Integer
  29. mexp x n m
  30.         | n == 0        = 1
  31.         | otherwise     = fst (foldl (mexp' m) (x, x ^ 2) [ testBit n (k - b - 2) | b <- [0 ..(k - 2)] ])
  32.         where
  33.                 k = ceiling ( logBase 2 (fromIntegral (n + 1)) )
  34.  
  35. mexp' :: Integer -> (Integer, Integer) -> Bool -> (Integer, Integer)
  36. mexp' m xs b
  37.         | b == False    = ((x1 ^ 2) `mod` m, (x1 * x2) `mod` m)
  38.         | otherwise             = ((x1 * x2) `mod` m, (x2 ^ 2) `mod` m)
  39.         where
  40.                 x1 = fst xs
  41.                 x2 = snd xs
  42.  
  43. -- Generate public and private keys using the multiplicative inverse of i, mod phi
  44. generateKeys :: Integer -> Integer -> Integer -> (Key, Key)
  45. generateKeys p q i
  46.         | gcd /= 1      = error "Public exponent i is not coprime with phi!"
  47.         | otherwise     = (Public n i, Private n j)
  48.         where
  49.                 n = p * q
  50.                 phi = (p - 1) * (q - 1)
  51.                 (gcd, _, _) = eea i phi
  52.                 j = mminv i phi
  53.  
  54. -- Code or decode an integer, given a public/private key
  55. rsaCoder :: Key -> Integer -> Integer
  56. rsaCoder (Public n k) x = mexp x k n
  57. rsaCoder (Private n k) x = mexp x k n
  58.  
  59.  
  60. -- Primality tester from http://www.haskell.org/haskellwiki/Testing_primality, but using my own mexp function instead of theirs
  61. -- BEGIN --
  62. -- (eq. to) find2km (2^k * n) = (k,n)
  63. find2km :: Integral a => a -> (a,a)
  64. find2km n = f 0 n
  65.     where
  66.         f k m
  67.             | r == 1 = (k,m)
  68.             | otherwise = f (k+1) q
  69.             where (q,r) = quotRem m 2  
  70.  
  71. -- n is the number to test; a is the (presumably randomly chosen) witness
  72. millerRabinPrimality :: Integer -> Integer -> Bool
  73. millerRabinPrimality n a
  74.     | a <= 1 || a >= n-1 =
  75.         error $ "millerRabinPrimality: a out of range ("
  76.               ++ show a ++ " for "++ show n ++ ")"
  77.     | n < 2 = False
  78.     | even n = False
  79.     | b0 == 1 || b0 == n' = True
  80.     | otherwise = iter (tail b)
  81.     where
  82.         n' = n-1
  83.         (k,m) = find2km n'
  84.         b0 = mexp a m n -- modified this line
  85.         b = take (fromIntegral k) $ iterate (squareMod n) b0
  86.         iter [] = False
  87.         iter (x:xs)
  88.             | x == 1 = False
  89.             | x == n' = True
  90.             | otherwise = iter xs
  91.  
  92. squareMod :: Integral a => a -> a -> a
  93. squareMod a b = (b * b) `rem` a
  94. -- END --
  95.  
  96. -- Use the Miller-Rabin method of primality testing, with a witness of 100 (i.e. a non-prime probability of 2^(-100),
  97. -- according to http://snippets.dzone.com/posts/show/4200)
  98. primeTest :: Integer -> Bool
  99. primeTest x = millerRabinPrimality x 100
  100.  
  101. -- Generate an n-bit random prime number
  102. getPrime :: Integer -> IO Integer
  103. getPrime n = do
  104.         r <- randomRIO (2 ^ n, (2 ^ (n + 1)) - 1)
  105.         if (primeTest r)
  106.                 then
  107.                         return r
  108.                 else
  109.                         getPrime n
  110.  
  111. -- Encode a string byte-wise as an list of RSA-encrypted integers (this is not a good way of doing it, as frequency
  112. -- analysis can easily be performed for frequent characters
  113. encode:: String -> Key -> [Integer]
  114. encode s k = [rsaCoder k (toInteger $ ord i) | i <- s]
  115.  
  116. -- Decode a list of RSA-encrypted integers byte-wise to a string
  117. decode:: [Integer] -> Key -> String
  118. decode s k = [chr $ fromInteger $ rsaCoder k i | i <- s]
  119.  
  120. main :: IO()
  121. main = do
  122.         p <- getPrime 256
  123.         q <- getPrime 256
  124.         i <- getPrime 256
  125.         putStr $ "p: " ++ (show p) ++ " " ++ show (primeTest p) ++ "\n"
  126.         putStr $ "q: " ++ (show q) ++ " " ++ show (primeTest q) ++ "\n"
  127.         putStr $ "i: " ++ (show i) ++ " " ++ show (primeTest i) ++ "\n"
  128.         let keys = generateKeys p q i
  129.         let pub = fst keys
  130.         let priv = snd keys
  131.         putStr $ show pub
  132.         putStr "\n"
  133.         putStr $ show priv
  134.         putStr "\nType the text to encode:\n"
  135.         plaintext <- getLine
  136.         putStr "\n"
  137.         let encrypted = encode plaintext pub
  138.         putStr $ "Encrypted:\n" ++ (show encrypted) ++ "\n"
  139.         let decrypted = decode encrypted priv
  140.         putStr $ "Decrypted:\n" ++ (show decrypted) ++ "\n"
clone this paste RAW Paste Data