cryptopals

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

AES.hs (3649B)

      1 {-# LANGUAGE OverloadedStrings #-}
      2 {-# LANGUAGE RecordWildCards #-}
      3 
      4 module Main where
      5 
      6 import Control.Applicative (optional)
      7 import qualified Cryptopals.AES as AES
      8 import qualified Data.ByteString.Base16 as B16
      9 import qualified Data.Char as C
     10 import qualified Data.Text as T
     11 import qualified Data.Text.Encoding as TE
     12 import qualified Data.Text.IO as TIO
     13 import GHC.Word (Word64)
     14 import qualified Options.Applicative as O
     15 import qualified System.Exit as SE
     16 import qualified System.IO as SIO
     17 
     18 data Operation =
     19     Encrypt
     20   | Decrypt
     21 
     22 data Mode =
     23     ECB
     24   | CBC
     25   | CTR
     26 
     27 data Args = Args {
     28     argsOpr   :: Operation
     29   , argsMod   :: Mode
     30   , argsIv    :: Maybe T.Text
     31   , argsKey   :: T.Text
     32   , argsNonce :: Maybe Word64
     33   , argsInp   :: T.Text
     34   }
     35 
     36 ops :: O.Parser Args
     37 ops = Args
     38   <$> operationParser
     39   <*> modeParser
     40   <*> optional (O.strOption (O.long "iv" <> O.metavar "IV"))
     41   <*> O.argument O.str (O.metavar "KEY")
     42   <*> optional (O.option O.auto (O.long "nonce" <> O.metavar "NONCE"))
     43   <*> O.argument O.str (O.metavar "INPUT")
     44 
     45 operationParser :: O.Parser Operation
     46 operationParser = O.argument op etc where
     47   op = O.eitherReader $ \input -> case fmap C.toLower input of
     48     "encrypt" -> pure Encrypt
     49     "decrypt" -> pure Decrypt
     50     _         -> Left ("invalid operation: " <> input)
     51 
     52   etc = O.metavar "OPERATION"
     53      <> O.help "{encrypt, decrypt}"
     54 
     55 modeParser :: O.Parser Mode
     56 modeParser = O.argument mode etc where
     57   mode = O.eitherReader $ \input -> case fmap C.toLower input of
     58     "ecb" -> pure ECB
     59     "cbc" -> pure CBC
     60     "ctr" -> pure CTR
     61     _     -> Left ("invalid mode: " <> input)
     62 
     63   etc = O.metavar "MODE"
     64      <> O.help "{ecb, cbc}"
     65 
     66 aes :: Args -> IO ()
     67 aes Args {..} = do
     68   let args = do
     69         k <- B16.decodeBase16 $ TE.encodeUtf8 argsKey
     70         v <- B16.decodeBase16 $ TE.encodeUtf8 argsInp
     71         pure (k, v)
     72 
     73       out = TIO.putStrLn . TE.decodeUtf8 . B16.encodeBase16'
     74       err = TIO.hPutStrLn SIO.stderr
     75 
     76   case args of
     77     Left e -> do
     78       TIO.hPutStrLn SIO.stderr ("cryptopals: " <> e)
     79       SE.exitFailure
     80 
     81     Right (k, v) -> do
     82       case argsOpr of
     83         Encrypt -> case argsMod of
     84           ECB -> out $ AES.encryptEcbAES128 k v
     85 
     86           CBC -> case argsIv of
     87             Nothing -> do
     88               err $ "cryptopals: must provide IV"
     89               SE.exitFailure
     90 
     91             Just miv -> case B16.decodeBase16 (TE.encodeUtf8 miv) of
     92               Left e -> do
     93                 err $ "cryptopals: " <> e
     94                 SE.exitFailure
     95 
     96               Right iv ->
     97                 out $ AES.encryptCbcAES128 iv k v
     98 
     99           CTR -> case argsNonce of
    100             Nothing -> do
    101               err $ "cryptopals: must provide nonce"
    102               SE.exitFailure
    103 
    104             Just n -> out $ AES.encryptCtrAES128 n k v
    105 
    106         Decrypt -> case argsMod of
    107           ECB -> out $ AES.decryptEcbAES128 k v
    108 
    109           CBC -> case argsIv of
    110             Nothing -> do
    111               err $ "cryptopals: must provide IV"
    112               SE.exitFailure
    113 
    114             Just miv -> case B16.decodeBase16 (TE.encodeUtf8 miv) of
    115               Left e -> do
    116                 err $ "cryptopals: " <> e
    117                 SE.exitFailure
    118 
    119               Right iv ->
    120                 out $ AES.decryptCbcAES128 k (iv <> v)
    121 
    122           CTR -> case argsNonce of
    123             Nothing -> do
    124               err $ "cryptopals: must provide nonce"
    125               SE.exitFailure
    126 
    127             Just n -> out $ AES.decryptCtrAES128 n k v
    128 
    129 main :: IO ()
    130 main = do
    131   let pars = O.info (O.helper <*> ops) $
    132            O.fullDesc
    133         <> O.progDesc "AES encryption/decryption"
    134         <> O.header "aes"
    135 
    136   args <- O.execParser pars
    137 
    138   aes args
    139