1 module Rsa (encrypt, decrypt, makeKeys) 2 where 3 4 5 encrypt, decrypt :: Integer -> Integer -> String -> String 6 encrypt n e = unlines . map (show . power e n . code) . collect (size n) 7 decrypt n d = concat . map (decode . power d n . read) . lines 8 9 10 -------- Converting between Strings and Integers ----------- 11 12 code :: String -> Integer 13 code = foldl accum 0 14 where accum x y = (128 * x) + fromIntegral (fromEnum y) 15 16 decode :: Integer -> String 17 decode n = reverse (expand n) 18 where expand 0 = [] 19 expand x = toEnum (fromIntegral (x `mod` 128)) : expand (x `div` 128) 20 21 collect :: Int -> [a] -> [[a]] 22 collect 0 xs = [] 23 collect n [] = [] 24 collect n xs = take n xs : collect n (drop n xs) 25 26 size :: Integer -> Int 27 size n = (length (show n) * 47) `div` 100 -- log_128 10 = 0.4745 28 29 30 ------- Constructing keys ------------------------- 31 32 makeKeys :: Integer -> Integer -> (Integer, Integer, Integer) 33 makeKeys p' q' = (n, invert phi d, d) 34 where p = nextPrime p' 35 q = nextPrime q' 36 n = p*q 37 phi = (p-1)*(q-1) 38 d = nextPrime (p+q+1) 39 40 nextPrime :: Integer -> Integer 41 nextPrime a = head (filter prime [odd,odd+2..]) 42 where odd | even a = a+1 43 | True = a 44 prime p = and [power (p-1) p x == 1 | x <- [3,5,7]] 45 46 invert :: Integer -> Integer -> Integer 47 invert n a = if e<0 then e+n else e 48 where e=iter n 0 a 1 49 50 iter :: Integer -> Integer -> Integer -> Integer -> Integer 51 iter g v 0 w = v 52 iter g v h w = iter h w (g - fact * h) (v - fact * w) 53 where fact = g `div` h 54 55 56 ------- Fast exponentiation, mod m ----------------- 57 58 power :: Integer -> Integer -> Integer -> Integer 59 power 0 m x = 1 60 power n m x | even n = sqr (power (n `div` 2) m x) `mod` m 61 | True = (x * power (n-1) m x) `mod` m 62 63 sqr :: Integer -> Integer 64 sqr x = x * x 65 66