cryptopals

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

AES.hs (2281B)

      1 module Cryptopals.AES (
      2     encryptCbcAES128
      3   , encryptEcbAES128
      4 
      5   , decryptCbcAES128
      6   , decryptEcbAES128
      7 
      8   , encryptCtrAES128
      9   , decryptCtrAES128
     10   ) where
     11 
     12 import qualified Crypto.Cipher.AES as CAES
     13 import qualified Crypto.Cipher.Types as CT
     14 import qualified Crypto.Error as CE
     15 import qualified Cryptopals.Util as CU
     16 import qualified Data.Binary.Get as BG
     17 import qualified Data.Binary.Put as BP
     18 import qualified Data.ByteString as BS
     19 import qualified Data.ByteString.Lazy as BSL
     20 import GHC.Word (Word64)
     21 
     22 initAES128 :: BS.ByteString -> CAES.AES128
     23 initAES128 =  CE.throwCryptoError . CT.cipherInit
     24 
     25 encryptEcbAES128 :: BS.ByteString -> BS.ByteString -> BS.ByteString
     26 encryptEcbAES128 key = CT.ecbEncrypt (initAES128 key)
     27 
     28 decryptEcbAES128 :: BS.ByteString -> BS.ByteString -> BS.ByteString
     29 decryptEcbAES128 key = CT.ecbDecrypt (initAES128 key)
     30 
     31 encryptCbcAES128
     32   :: BS.ByteString -> BS.ByteString -> BS.ByteString -> BS.ByteString
     33 encryptCbcAES128 iv key plaintext = loop iv iv (BS.splitAt 16 plaintext)
     34   where
     35     loop las !acc (b, bs) =
     36       let xed  = CU.fixedXor las b
     37           enc  = encryptEcbAES128 key xed
     38           nacc = acc <> enc
     39       in  if   BS.null bs
     40           then nacc
     41           else loop enc nacc (BS.splitAt 16 bs)
     42 
     43 decryptCbcAES128
     44   :: BS.ByteString -> BS.ByteString -> BS.ByteString
     45 decryptCbcAES128 key ciphertext =
     46     let (iv, cip) = BS.splitAt 16 ciphertext
     47     in  loop iv mempty (BS.splitAt 16 cip)
     48   where
     49     loop !las !acc (b, bs) =
     50       let dec  = decryptEcbAES128 key b
     51           nacc = acc <> CU.fixedXor dec las
     52           niv  = b
     53       in  if   BS.null bs
     54           then nacc
     55           else loop b nacc (BS.splitAt 16 bs)
     56 
     57 encryptCtrAES128 :: Word64 -> BS.ByteString -> BS.ByteString -> BS.ByteString
     58 encryptCtrAES128 nonce key plaintext = loop mempty 0 bs where
     59   bs = CU.chunks 16 plaintext
     60   iv = BS.replicate 16 0
     61   no = BP.runPut (BP.putWord64le nonce)
     62 
     63   loop !acc !ctr cs = case cs of
     64     []    -> acc
     65     (h:t) ->
     66       let bc = BP.runPut (BP.putWord64le ctr)
     67           pt = BSL.toStrict (no <> bc)
     68           ks = BS.drop 16 $ encryptCbcAES128 iv key pt
     69       in  loop (acc <> CU.fixedXor h ks) (ctr + 1) t
     70 
     71 decryptCtrAES128 :: Word64 -> BS.ByteString -> BS.ByteString -> BS.ByteString
     72 decryptCtrAES128 = encryptCtrAES128
     73