Classic cryptography toolbox: Caesar, Vigenere and ADFGVX ciphers

Question

I wrote a program in haskell that aims to let the user encrypt, decrypt and crack/cryptanalyse pre-electromechanical era ciphers in Haskell. I want to know your opinion on it since this is my first Haskell project and so my approach to it is slightly different from the approach I would make on other languages.

It currently supports Caesar, Vigenere and ADFGVX ciphers and lets the user crack the first two. It also lets the user perform some cryptanalysis methods like count letter/substring frequencies and substituting letters until the user is satisfied with the result.

My code has a lot of functions defined on the top-level so I'm starting to get a bit worried if I should have defined some of them locally. I'm also a bit worried about the types of my functions because maybe some of them could be more generalized.

Please bear in mind, that the Vigenere cracking and the ADFGVX implementations have still some work to do. As for the Vigenere cracking, the user has to manually enter the mininum and maximum size of the words that are repeated along the ciphertext to be searched for (Kasiski algorithm) and the ADFGVX encryption and decryption still doesn't work 100% because i'm filling the ciphertext with the letter 'a' until it fits totally on the grid.

I will show you all the modules starting from the CLI (since it acts as the main method).

cct.hs

import Control.Monad import System.Exit import System.IO import MyUtils import Ciphers.Caesar import Ciphers.Vigenere import Ciphers.ADFGVX import Codebreaking.Cryptanalysis import Codebreaking.VigenereCrack caesarEncryption = do clearAll putStrLn "" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "Enter the shift number:" shift <- getLine putStrLn "Enter the message:" message <- getLine let shift_int = (read shift :: Int) --convert input to int let ciphertext = caesarShift shift_int message clearAll putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "Ciphertext:" print (ciphertext) putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "Press any key to return to the main menu." input <- getLine main vigenereEncryption = do clearAll putStrLn "" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "Enter the desired keyword:" key <- getLine putStrLn "Enter the message:" message <- getLine let ciphertext = vigenereEncrypt key message clearAll putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn ("Ciphertext:") print (ciphertext) putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "Press any key to return to the main menu." input <- getLine main adfgvxEncryption = do clearAll putStrLn "" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "The program will now read the substitution key from my_grid.txt." putStrLn "Do you want to change it (y/n)?" input1 <- getLine when (input1 == "y") (do createSubstitutionKey; putStrLn "Substitution key created.") handle <- openFile "my_grid.txt" ReadMode substitution_key <- hGetContents handle putStrLn "Enter the desired keyword:" key <- getLine putStrLn "Enter the message:" message <- getLine let ciphertext = adfgvxEncrypt substitution_key key message clearAll putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn ("Ciphertext:") print (ciphertext) putStrLn "\nDon't forget to share the substitution key with the recipient" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "Press any key to return to the main menu." input2 <- getLine main caesar_decryption = do clearAll putStrLn "" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "Enter the shift number:" shift <- getLine putStrLn "Enter the message:" message <- getLine let shift_int = (read shift :: Int) --convert input to int let plaintext = caesarShift (-shift_int) message clearAll putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "Plaintext:" print (plaintext) putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "Press any key to return to the main menu." input <- getLine main vigenereDecryption = do clearAll putStrLn "" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "Enter the keyword:" key <- getLine putStrLn "Enter the message:" message <- getLine let plaintext = vigenereDecrypt key message clearAll putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn ("Plaintext:") print (plaintext) putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "Press any key to return to the main menu." input <- getLine main adfgvxDecryption = do clearAll putStrLn "" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "The program will now read the substitution key from my_grid.txt." handle <- openFile "my_grid.txt" ReadMode substitution_key <- hGetContents handle putStrLn "Enter the keyword:" key <- getLine putStrLn "Enter the message:" message <- getLine let plaintext = adfgvxDecrypt substitution_key key message clearAll putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn ("Plaintext:") print (plaintext) putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "Press any key to return to the main menu." input <- getLine main decryption = do clearAll putStrLn "" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "::1 - Caesar's cipher ::" putStrLn "::2 - Vigenere's cipher ::" putStrLn "::3 - ADFGVX ::" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "::r - Return e - Exit ::" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" input <- getLine case input of "1" -> caesar_decryption "2" -> vigenereDecryption "3" -> adfgvxDecryption "r" -> main "e" -> exitSuccess otherwise -> do putStrLn "" putStrLn ("Please enter a valid option") encryption encryption = do clearAll putStrLn "" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "::1 - Caesar's cipher ::" putStrLn "::2 - Vigenere's cipher ::" putStrLn "::3 - ADFGVX ::" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "::r - Return e - Exit ::" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" input <- getLine case input of "1" -> caesarEncryption "2" -> vigenereEncryption "3" -> adfgvxEncryption "r" -> main "e" -> exitSuccess otherwise -> do putStrLn "" putStrLn ("Please enter a valid option") encryption tools :: String -> String -> IO() tools ciphertext guess = forever $ do putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "Ciphertext:" print (ciphertext) putStrLn "" putStrLn "My guess:" print (guess) putStrLn "" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "::0 - Display the letter frequency in descending order ::" putStrLn "::1 - Break Caesar's cipher ::" putStrLn "::2 - Break Vigenere's cipher (Babbage/Kasiski Algorithm) ::" putStrLn "::3 - Get repeated substrings ::" putStrLn "::4 - Count the occurrences of a substring ::" putStrLn "::5 - Count the occurrences of a letter immediately before/after other letters ::" putStrLn "::6 - Count the occurrences of a letter immediately before other letters ::" putStrLn "::7 - Count the occurrences of a letter immediately after other letters ::" putStrLn "::8 - Substitute a letter by another in the ciphertext ::" putStrLn "::r - Return ::" putStrLn "::e - Exit ::" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" input <- getLine case input of "0" -> do putStrLn "" putStrLn "Letter frequency:" print (sortAlphabetCount ciphertext) putStrLn "" "1" -> do putStrLn "" print(breakCaesar ciphertext) putStrLn "" "2" -> do putStrLn "" putStrLn "For this tool to work it is necessary to find some substrings that have multiple occurrences along the ciphertext." crackVigenere ciphertext "3" -> do putStrLn "" putStrLn "Enter the minimum size of the substrings to be searched for:" min_size <- getLine putStrLn "Enter the maximum size of the substrings to be searched for:" max_size <- getLine let min_size_int = (read min_size :: Int) max_size_int = (read max_size :: Int) putStrLn "Repeated substrings:" print (repeatedSubs min_size_int max_size_int ciphertext) "4" -> do putStrLn "" putStrLn "Enter the substring:" substring <- getLine putStrLn "Occurrences:" print(countSubstring substring ciphertext) putStrLn "" "5" -> do putStrLn "" putStrLn "Enter the letter(between ''):" letter <- getLine let letter_char = (read letter :: Char) putStrLn "Occurrences:" print(countAllNeighbours letter_char ciphertext) putStrLn "" "6" -> do putStrLn "" putStrLn "Enter the letter(between ''):" letter <- getLine let letter_char = (read letter :: Char) putStrLn "Occurrences:" print(countAllBefore letter_char ciphertext) putStrLn "" "7" -> do putStrLn "" putStrLn "Enter the letter(between ''):" letter <- getLine let letter_char = (read letter :: Char) putStrLn "Occurrences:" print(countAllAfter letter_char ciphertext) putStrLn "" "8" -> do putStrLn "" putStrLn "Enter the letter(between '') you wish to substitute:" letter1 <- getLine let letter1_char = (read letter1 :: Char) putStrLn "Enter the letter(beween '') to substitute by:" letter2 <- getLine let letter2_char = (read letter2 :: Char) new_ciphertext = substitute letter1_char letter2_char guess putStrLn "New ciphertext:" print(new_ciphertext) tools ciphertext new_ciphertext "r" -> main "e" -> exitSuccess otherwise -> do putStrLn "" putStrLn ("Please enter a valid option") tools ciphertext guess crack = do clearAll putStrLn "" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "Enter the message:" ciphertext <- getLine tools ciphertext ciphertext main = forever $ do clearAll putStrLn "" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn ":: /$$$$$$ /$$$$$$ /$$$$$$$$ ::" putStrLn ":: /$$__ $$ /$$__ $$ |__ $$__/ ::" putStrLn "::| $$ __/ /$$ /$$ | $$ __/ /$$ /$$| $$ ::" putStrLn "::| $$ |__/|__/| $$ |__/|__/| $$ ::" putStrLn "::| $$ | $$ | $$ ::" putStrLn "::| $$ $$ /$$ /$$| $$ $$ /$$ /$$| $$ ::" putStrLn "::| $$$$$$/|__/|__/| $$$$$$/|__/|__/| $$ ::" putStrLn ":: |______/ |______/ |__/ ::" putStrLn "::::::::Classic Cryptography Toolbox:::::::::::::::::::::::::::::::::::::::::::::" putStrLn ":: ::" putStrLn "::What would you like to do? ::" putStrLn ":: ::" putStrLn "::1 - Encrypt a message ::" putStrLn "::2 - Decrypt a message ::" putStrLn "::3 - Cryptanalyse an encrypted message ::" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" putStrLn "::e - Exit ::" putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" input <- getLine case input of "1" -> encryption "2" -> decryption "3" -> crack "e" -> exitSuccess otherwise -> do putStrLn "" putStrLn ("Please enter a valid option") main

MyUtils.hs

module MyUtils where import Data.Char import Data.List import System.Console.ANSI import System.Random --lowercase letter to int conversion let2int :: Char -> Int let2int c = ord c - ord 'a' --int to lowercase letter conversion int2let :: Int -> Char int2let n = chr(ord 'a' + n) --converts an entire string an array of ints (each char -> int) text2ints :: String -> [Int] text2ints xs = map (let2int) xs --convrets an array of ints into a string (each int -> char) ints2text :: [Int] -> String ints2text xs = map (int2let) xs --shifts the given lowercase letter n positions shift :: Int -> Char -> Char shift n c |isLower c = int2let((let2int c + n) `mod` 26) |otherwise = c --gets the factors of n factors :: Int -> [Int] factors n = [x |x<-[2..n], n`mod`x == 0] --deletes all occurrences of an element within a list deleteAll :: Eq a => a -> [a] -> [a] deleteAll x s = filter (/=x) s --gives a list of all the elements that have multiple occurrences within a list equals :: Eq a => [a] -> [a] equals [] = [] equals (x:xs) |elem x xs = x : equals (deleteAll x xs) |otherwise = equals xs --gives a list of all the elements that are common to all the lists within a list of lists commonElems :: Eq a => [[a]] -> [a] commonElems l = equals [x | y<-l, x<-y, length (filter (elem x) l) == length l] --gives a list of all the factors in common to all the integers in a list commonFactors :: [Int] -> [Int] commonFactors xs |length xs == 1 = factors (head (xs)) |otherwise = commonElems [factors x | x<-xs] --gives a list of the indexes of each occurrence of a substring within a string matchIndices :: (Eq a, Num b, Enum b) => [a] -> [a] -> [b] matchIndices needle = map fst . filter (isPrefixOf needle . snd) . zip [0..] . tails --gives a list of the lengths between each consecutive occurrences of a substring within a string spaceBetween :: String -> String -> [Int] spaceBetween needle = diffs . matchIndices needle -- calculates the difference between each consecutive index where diffs xs = zipWith (flip(-)) xs (tail xs) --count the space between the first occurrence of a subtring and the next occurrence within a string repeatSpacing :: String -> String -> Int repeatSpacing substring ciphertext |spaceBetween substring ciphertext == [] = 0 |otherwise = head (spaceBetween (substring) (ciphertext)) --gives a list of the lengths between the first occurrence of multiple substrings and the next respective occurrence multRepeatSpacing :: [String] -> String -> [Int] multRepeatSpacing substrings ciphertext = [y | x<-substrings, y<-[repeatSpacing x ciphertext]] --gets all chars n chars away from each other getSpacedLetters :: Int -> String -> String getSpacedLetters n (x:xs) |n > length xs = [x] |otherwise = x : getSpacedLetters n (drop (n-1) xs) --gets all chars "size" chars away from each other starting from the nth position getNthSpacedLetters :: Int -> Int -> String -> String getNthSpacedLetters size n s |n > length s = "" |otherwise = getSpacedLetters size (drop (n-1) s) --removes all tuples with x as fst removeAllTuplesByInt :: Int -> [(a,Int)] -> [(a,Int)] removeAllTuplesByInt x [] = [] removeAllTuplesByInt x list |snd (head list) /= x = head list : removeAllTuplesByInt x (tail list) |otherwise = removeAllTuplesByInt x (tail list) --gets the index of a char in a dictionary of type [(Char,Integer)] getDictIndex :: Eq a => a -> [(a,Integer)] -> Integer getDictIndex c [key] |c == fst key = snd key |otherwise = error "no such element" getDictIndex c dict |c == fst (head dict) = snd (head dict) |otherwise = getDictIndex c (tail dict) --gives a list of the elements in a list withou repeating them delRepeated :: Eq a => [a] -> [a] delRepeated [] = [] delRepeated list = x : delRepeated (deleteAll x (tail list)) where x = head list --clears the terminal and sets the cursor position to 0 0 clearAll :: IO() clearAll = do clearScreen setCursorPosition 0 0 --converts something of type a into the corresponding value of type b in a dictionary of the type [(b,a)] convertTo :: Eq a => a -> [(b,a)]-> b convertTo x [] = error ("int not found in the dict") convertTo x dict |x == (snd (head dict)) = fst (head dict) |otherwise = convertTo x (tail dict) convertFrom :: Eq a => a -> [(a,b)] -> b convertFrom x [] = error ("not found in the dict") convertFrom x dict |x == (fst (head dict)) = snd (head dict) |otherwise = convertFrom x (tail dict) --converts an entire list into the corresponding dictionary values toDictValue :: Eq a => [a] -> [(b,a)] -> [b] toDictValue ns dict = map (\x -> convertTo x dict) ns --generates a list of different random integers from n1 to n2 of size n2 genRandNrs :: Integer -> Integer -> IO([Integer]) genRandNrs n1 n2 = do g <- newStdGen return (take (fromIntegral n2) (nub (randomRs (n1,n2) g :: [Integer]))) --groups the given list in a list of lists in, n by n groupN:: Int -> [a] -> [[a]] groupN 0 _ = [] groupN size [] = [] groupN size s = (take (size) s) : groupN size (drop size s)

Cryptanalysis.hs

module Codebreaking.Cryptanalysis where import Data.Char import Data.List import Data.Function import MyUtils alphabet = "abcdefghijklmnopqrstuvwxyz" --most to least frequent letters in english with respective index etaoin = zip "etaoinshrdlcumwfgypbvkjxqz" [1..] en_letter_most_freq = "etaoin" --most frequent english letters en_letter_least_freq = "vkjxqz" --least frequent english letters --counts the number of ocurrences of a char in a string count :: Char -> String -> Int count a [x] |a == x = 1 |otherwise = 0 count a (x:xs) |a == x = 1 + count a xs |otherwise = count a xs --counts the numbers of ocurrences of a string in another string countSubstring :: String -> String -> Int countSubstring s1 s2 |length s1 > length s2 = 0 |take (length s1) s2 == s1 = 1 + countSubstring s1 (drop 1 s2) |otherwise = countSubstring s1 (drop 1 s2) --given a number m and a string, finds all the substrings with size n that have multiple occurrences on the given string repeatedSubsBySize :: Int -> String -> [String] repeatedSubsBySize n [] = [] repeatedSubsBySize n s |countSubstring (take n s) s > 1 = (take n s) : repeatedSubsBySize n (drop 1 s) |otherwise = repeatedSubsBySize n (drop 1 s) --finds all the substrings with sizes between n1 and n2 that have multiple occurrences on the given string repeatedSubs :: Int -> Int -> String -> [String] repeatedSubs n1 n2 [] = [] repeatedSubs n1 n2 s = [sub | n<-[n1..n2], sub<-repeatedSubsBySize n s] --counts the number of ocurrences of each letter of the alphabet in a string countAlphabet :: String -> [(Char, Int)] countAlphabet s = [(letter,occurs) | letter<-alphabet, occurs<-[count letter s]] --outputs the result of count alphabet from the most frequent letter to the least sortAlphabetCount :: String -> [(Char, Int)] sortAlphabetCount s = reverse (sortOn (snd) (countAlphabet s)) --substitutes all occurrences of c1 by c2 on the given string substitute :: Char -> Char -> String -> String substitute c1 c2 [] = [] substitute c1 c2 (x:xs) |c1 == x = toUpper c2 : substitute c1 c2 xs |otherwise = x : substitute c1 c2 xs --counts the occurrences of c1 immediately before c2 countBefore :: Char -> Char -> String -> Int countBefore c1 c2 [x] = 0 countBefore c1 c2 (x:xs) |head xs == c2 && x == c1 = 1 + countBefore c1 c2 xs |otherwise = 0 + countBefore c1 c2 xs --counts the occurrences of c1 immediately after c2 countAfter :: Char -> Char -> String -> Int countAfter c1 c2 [x] = 0 countAfter c1 c2 (x:xs) |x == c2 && head xs == c1 = 1 + countAfter c1 c2 xs |otherwise = 0 + countAfter c1 c2 xs -- counts the ocurrences of c1 immediately before or after c2 countNeighbours :: Char -> Char -> String -> Int countNeighbours c1 c2 s = (countBefore c1 c2 s) + (countAfter c1 c2 s) --counts the occurrences of c immediately before or after every letter of the alphabet countAllNeighbours :: Char -> String -> [(Char, Int)] countAllNeighbours c s = [(letter, occurs) | letter<-alphabet, occurs<-[countNeighbours c letter s]] --counts the occurrences of c immediately before every letter of the alphabet countAllBefore :: Char -> String -> [(Char, Int)] countAllBefore c s = [(letter, occurs) | letter<-alphabet, occurs<-[countBefore c letter s]] --counts the occurrences of c immediately after every letter of the alphabet countAllAfter :: Char -> String -> [(Char, Int)] countAllAfter c s = [(letter, occurs) | letter<-alphabet, occurs<-[countAfter c letter s]] --attributes a letter frequency score to the first 6 letters in a string matchFreqScoreFirst :: String -> Int matchFreqScoreFirst [] = 0 matchFreqScoreFirst s |elem (head sorted_first) en_letter_most_freq = 1 + matchFreqScoreFirst (drop 1 sorted_first) |otherwise = 0 + matchFreqScoreFirst (drop 1 sorted_first) where sorted_first = take 6 s --attributes a letter frequency score to the last 6 letters in a string matchFreqScoreLast :: String -> Int matchFreqScoreLast [] = 0 matchFreqScoreLast s |elem (head sorted_last) en_letter_least_freq = 1 + matchFreqScoreLast (drop 1 sorted_last) |otherwise = 0 + matchFreqScoreLast (drop 1 sorted_last) where sorted_last = take 6 (reverse s) --sorts the strings in the tuple in reverse ETAOIN order reverseEtaoinSortFreqs :: [(Int, String)] -> [(Int, String)] reverseEtaoinSortFreqs [] = [] reverseEtaoinSortFreqs [x] |length (snd x) > 1 = [(fst x, reverseEtaoinSort (snd x))] |otherwise = [x] reverseEtaoinSortFreqs (x:xs) |length (snd x) > 1 = (fst x, reverseEtaoinSort (snd x)) : reverseEtaoinSortFreqs xs |otherwise = x : reverseEtaoinSortFreqs xs --gives a list of frequencies and the respective group of letters sortFreqToLetters :: String -> [(Int, String)] sortFreqToLetters s = reverseEtaoinSortFreqs [(snd (head gr), map fst gr) | gr <- groupBy ((==) `on` snd) (sorted_freqs)] where sorted_freqs = (sortAlphabetCount s) --inserts a letter in a "reverse_etaoin" ordered string keeping its order reverseEtaoinInsert :: Char -> String -> String reverseEtaoinInsert c [] = [c] reverseEtaoinInsert c (x:xs) |(getDictIndex c etaoin) > (getDictIndex x etaoin) = c : x : xs |otherwise = x : reverseEtaoinInsert c xs --sorts a string in reverse ETAOIN order reverseEtaoinSort :: String -> String reverseEtaoinSort [] = [] reverseEtaoinSort (x:xs) = reverseEtaoinInsert x (reverseEtaoinSort xs) --gives the 2 highest ints in lust of (Char,Int) getHighestFreqScores :: [(Char,Int)] -> [Int] getHighestFreqScores scores = [maximum (map (snd) scores),maximum (map (snd) rest)] where rest = removeAllTuplesByInt (maximum (map (snd) scores)) scores --outputs the letters corresponding to the given highest freq scores getHighestLetters :: [Int] -> [(Char,Int)] -> String getHighestLetters highest_scores [] = [] getHighestLetters highest_scores scores |elem (snd (head scores)) highest_scores = fst (head scores) : getHighestLetters highest_scores (tail scores) |otherwise = getHighestLetters highest_scores (tail scores) --given a reverse_etaoin sorted string, attributes a frequency match score matchFreqScore :: String -> Int matchFreqScore s = matchFreqScoreFirst s + matchFreqScoreLast s --gets the reverse etaoin sorted string of a string sortedEtaoinString :: String -> String sortedEtaoinString x = concat (map (snd) (init (sortFreqToLetters x)))

Caesar.hs

module Ciphers.Caesar where import MyUtils import Data.Char --encrypts(n) or decrypts(-n) caesarShift :: Int -> String -> String caesarShift n xs = [shift n x | x <- map (toLower) xs] --given a string, shifts it 26 times and generates a list with all of the shifted strings --one of the elements might mean something breakCaesar :: String -> [String] breakCaesar xs = [s | n<-[(0)..(25)], s<- [caesarShift (-n) (map (toLower) xs)]]

Vigenere.hs

module Ciphers.Vigenere where import MyUtils import Data.Char --encrypts the plaintext with the given key vigenereEncrypt :: String -> String -> String vigenereEncrypt key plaintext = ints2text result where result = map (`mod` 26) (zipWith (+) keyCycle intPlainText) keyCycle = (cycle(text2ints key)) intPlainText = text2ints (map (toLower) (filter (isAlphaNum) plaintext)) --decrypts the ciphertext with the given key vigenereDecrypt :: String -> String -> String vigenereDecrypt key ciphertext = ints2text result where result = map (`mod` 26) (zipWith (-) intciphertext keyCycle) keyCycle = (cycle(text2ints key)) intciphertext = text2ints (map (toLower)(filter (isAlphaNum) ciphertext))

ADFGVX.hs

module Ciphers.ADFGVX where import Control.Monad import System.Directory import Data.List import Data.Char import Data.Maybe import MyUtils grid = sequence ["adfgvx","adfgvx"] alpha_nums = zip ['a'..'z'] [1..] ++ zip ['0'..'9'] [27..] --creates a file with a random substitution key createSubstitutionKey :: IO() createSubstitutionKey = do let filename = "my_grid.txt" fileExists <- doesFileExist (filename) when fileExists (removeFile filename) rands <- genRandNrs 1 36--random list of alpha_nums indexes writeFile filename (toDictValue rands alpha_nums) --fills the ADFGVX grid with the given string fillGrid :: String -> [(String,Char)] fillGrid s = zip grid s --substitutes all chars in a string for their respecive value in the ADFGVX grid substitutionStep :: String -> [(String,Char)] -> String substitutionStep plaintext filled_grid = concat (toDictValue plaintext filled_grid) --attributes each letter in the ciphertext to each letter of the key in a cyclic fashion --if the the ciphertext leaves blank spaces on the gird, fills it with encrypted 'a's createKeyGrid :: String -> String -> [(Char,Char)] createKeyGrid key ciphertext = zip (cycle key) fit_ciphertext where fit_ciphertext = if length (ciphertext) `mod` length (key) == 0 then ciphertext else ciphertext ++ replicate (rest) 'a' rest = length key - length (ciphertext) `mod` length (key) --sorts the key grid columns in alphabetical order sortKeyGrid :: String -> [(Char,Char)] -> [(Char,Char)] sortKeyGrid key [] = [] sortKeyGrid key keygrid = sortOn (fst) (take (length key) keygrid) ++ (sortKeyGrid key (drop (length key) keygrid)) --ouputs the key grid with the columns as lines groupByCols :: Eq a => [(a,b)] -> [(a,b)] groupByCols [] = [] groupByCols [x] = [x] groupByCols (x:xs) = [x] ++ (filter (\t -> fst(t) == fst(x)) xs) ++ groupByCols (filter (\t2 -> fst(t2) /= fst(x)) xs) --gives the elements of the key grid as a string transpositionStep :: String -> [(Char,Char)] -> String transpositionStep key keygrid = map (snd) (groupByCols sorted_keygrid) where sorted_keygrid = sortKeyGrid key keygrid --given a key, sorts the key and fills the grid the same way it was on the encryption process recreateKeyGrid :: String -> String -> [(Char,String)] recreateKeyGrid key ciphertext = zip (sorted_key) (groupN nrows ciphertext) where nrows = cipher_text_size `div` key_size sorted_key = sort key cipher_text_size = length ciphertext key_size = length key --sorts the columns of the grid by the order of the password unSortKeyGrid :: String -> [(Char,String)] -> [(Char,String)] unSortKeyGrid key [] = [] unSortKeyGrid key keygrid = found : unSortKeyGrid (drop 1 key) (delete found keygrid) where found = fromJust (find (\x -> fst(x) == head key) keygrid) --get the untransposed text from the unsorted grid getPreCipherText :: [(Char,String)] -> [String] getPreCipherText keygrid = groupN 2 [s | n<-[1..nrows], s<-getNthSpacedLetters (nrows) n gridstring]--(map (head) (map (snd) keygrid)) ++ getPreCipherText (map (tail) (map (snd) keygrid)) where gridstring = concat (map (snd) keygrid) nrows = length (snd (head keygrid)) --converts the untransposed text into plaintext getPlainText :: [String] -> [(String,Char)] -> String getPlainText preciphertext adfgvxgrid = map (\x -> convertFrom x adfgvxgrid) preciphertext --encryption algorithm adfgvxEncrypt :: String -> String -> String -> String adfgvxEncrypt substitution_key key plaintext = transpositionStep key keygrid where keygrid = createKeyGrid key ciphertext1 ciphertext1 = substitutionStep (filter (isAlphaNum) (map (toLower) plaintext)) my_grid my_grid = fillGrid substitution_key --decryption algorithm adfgvxDecrypt :: String -> String -> String -> String adfgvxDecrypt substitution_key key ciphertext = getPlainText preciphertext my_grid where my_grid = fillGrid substitution_key preciphertext = getPreCipherText (unSortKeyGrid key keygrid) keygrid = recreateKeyGrid key ciphertext

VigenereCrack.hs

module Codebreaking.VigenereCrack where import Ciphers.Caesar import Ciphers.Vigenere import Codebreaking.Cryptanalysis import MyUtils import Control.Monad import System.Exit import System.Console.ANSI import Control.Concurrent import Data.Function --given two numbers representing the min and max size of the substrings that may repeat along the ciphertext and the ciphertext gives a list of all the possible lengths of the vigenere key guessKeyLength :: Int -> Int -> String -> [Int] guessKeyLength n1 n2 ciphertext = commonFactors (multRepeatSpacing (repeatedSubs n1 n2 ciphertext) ciphertext) --given a list of possible keysizes and the ciphertext, splits the ciphertext into subkey parts for each possible keysize groupBySubkeys :: [Int] -> String -> [(Int,String)] groupBySubkeys sizes ciphertext = [(keysize,x) | keysize<-sizes, n<-[1..keysize], x<-[getNthSpacedLetters keysize n ciphertext]] --attributes a frequency score to each caesar shift of the string subkeyScores :: String -> [(Char,Int)] subkeyScores s = zip alphabet [matchFreqScore shifted | shifted <- map (sortedEtaoinString) (breakCaesar s)] --filters the most likely subkeys out of the string filterSubkey :: (Int,String) -> (Int,String) filterSubkey subkey_group = (keysize, candidates) where keysize = fst subkey_group string = snd subkey_group candidates = getHighestLetters (getHighestFreqScores (subkeyScores (string))) (subkeyScores (string)) --outputs the possible subkeys for each position of each possible key size possibleSubkeys :: [(Int,String)] -> [(Int,String)] possibleSubkeys subkey_groups = map (filterSubkey) subkey_groups --given a keysize, ouputs the components of the key getKeysizeGroup :: Int -> [(Int,String)] -> [(Int,String)] getKeysizeGroup x group = filter (\i -> fst i == x) group --given a list of possible subkeys and the respective keysize, gives a list of all the keys for all the possible keysizes possibleKeys :: [(Int,String)] -> [String] possibleKeys subkeys = [ key | keysize <- keysizes, key<-keys keysize] where keysizes = delRepeated (map (fst) subkeys) keys x = sequence (map (snd) (getKeysizeGroup x subkeys)) --tries all the keys bruteForceKeys :: [String] -> String -> IO() bruteForceKeys [] ciphertext = putStrLn "\nDone" bruteForceKeys keys ciphertext = do let key = head keys putStrLn "" putStrLn ("Attempting with key: " ++ key ++ " :") threadDelay 500000 print(vigenereDecrypt key ciphertext) bruteForceKeys (drop 1 keys) ciphertext --kasiski Algorithm --user interaction crackVigenere :: String -> IO() crackVigenere ciphertext = do putStrLn "Enter min size of repeated words:" readMin <- getLine putStrLn "Enter max size of repeated words:" readMax <- getLine let minsize = (read readMin :: Int) maxsize = (read readMax :: Int) let key_lengths = guessKeyLength minsize maxsize ciphertext --putStrLn "Possible key lengths:" clearAll putStrLn "Possible keys:" putStrLn "Calculating possible key lengths..." --print (key_lengths) let subkey_groups = groupBySubkeys key_lengths ciphertext --putStrLn "Subkey groups for each possible key size:" --print (subkey_groups) let subkeys = possibleSubkeys subkey_groups --putStrLn "Possible subkeys:" --print (subkeys) let keys = possibleKeys subkeys print (keys) forever $ do putStrLn "1 - Try a key" putStrLn "2 - Brute-force attack" putStrLn "r - Retry" putStrLn "e - Exit" input <- getLine case input of "1" -> do key <- getLine let plaintext = vigenereDecrypt key ciphertext print (plaintext) "2" -> bruteForceKeys keys ciphertext "r" -> crackVigenere ciphertext "e" -> exitSuccess otherwise -> do putStrLn "Please enter a valid option." exitFailure ```

sshine · Accepted Answer · 2019-04-30 07:37:01Z

First some comments related to your module structure:

You may want to mirror the module structure of the cryptonite and crypto-api packages, which are the most popular cryptography packages on Hackage; Crypto.Cipher.Caesar, Crypto.Cipher.Vigenere, etc.
You may want to place the Vigenere crack implementation in Crypto.Cipher.Vigenere.Crack, call the method crack rather than crackVigenere (since the cipher is implied by the module), and only export crack:
```
module Crypto.Cipher.Vigenere.Crack ( crack ) where ... 
```
as this provides a clean interface to the algorithm.

If, for some reason, you wish to export the internal functions (such that they may be used by other modules), a common thing to do is to place the actual implementation in a module called Crypto.Cipher.Vigenere.Crack.Impl, and in the module Crypto.Cipher.Vigenere.Crack import this Impl but only export the public interface. This means that users of your library will know that Impl might change and should be referred to at their own risk, whereas Crack has a stable interface.

If you import these modules using qualified, you don't need to prefix each combinator as caesarEncrypt, vigenereEncrypt, etc. You can instead write e.g.

import qualified Crypto.Cipher.Caesar as Caesar import qualified Crypto.Cipher.Vigenere as Vigenere ... Caesar.encrypt ... ... Vigenere.decrypt ...

Give your modules a common interface, so it's Caesar.encrypt, Caesar.decrypt, Vigenere.encrypt, Vigenere.decrypt, and finally break or crack in the corresponding implementations, whichever you choose.
In the ADFGVX module in particular, and also in general, consider placing the high-level definitions / the definitions you aim to explicitly export, such as encrypt and decrypt, first in the file and all its helper definitions below. This provides more clarity when reading the code.
The Codebreaking.Cryptanalysis module is only used in the Vigenere cipher, so perhaps name this accordingly as e.g. Crypto.Cipher.Vigenere.Analysis to clarify what its use is.
Since the cryptonite package already has a module Crypto.Cipher.Utils, adding your MyUtils under this name may conflict with use-cases where you wish to use both packages simultaneously.

Secondly some low-level comments related to your syntax and helper functions:

As Michael Chav suggested, you may want to use quasi quotation on your longer strings. As an additional suggestion, you may want to consider the module Data.FileEmbed to move your very long formattable strings to a separate file:
```
import Data.FileEmbed (embedStringFile) someVeryLongStringWithWhitespaceFormatting :: String someVeryLongStringWithWhitespaceFormatting = $(embedStringFile "path/to/foo.txt") 
```
But for your terminal user-interface, you may want to use a library for building this; there are quite a lot out there, and I can only personally recommend brick, but there are also byline, cli, haskeline, HCL and structured-cli.

Depending on whether you choose one of these or not, cct.hs could see some refactoring on its own that warrants its own code review, I think. Mainly there's a lot of UI-related code duplication and some separation of displaying the UI and reacting to input that could be separated. E.g. FRP with Brick would enforce that.
Consider using HLint as it will provide you with a lot of helpful warnings about redundant parentheses and formatting; I won't comment on these, but there's for example quite a lot of parentheses that are not necessary and do not improve reading (one case is map (toLower) xs).
I assume the intent with MyUtils is to extract the most generic helper functions you've used. But it seems to me that a lot of these are dead (no longer used) or only used in one cipher. I understand that some of these helper functions are used by other helper functions inside MyUtils.

And finally, perhaps, generic functions used in multiple ciphers?

I'd recommend not extracting things to a common place until you need them in two places, and not export functions that are not expected to be used outside of a library. There's a principle to back this up somewhere, but I can only think of premature generalization right now.

If this completely eradicates MyUtils, that's good.

Notice that cryptonite's Crypto.Cipher.Utils only has a single definition.
As another point of comparison with the cryptonite package, you'll notice that it works on Data.ByteArray. Since your ciphers are not binary but letter-based, this is not really appropriate, but have you considered Data.Text for more efficient representation of strings? See the String Types tutorial by FPComplete for an intro.
Avoid a mixture of CamelCase and snake_case. You have both adfgvxEncryption and caesar_decryption.

You don't want as complex machinery as in Crypto.Cipher.Types, but you may want to create some type aliases to convey the meaning behind the many String and Int arguments.

E.g. instead of

caesarShift :: Int -> String -> String caesarShift n xs = [shift n x | x <- map (toLower) xs] ... vigenereEncrypt :: String -> String -> String vigenereEncrypt key plaintext = ...

you can have

type CaesarKey = Int encrypt :: CaesarKey -> String -> String encrypt key plaintext = map (shift key . toLower) plaintext ... type VigenereKey = String encrypt :: VigenereKey -> String -> String encrypt key plaintext = ...

The vigenereEncrypt function is nicely written in the sense of its use of combinators, so you're using Haskell's standard library quite well. Stylistically I might prefer to rewrite

vigenereEncrypt :: String -> String -> String vigenereEncrypt key plaintext = ints2text result where result = map (`mod` 26) (zipWith (+) keyCycle intPlainText) keyCycle = (cycle(text2ints key)) intPlainText = text2ints (map (toLower) (filter (isAlphaNum) plaintext))

into

encrypt :: VigenereKey -> String -> String encrypt key plaintext = ints2text . encrypt' . text2ints $ plaintext' where encrypt' = map (`mod` 26) . zipWith (+) (cycle key') plaintext' = map toLower (filter isAlphaNum plaintext) key' = text2ints key

although I'm still a little unsatisfied with the name and use of text2ints and ints2text.

Hope it helps.

Thanks! Most detailed comment so far. I really appreciate it. I'm currently cleaning the CLI part (from 300 lines to 120) and i will deal with the modulation next, then the types and finally some efficiency tweaks before proceding to tune the logic itself. Do you think this is a good way to go? — Guilherme Lima
– Guilherme Lima, Commented Apr 29, 2019 at 14:33

Felix · Accepted Answer · 2019-04-27 22:20:59Z

I'd also maybe suggest making helper functions for pretty printing to the terminal.

screenLength :: Int screenLength = 82 colons :: Int -> String colons = flip replicate ':' printFill :: IO () printFill = putStrLn $ colons screenLength printFillT :: String -> IO () printFillT s = do putStrLn $ begin ++ fillSpace ++ end when (not $ null rest) $ printFillT rest where (fstStr, rest) = splitAt (screenLength - 6) s begin = ":: " ++ fstStr end = "::" fillSpace = replicate (screenlength - length begin - length end) ' ' printTitle :: String -> IO () printTitle s = putStrLn $ begin ++ s ++ end where begin = colons 8 end = colons $ screenLength - length begin - length s

This way, your main functions will look a lot cleaner, and they're reusable everywhere, so there's less putStrLns filling the code:

logo :: [String] logo = [ " /$$$$$$ /$$$$$$ /$$$$$$$$" , " /$$__ $$ /$$__ $$ |__ $$__/" , "| $$ __/ /$$ /$$ | $$ __/ /$$ /$$| $$" , "| $$ |__/|__/| $$ |__/|__/| $$" , "| $$ | $$ | $$" , "| $$ $$ /$$ /$$| $$ $$ /$$ /$$| $$" , "| $$$$$$/|__/|__/| $$$$$$/|__/|__/| $$" , " \______/ \______/ |__/" ] printMenu :: IO () printMenu = do putStrLn "" printFill mapM_ printFillT logo printTitle "Classic Cryptography Toolbox mapM_ printFillT menu printFill printFillT "e - Exit" printFill where menu = [ "" , "What would you like to do?" , "" , "1 - Encrypt a message" , "2 - Decrypt a message" , "3 - Cryptanalyse an encrypted message" , "" ] main = forever $ do clearAll printMenu input <- getLine case input of "1" -> encryption "2" -> decryption "3" -> crack "e" -> exitSuccess otherwise -> do putStrLn "" putStrLn $ "Please enter a valid option" ```

thanks for the suggestion. yeah i thought so. i'm currently working on a very simple CLI framework to aid me on this project and also in future ones — Guilherme Lima
– Guilherme Lima, Commented Apr 27, 2019 at 23:10

Michael Chav · Accepted Answer · 2019-04-27 16:31:46Z

Some quick initial comments - will edit as I move. For your cct.hs file you probably want to put different prompt lines into a list and map a print over that list for example:

import Control.Monad mainMenuText = ["Line 1", "Line 2", "Line 3", ...] main = mapM_ putStrLn mainMenuText

Or use QuasiQuuotes

{-# LANGUAGE QuasiQuotes #-} import Data.String.QQ main = putStrLn [s| Line 1 Line 2 Line 3|]

Or use multiline strings:

main = putStrLn "Line 1 \n \ \ Line 2 \n \ \ Line 3"

You may also want to an enum for each case statement menu so if need be you can pass around the value and it makes sense everywhere. In your case "1" being encryption is lost fairly early. I suggest adding a data type for the command:

data Command = ENCRYPTION | DECRYPTION | ...

So that you have one function to do both encryption and decryption:

type Message = String type Shift = Int caesarCipher :: Command -> Message -> Shift -> String

Or something of that nature. It'll make the interface cleaner.

Also be consistent in your use of camelCase.

This is a lot of code but lemme get to the parts which I think are worth addressing.

The commonElems function seems grossly inefficient. Checking that each item appears in every list by doing a length check then removing duplicates seems confusing. I think the simpler algorithm would be to take the unions of the running intersections.

import Data.List commonElems xs = foldr intersect intialElement xs where initialElement = if (null xs) then [] else (head xs)

matchIndices would look better with explicit recursion.

matchIndices needle haystack = go needle haystack 0 where go _ [] _ = [] go n (x:xs)@h i = if n `isPrefixOf` h then i : (go n xs (i + 1)) else (go n xs (i + 1))

thank you very much for going through my code and for your suggestions! i will apply those — Guilherme Lima
– Guilherme Lima, Commented Apr 27, 2019 at 16:39
On having encrypt/decrypt in a single function: I agree with the sentiment of making the interface cleaner, but I object to the method. Functions should do one thing, as adviced by Robert C. Martin's Clean Code. What you can do instead is have common interfaces to different modules, e.g. Ciphers.Caesar.(encrypt, decrypt, crack), Ciphers.Vigenere.(encrypt, decrypt, crack) and let them have common type signatures, to the extent that it's possible. — sshine
– sshine, Commented Apr 29, 2019 at 9:22

Stack Exchange Network

Classic cryptography toolbox: Caesar, Vigenere and ADFGVX ciphers

3 Answers 3

You must log in to answer this question.

Hot Network Questions

Classic cryptography toolbox: Caesar, Vigenere and ADFGVX ciphers

3 Answers 3

You must log in to answer this question.

Related

Hot Network Questions