5
\$\begingroup\$

I wrote the following that tries to crack a message that was encrypted via a simple Caesar cipher through brute force. I'm fairly new to Haskell, so any and all input is appreciated. Because there are infinite ways that something could have been encrypted, it assumes very simple "offset" encryption; like what decShift uses. It also doesn't assume any "wrapping" if an offset character goes out of range.

It works fine (from my testing), I'd just like any input on how it could be made more readable, idiomatic, or generally better.

Use:

simpDec "Encrypted Message", which returns a list of tuples where the first element is the key used to obtain the decryption, and the second is the decrypted message (it returns a list because it's possible for it to return more then one possible decryption).

decUpper = 127 --Upperbound of normal characters
decLower = 32 --Lowerbound of normal characters
decRange = decUpper - decLower --Total range

type Message = String

--Checks if the char is in range
isInRange :: Char -> Bool
isInRange char = ichar <= decUpper && ichar >= decLower
    where ichar = ord char

--Makes sure all chars in the Message are in range
isPossible :: Message -> Bool
isPossible [] = False
isPossible m = null [letter | letter <- m, not $ isInRange letter]

--Returns a list > 0 if it finds consecutive symbols
conSymList :: Message -> Char -> [Char]
conSymList [] _ = []
conSymList (x:xs) lastChar
    | isSym x && isSym lastChar = x : conSymList xs x
    | otherwise = conSymList xs x
    where isSym c = isSymbol c || isPunctuation c

--Checks if a string has 2 symbols beside each other (meaning its improbable)
isProbable :: Message -> Bool
isProbable [] = False
isProbable m = null $ conSymList m 'a'

--Shifts all characters by n
decShift :: Message -> Int -> Message
decShift [] _ = []
decShift (x:xs) n 
    | iNewChar > 0 = chr iNewChar : decShift xs n
    | otherwise = x : decShift xs n
    where iNewChar = ord x + n

--Returns a list of tuples of the offset used, and the shifted Message
getCombos :: Message -> [(Int,Message)]
getCombos m = [(off,decShift m off) | off <- [decRange * (-1)..decRange]]

--Returns a list of tuples of possible decryptions (KeyUsed,Message)
simpDec :: Message -> [(Int, Message)]
simpDec m = [(key,try) | (key,try) <- getCombos m, isPossible try && isProbable try]
\$\endgroup\$
2
\$\begingroup\$
import Data.Char (chr, isPunctuation, isSymbol, ord)

decUpper = 127 --Upperbound of normal characters
decLower = 32 --Lowerbound of normal characters
decRange = decUpper - decLower --Total range

type Message = String

-- | Checks if the char is in range
isInRange :: Char -> Bool
isInRange char = ichar <= decUpper && ichar >= decLower
    where ichar = ord char

-- Test if all chars in the Message are in range
isPossible :: Message -> Bool
isPossible = all isInRange

-- Turn a list into a list of pairs
mkPairs :: [a] -> [(a,a)]
mkPairs xs = zip xs (tail xs)

-- no consecutive symbols in Message
isProbable :: Message -> Bool
isProbable = not . any (\(x,y) -> isSym x && isSym y) . mkPairs
  where isSym c = isSymbol c || isPunctuation c

-- Shifts all characters by n
decShift :: Message -> Int -> Message
decShift []     _  = []
decShift (x:xs) n
    | iNewChar > 0 = chr iNewChar : decShift xs n
    | otherwise    = x : decShift xs n
  where iNewChar = ord x + n

-- Returns a list of tuples of the offset used, and the shifted Message
getCombos :: Message -> [(Int,Message)]
getCombos m = [(off,decShift m off) | off <- [negate decRange .. decRange]]

-- Returns a list of tuples of possible decryptions (KeyUsed,Message)
simpDec :: Message -> [(Int, Message)]
simpDec = filter ((\x -> isPossible x && isProbable x) . snd) . getCombos

Changes:

  • used more function composition
  • simpDec is really a filter on results. getCombos generates data so a list comprehension makes sense.
  • simplify isProbable with the definition of mkPairs
  • simplify isPossible using the all function.
  • added import line
\$\endgroup\$
  • \$\begingroup\$ Awesome, thank you.I especially like mkPairs. That should help ease the transition if I ever decide to make it try to match 3 consecutive symbols. \$\endgroup\$ – Carcigenicate Jul 11 '14 at 0:16
  • \$\begingroup\$ I'll be honest, I wrote mkPairs directly as a recursive solution. Then I said surely this already exists. But no, it is not in the standard lib. But lots of people have recreated it. The above using zip and tail is the easiest to understand. zip <*> tail is another popular one. Way less obvious though. \$\endgroup\$ – Sean Perry Jul 11 '14 at 4:17

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.