## Posts Tagged ‘cryptography’

### Programming Praxis – RSA Cryptography

November 16, 2010

In today’s Programming Praxis exercise, our task is to implement a key generator and encryption/decription functions for RSA cryptography. Let’s get started, shall we?

A few imports:

```import Data.Bits
import Data.List
import System.Random
import Data.Numbers.Primes
```

Like the Scheme solution, we’ll be recycling a few functions from previous solutions.

```expm :: Integer -> Integer -> Integer -> Integer
expm b e m = foldl' (\r (b', _) -> mod (r * b') m) 1 .
filter (flip testBit 0 . snd) .
zip (iterate (flip mod m . (^ 2)) b) \$
takeWhile (> 0) \$ iterate (`shiftR` 1) e

euclid :: Integral a => a -> a -> a
euclid x y = f 1 0 x 0 1 y where
f a b g u v w | w == 0    = mod a y
| otherwise = f u v w (a - q*u) (b - q*v) (g - q*w)
where q = div g w

inv :: Integral a => a -> a -> a
inv x m | gcd x m == 1 = euclid x m
| otherwise    = error "divisor must be coprime to modulus"
```

The keygen returns the modulus and the decryption key.

```keygen :: Integer -> Integer -> IO (Integer, Integer)
keygen bits key = do p <- gen (div bits 2)
q <- gen (div bits 2)
let d = inv key ((p - 1) * (q - 1))
return (p * q, d) where
gen k = fmap (until valid succ) \$ randomRIO (2 ^ (k - 1), 2 ^ k)
valid v = gcd key (v - 1) == 1 && mod v 4 == 3 && isPrime v
```

For encrypting and decrypting we could just use expm directly, but we flip the last two arguments to correspond to the Scheme solution.

```crypt :: Integer -> Integer -> Integer -> Integer
crypt = flip . expm
```

Some tests to see if everything’s working correctly:

```main :: IO ()
main = do let e = 65537
(m, d) <- keygen 32 e
print \$ crypt (crypt 42 m e) m d == 42
print \$ crypt 42 1893932189 e == 1118138102
```

Everything seems to be working fine.

### Programming Praxis – The Playfair Cipher

July 3, 2009

Today’s Programming Praxis problem is about the Playfair Cipher, a way of encrypting messages that was used in the first and second World Wars. Our target is 44 lines, so let’s get cracking.

We’re going to need a bunch of imports on this one:

```import Data.Char
import Data.List
import Data.List.HT
import Data.List.Split
import qualified Data.Map as M```

And for convenience, we make a type definition for Keys.

`type Key = M.Map (Int, Int) Char`

In order for the algorithm to work, we’re going to have to filter all the input so that all we get is capital letters without a J.

```process :: String -> String
process = replace "J" "I" . map toUpper . filter isLetter```

Instead of working with a block, we turn the key into a map of of x-y coordinates to letters. This makes the rest of the algorithm simpler.

```key :: String -> Key
key = M.fromList . concat .
zipWith (\y -> zipWith (\x c -> ((x, y), c)) [0..]) [0..] .
chunk 5 . (`union` delete 'J' ['A'..'Z']) . nub . process```

bigram encodes or decodes two letters at a time according to the three given rules.

```bigram :: Key -> Int -> Char -> Char -> String
bigram k dir c1 c2
| y1 == y2  = get (x1 + dir, y1) : [get (x2 + dir, y2)]
| x1 == x2  = get (x1, y1 + dir) : [get (x2, y2 + dir)]
| otherwise = get (x2, y1)       : [get (x1, y2)]
where (x1, y1) = head . M.keys \$ M.filter (== c1) k
(x2, y2) = head . M.keys \$ M.filter (== c2) k
get (x,y) = k M.! (mod x 5, mod y 5)```

Encoding consists of inserting Xs in the correct places and then encoding all the bigrams.

```encode' :: Key -> String -> String
encode' _ []       = []
encode' k [x]      = encode' k (x : "X")
encode' k (x:y:xs) | x == y    = encode' k [x] ++ encode' k (y:xs)
| otherwise = bigram k 1 x y ++ encode' k xs```

Decoding is simpler, since there are no special cases there.

```decode' :: Key -> String -> String
decode' k = concatMap (\[x,y] -> bigram k (-1) x y) . chunk 2```

And finally, two convenience functions so we can work with strings directly.

```encode :: String -> String -> String
encode k = encode' (key k) . process

decode :: String -> String -> String
decode k = decode' (key k) . process```

All that remains is to test if everything works correctly:

```main :: IO ()
main = do print \$ encode "PLAYFAIR" "PROGRAMMING PRAXIS"
print \$ decode "PLAYFAIR" "LIVOBLKZEDOELIYWCN"```

And we’re done. Interestingly, if you try to decode the 1943 message, you’ll notice two errors in the result: it says Blackess instead of Blackett and coce instead of cove. I wonder if the errors were made by the original sender or by the first person to type it on a computer.

Anyway, the solution is 24 lines, just over half the size of the Scheme version. That will do nicely.