Created
February 27, 2016 20:32
-
-
Save anonymous/f7ae7e5f8e1cba7819e0 to your computer and use it in GitHub Desktop.
The Matasano Crypto Challenges Set 1 (http://cryptopals.com/sets/1)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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