cryptopals

Matasano's cryptopals challenges (cryptopals.com).
git clone git://git.jtobin.io/cryptopals.git
Log | Files | Refs | README | LICENSE

BreakSingleByteXor.hs (2077B)

      1 {-# LANGUAGE OverloadedStrings #-}
      2 {-# LANGUAGE RecordWildCards #-}
      3 
      4 module Main where
      5 
      6 import qualified Cryptopals.Util as CU
      7 import qualified Data.ByteString as BS
      8 import qualified Data.ByteString.Base16 as B16
      9 import qualified Data.Char as C
     10 import Data.List (foldl')
     11 import qualified Data.Text as T
     12 import qualified Data.Text.IO as TIO
     13 import qualified Data.Text.Encoding as TE
     14 import GHC.Word (Word8)
     15 import qualified Options.Applicative as O
     16 import qualified System.Exit as SE
     17 import qualified System.IO as SIO
     18 
     19 data Mode =
     20     Decrypt
     21   | Log
     22 
     23 data Args = Args {
     24     argsInp :: T.Text
     25   , argsMod :: Mode
     26   }
     27 
     28 ops :: O.Parser Args
     29 ops = Args
     30   <$> O.argument O.str (O.metavar "INPUT")
     31   <*> O.flag Decrypt Log (
     32         O.long "log" <> O.short 'l' <>
     33         O.help "log the likely enciphering byte"
     34         )
     35 
     36 best :: BS.ByteString -> (Word8, Double, BS.ByteString)
     37 best s = foldl' alg (0, CU.score s, s) [32..126] where
     38   alg acc@(_, asc, _) b =
     39     let xo = CU.singleByteXor b s
     40         sc = CU.score xo
     41     in  if   sc < asc
     42         then (b, sc, xo)
     43         else acc
     44 
     45 decipher :: Args -> IO ()
     46 decipher Args {..} = do
     47   let render :: Show a => a -> T.Text
     48       render = T.pack . show
     49 
     50       err = TIO.hPutStrLn SIO.stderr
     51       out = TIO.hPutStrLn SIO.stdout
     52 
     53       args = B16.decodeBase16 $ TE.encodeUtf8 argsInp
     54 
     55   case args of
     56     Left e -> do
     57       err $ "cryptopals: " <> e
     58       SE.exitFailure
     59 
     60     Right s -> do
     61       err $ "cryptopals: input similarity score is " <> render (CU.score s)
     62 
     63       let (byt, bsc, b) = best s
     64 
     65       err (
     66         "cryptopals: xor-ing with " <> render byt <>
     67         " yields " <> render bsc
     68         )
     69 
     70       err $ "cryptopals: result"
     71       case argsMod of
     72         Decrypt -> out . TE.decodeUtf8 . B16.encodeBase16' $ b
     73         Log     -> out . render $ C.chr (fromIntegral byt)
     74 
     75 main :: IO ()
     76 main = do
     77   let pars = O.info (O.helper <*> ops) $
     78            O.fullDesc
     79         <> O.progDesc "attempt to break single-byte xor'd ciphertext"
     80         <> O.header "break-single-byte-xor"
     81 
     82   args <- O.execParser pars
     83 
     84   decipher args
     85