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