Advertisement
Guest User

Untitled

a guest
Dec 27th, 2015
41
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. -- Note to self: I probably way overcomplicated this solution
  2. module Vigenere where
  3.  
  4. import qualified Data.Map  as M
  5. import qualified Data.List as L
  6. import Control.Monad.Reader
  7.  
  8. type CharSet = [Char] -- alias for string, used to distinguish from text input
  9. type CipherTable = M.Map Char CharSet
  10. type ReadEnv a = ReaderT CipherEnv Maybe a
  11.  
  12. data CipherEnv = Cipher { cipherChars :: CharSet
  13.                         , cipherTable :: CipherTable
  14.                         } deriving (Show)                                  
  15.  
  16. -- | Creates a character set with no duplicate entries
  17. mkCharSet :: String -> CharSet
  18. mkCharSet = L.nub
  19.  
  20. -- | Generates a row in the character table
  21. genRow :: Char -> CharSet -> CharSet
  22. genRow char charset = b ++ a
  23.   where (a, b) = break (== char) charset
  24.  
  25. -- | Constructs a table from a character set
  26. mkTable :: CharSet -> CipherTable
  27. mkTable charset = M.fromList $ map generator charset
  28.   where generator c = (c, genRow c charset)
  29.  
  30. -- | generates a cryptographic key based on a message and a keyword
  31. --   if the message is "hello there", and the keyword is "apple";
  32. --   then the resulting key will be "appleapplea"
  33. genKey :: String -> String -> String
  34. genKey msg kw = kw `padTo` length msg
  35.   where padTo xs size = take size $ cycle xs
  36.  
  37. -- | gets a row from the table at a specific key k
  38. --   if no row exists, Nothing is returned
  39. getRow ::  Char -> ReadEnv String
  40. getRow k = do
  41.   env <- ask
  42.   row <- lift $ M.lookup k $ cipherTable env
  43.   return row
  44.  
  45. -- | Cryptographic function
  46. --   gets the vth letter on the kth row on the table
  47. encryptLetter :: Char -> Char -> ReadEnv Char
  48. encryptLetter k v = do
  49.   env <- ask
  50.   index <- lift $ L.elemIndex v $ cipherChars env
  51.   row <- getRow k
  52.   return $ row !! index
  53.  
  54. -- | Cryptographic function
  55. --   gets the index of the cth letter on the kth row in the table,
  56. --   then uses that index to find the cth letter in the base
  57. decryptLetter :: Char -> Char -> ReadEnv Char -- base[table[k, c]]
  58. decryptLetter k c = do
  59.   env <- ask
  60.   row <- getRow k
  61.   tableIndex <- lift $ L.elemIndex c row
  62.   let base = cipherChars env
  63.   return $ base !! tableIndex
  64.  
  65. -- | maps a cryptographic function to two strings
  66. crypt :: (Char -> Char -> ReadEnv Char) -> String -> String -> ReadEnv String
  67. crypt f w kw = sequence zipped
  68.   where key = genKey w kw
  69.         zipped = zipWith f key w
  70.  
  71. -- encrypts the string using a message and a keyword
  72. encrypt :: String -> String -> ReadEnv String
  73. encrypt = crypt encryptLetter
  74.  
  75. -- decrypts using a message and a keyword
  76. decrypt :: String -> String -> ReadEnv String
  77. decrypt = crypt decryptLetter
  78.  
  79. mkEnv :: CharSet -> CipherEnv
  80. mkEnv ch = Cipher c $ mkTable c
  81.   where c = mkCharSet ch
  82.  
  83. -- | alias for runReaderT
  84. runEnv :: ReaderT r m a -> r -> m a
  85. runEnv = runReaderT
  86.  
  87. -- testing functions
  88. encodeTest :: IO ()
  89. encodeTest = do
  90.   let characterSet = mkEnv $ " ," ++ ['A' .. 'Z'] ++ ['a' .. 'z']
  91.       message      = "Hello, this is a test"
  92.       keyword      = "bananas"
  93.       cipher       = encrypt message keyword
  94.       result       = runEnv cipher characterSet
  95.   putStrLn $ "Here's the output of running \"" ++ message ++ "\" through the function: "
  96.   putStrLn $ show result
  97.  
  98. decodeTest :: IO ()
  99. decodeTest = do
  100.   let characterSet = mkEnv $ " ," ++ ['A' .. 'Z'] ++ ['a' .. 'z']
  101.       message      = "kEYLbbsUHVSnIkbAnTRSl"
  102.       keyword      = "bananas"
  103.       cipher       = decrypt message keyword
  104.       result       = runEnv cipher characterSet
  105.   putStrLn $ "Here's the output of running \"" ++ message ++ "\" through the function: "
  106.   putStrLn $ show result
Advertisement
RAW Paste Data Copied
Advertisement