Skip to content

Instantly share code, notes, and snippets.

/Set1.hs
Created Feb 27, 2016

Embed
What would you like to do?
The Matasano Crypto Challenges Set 1 (http://cryptopals.com/sets/1)
module Set1 where
import qualified Data.Map.Strict as M
import Data.Bits
import Data.Word
import Data.Char (toLower)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C
-- Helpers
stringToBytes :: String -> [Word8]
stringToBytes = BS.unpack . C.pack
charToBytes :: Char -> [Word8]
charToBytes = BS.unpack . C.singleton
bytesToString :: [Word8] -> String
bytesToString = C.unpack . BS.pack
-- Set 1, Challenge 1: Base64 encoding -----------------------------------------
base64Chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
base64Dict = M.fromList $ zip [0..] base64Chars
getBase64Char b = M.findWithDefault ' ' b base64Dict
encodeTriple :: Word8 -> Word8 -> Word8 -> String
encodeTriple a b c =
map getBase64Char $ zipWith (.|.)
(map transform [(a, -2, 0x3f), (a, 4, 0x30), (b, 2, 0x3c), (c, 0, 0x3f)])
(map transform [(0, 0, 0), (b, -4, 0x0f), (c, -6, 0x03), (0, 0, 0)])
where
transform (a, s, m) = a `shift` s .&. m
bytesToBase64 :: [Word8] -> String
bytesToBase64 [] = []
bytesToBase64 [a] = take 2 (encodeTriple a 0 0) ++ "=="
bytesToBase64 [a, b] = take 3 (encodeTriple a b 0) ++ "="
bytesToBase64 (a:b:c:xs) = encodeTriple a b c ++ bytesToBase64 xs
stringToBase64 :: String -> String
stringToBase64 = bytesToBase64 . stringToBytes
-- Set 1, Challenge 2: hex string conversion -----------------------------------
hexChars = "0123456789abcdef"
hexDict = M.fromList $ zip hexChars [0..]
hexToByte c = M.findWithDefault 0 (toLower c) hexDict
hexRevDict = M.fromList $ zip [0..] hexChars
byteToHex b = M.findWithDefault ' ' b hexRevDict
hexStringToBytes :: String -> [Word8]
hexStringToBytes [] = []
hexStringToBytes [a] = [0]
hexStringToBytes (a:b:xs) = 16 * hexToByte a + hexToByte b : hexStringToBytes xs
bytesToHexString :: [Word8] -> String
bytesToHexString [] = []
bytesToHexString (x:xs) = byteToHex (x `shiftR` 4 .&. 0xf) : byteToHex (x .&. 0xf) : bytesToHexString xs
hexStringToBase64 :: String -> String
hexStringToBase64 = bytesToBase64 . hexStringToBytes
-- Set 1, Challenge 3: Decrypt single-byte XOR with frequency analysis ---------
fixedXor :: [Word8] -> [Word8] -> [Word8]
fixedXor = zipWith xor
fixedXorHexStr :: String -> String -> String
fixedXorHexStr a b = bytesToHexString $ fixedXor (hexStringToBytes a) (hexStringToBytes b)
-- Decrypt a hex-encoded message with a single-byte XOR
singleXorHexStr s c = bytesToString $ fixedXor (hexStringToBytes s) $ cycle (charToBytes c)
-- English letter frequencies (https://en.wikipedia.org/wiki/Letter_frequency)
charFreqEnglish = M.fromList
[ ('a', 0.08167)
, ('b', 0.01492)
, ('c', 0.02782)
, ('d', 0.04253)
, ('e', 0.1270)
, ('f', 0.02228)
, ('g', 0.02015)
, ('h', 0.06094)
, ('i', 0.06966)
, ('j', 0.00153)
, ('k', 0.00772)
, ('l', 0.04025)
, ('m', 0.02406)
, ('n', 0.06749)
, ('o', 0.07507)
, ('p', 0.01929)
, ('q', 0.00095)
, ('r', 0.05987)
, ('s', 0.06327)
, ('t', 0.09056)
, ('u', 0.02758)
, ('v', 0.00978)
, ('w', 0.02361)
, ('x', 0.00150)
, ('y', 0.01974)
, ('z', 0.00074) ]
freqExpected c = M.findWithDefault 0 c charFreqEnglish
-- number of occurences of an element in a list
count :: Eq a => a -> [a] -> Int
count c = length . filter (==c)
-- frequency of an element in a list
freq :: Eq a => [a] -> a -> Double
freq s c = fromIntegral (count c s) / fromIntegral (length s)
-- score for a Char = square deviation from expected frequency
getScore :: String -> Char -> Double
getScore s c = (freq s c - freqExpected c) ^^ 2
-- score an entire string (sum scores for 'a'..'z' and unexpected characters '*')
scoreString :: String -> Double
scoreString s = sum $ map (getScore s') ('*':['a'..'z'])
where
s' = map (replaceNonAlpha . toLower) s
replaceNonAlpha c = if c `elem` ['a'..'z'] then c else '*'
-- Decrypt with every letter, calculate score, and return the result with the lowest score
tryDecryptHex :: String -> String
tryDecryptHex s = snd . minimum $ map ((\s -> (scoreString s, s)) . singleXorHexStr s) ['A'..'Z']
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.