In today’s Programming Praxis exercise, our goal is to implement a cipher that hides messages in spam emails. Let’s gets started, shall we?
import Control.Applicative import Data.Bits import Data.Char import Data.List import Data.List.Split (chunk) import System.Random (randomRIO)
First we define the allowed characters (without numbers since they are treated a differently from the rest).
chars :: String chars = ['A'..'Z'] ++ ['a'..'z'] ++ ". "
Neither the key nor the message can contain any other characters, so we make a function to remove all other characters.
sanitize :: String -> String sanitize = flip intersect $ chars ++ ['0'..'9']
Making a key consists of removing duplicate characters, appending the rest and inserting the remaining numbers in their correct places.
makeKey :: String -> String makeKey phrase = addDigits $ union (nub $ sanitize phrase) chars where addDigits = (=<<) (\c -> maybe [c] ((c:) . return) . lookup c $ filter (flip notElem phrase . snd) $ zip ('j':['a'..'i']) ['0'..'9'])
Next, we need a function to encode/decode the pairs of letters.
cipher :: (Int -> Int -> Int) -> String -> [String] -> String cipher op key = (f =<<) where f ~[a,b] | c1 == c2 = [get (op r1 1) c1, get (op r2 1) c2] | r1 == r2 = [get r1 (op c1 1), get r2 (op c2 1)] | otherwise = [get r1 c2 , get r2 c1 ] where (r1,c1) = maybe (0,0) (`divMod` 8) $ elemIndex a key (r2,c2) = maybe (0,0) (`divMod` 8) $ elemIndex b key get r c = key !! (8 * mod r 8 + mod c 8)
The words are loaded from the given dictionary and divided into two lists based on whether their length is even or odd. For every bit of information a random word is selected from the appropriate list.
getWords :: FilePath -> [Bool] -> IO String getWords dict bs = do (evens, odds) <- partition (even . length) . filter (\w -> all isAlpha w && length w < 9) . lines <$> readFile dict let pick xs = fmap (xs !!) $ randomRIO (0, length xs - 1) fmap unwords $ mapM (\b -> pick $ if b then odds else evens) bs
Hiding a message is a matter of doing all the required steps in the right order. Unlike the provided solution I used a 7-bit encoding since it saves me from having to make another lookup table.
hide :: FilePath -> String -> String -> IO String hide dict key = getWords dict . (>>= \c -> map (testBit $ fromEnum c) [0..6]) . cipher (+) key . split . sanitize where split  =  split (a:b:cs) | a /= b = [a,b ] : split cs split (a:cs) = [a,'X'] : split cs
To retrieve the original message we simply undo all the steps.
unhide :: String -> String -> String unhide key = cipher (-) key . chunk 2 . map (toEnum . foldr (flip setBit . fst) 0 . filter snd . zip [0..]) . chunk 7 . map (odd . length) . words
Some tests to see if everything is working properly:
main :: IO () main = do let key = makeKey "President Obama’s visit to a Chrysler plant in Tol\ \edo, Ohio, on Friday was the culmination of a campaign to \ \portray the auto bailouts as a brilliant success with no u\ \npleasant side effects." hidden <- hide "74550com.mon" key "Bonsai Code" putStrLn hidden print $ unhide key hidden == "Bonsai CodeX" let key2 = makeKey "a4b3c2" let msg2 = "abcd1234" print . (== msg2) . unhide key2 =<< hide "74550com.mon" key2 msg2
Yup. Make sure the recipient knows when you’re sending the message though, since it will undoubtedly get caught by the spam filter.