chacha

The ChaCha20 stream cipher (docs.ppad.tech/chacha).
git clone git://git.ppad.tech/chacha.git
Log | Files | Refs | README | LICENSE

Main.hs (7780B)


      1 {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
      2 {-# LANGUAGE BangPatterns #-}
      3 {-# LANGUAGE MagicHash #-}
      4 {-# LANGUAGE OverloadedStrings #-}
      5 {-# LANGUAGE UnboxedTuples #-}
      6 
      7 module Main where
      8 
      9 import qualified Crypto.Cipher.ChaCha20 as ChaCha
     10 import qualified Data.ByteString as BS
     11 import qualified Data.ByteString.Base16 as B16
     12 import Data.Foldable (for_)
     13 import Data.Maybe (fromJust)
     14 import qualified Data.Primitive.PrimArray as PA
     15 import Data.Word (Word32)
     16 import Test.Tasty
     17 import qualified Test.Tasty.HUnit as H
     18 
     19 main :: IO ()
     20 main = defaultMain $ testGroup "ppad-chacha" [
     21     quarter
     22   , quarter_fullstate
     23   , chacha20_block_init
     24   , chacha20_rounds
     25   , encrypt
     26   , crypt1
     27   , crypt2
     28   , crypt3
     29   ]
     30 
     31 quarter :: TestTree
     32 quarter = H.testCase "quarter round" $ do
     33   let e = (0xea2a92f4, 0xcb1cf8ce, 0x4581472e, 0x5881c4bb)
     34       o = ChaCha._quarter_pure 0x11111111 0x01020304 0x9b8d6f43 0x01234567
     35   H.assertEqual mempty e o
     36 
     37 quarter_fullstate :: TestTree
     38 quarter_fullstate = H.testCase "quarter round (full chacha state)" $ do
     39   let inp :: PA.PrimArray Word32
     40       inp = PA.primArrayFromList [
     41           0x879531e0, 0xc5ecf37d, 0x516461b1, 0xc9a62f8a
     42         , 0x44c20ef3, 0x3390af7f, 0xd9fc690b, 0x2a5f714c
     43         , 0x53372767, 0xb00a5631, 0x974c541a, 0x359e9963
     44         , 0x5c971061, 0x3d631689, 0x2098d9d6, 0x91dbd320
     45         ]
     46   hot <- PA.unsafeThawPrimArray inp
     47 
     48   ChaCha._quarter (ChaCha.ChaCha hot) 2 7 8 13
     49 
     50   o <- PA.unsafeFreezePrimArray hot
     51 
     52   let e :: PA.PrimArray Word32
     53       e = PA.primArrayFromList [
     54           0x879531e0, 0xc5ecf37d, 0xbdb886dc, 0xc9a62f8a
     55         , 0x44c20ef3, 0x3390af7f, 0xd9fc690b, 0xcfacafd2
     56         , 0xe46bea80, 0xb00a5631, 0x974c541a, 0x359e9963
     57         , 0x5c971061, 0xccc07c79, 0x2098d9d6, 0x91dbd320
     58         ]
     59 
     60   H.assertEqual mempty e o
     61 
     62 block_key :: BS.ByteString
     63 block_key = fromJust $
     64   B16.decode "000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f"
     65 
     66 block_non :: BS.ByteString
     67 block_non = fromJust $ B16.decode "000000090000004a00000000"
     68 
     69 chacha20_block_init :: TestTree
     70 chacha20_block_init = H.testCase "chacha20 state init" $ do
     71   let key = ChaCha._parse_key block_key
     72       non = ChaCha._parse_nonce block_non
     73   ChaCha.ChaCha foo <- ChaCha._chacha key 1 non
     74   state <- PA.freezePrimArray foo 0 16
     75   let ref = PA.primArrayFromList [
     76           0x61707865, 0x3320646e, 0x79622d32, 0x6b206574
     77         , 0x03020100, 0x07060504, 0x0b0a0908, 0x0f0e0d0c
     78         , 0x13121110, 0x17161514, 0x1b1a1918, 0x1f1e1d1c
     79         , 0x00000001, 0x09000000, 0x4a000000, 0x00000000
     80         ]
     81   H.assertEqual mempty ref state
     82 
     83 chacha20_rounds :: TestTree
     84 chacha20_rounds = H.testCase "chacha20 20 rounds" $ do
     85   let key = ChaCha._parse_key block_key
     86       non = ChaCha._parse_nonce block_non
     87   state@(ChaCha.ChaCha s) <- ChaCha._chacha key 1 non
     88   for_ [1..10 :: Int] (const (ChaCha._rounds state))
     89 
     90   out <- PA.freezePrimArray s 0 16
     91 
     92   let ref = PA.primArrayFromList [
     93           0x837778ab, 0xe238d763, 0xa67ae21e, 0x5950bb2f
     94         , 0xc4f2d0c7, 0xfc62bb2f, 0x8fa018fc, 0x3f5ec7b7
     95         , 0x335271c2, 0xf29489f3, 0xeabda8fc, 0x82e46ebd
     96         , 0xd19c12b4, 0xb04e16de, 0x9e83d0cb, 0x4e3c50a2
     97         ]
     98 
     99   H.assertEqual mempty ref out
    100 
    101 crypt_plain :: BS.ByteString
    102 crypt_plain = case B16.decode "4c616469657320616e642047656e746c656d656e206f662074686520636c617373206f66202739393a204966204920636f756c64206f6666657220796f75206f6e6c79206f6e652074697020666f7220746865206675747572652c2073756e73637265656e20776f756c642062652069742e" of
    103   Nothing -> error "bang"
    104   Just x -> x
    105 
    106 crypt_cip :: BS.ByteString
    107 crypt_cip = case B16.decode "6e2e359a2568f98041ba0728dd0d6981e97e7aec1d4360c20a27afccfd9fae0bf91b65c5524733ab8f593dabcd62b3571639d624e65152ab8f530c359f0861d807ca0dbf500d6a6156a38e088a22b65e52bc514d16ccf806818ce91ab77937365af90bbf74a35be6b40b8eedf2785e42874d" of
    108   Nothing -> error "bang"
    109   Just x -> x
    110 
    111 crypt_non :: BS.ByteString
    112 crypt_non = case B16.decode "000000000000004a00000000" of
    113   Nothing -> error "bang"
    114   Just x -> x
    115 
    116 encrypt :: TestTree
    117 encrypt = H.testCase "chacha20 encrypt" $ do
    118   let Right o = ChaCha.cipher block_key 1 crypt_non crypt_plain
    119   H.assertEqual mempty crypt_cip o
    120 
    121 -- additional vectors
    122 
    123 crypt1 :: TestTree
    124 crypt1 = H.testCase "chacha20 encrypt (A.2 #1)" $ do
    125   let key = fromJust . B16.decode $
    126         "0000000000000000000000000000000000000000000000000000000000000000"
    127       non = fromJust . B16.decode $
    128         "000000000000000000000000"
    129       con = 0
    130       plain = fromJust . B16.decode $
    131         "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
    132       cip = fromJust . B16.decode $
    133         "76b8e0ada0f13d90405d6ae55386bd28bdd219b8a08ded1aa836efcc8b770dc7da41597c5157488d7724e03fb8d84a376a43b8f41518a11cc387b669b2ee6586"
    134       Right out = ChaCha.cipher key con non plain
    135   H.assertEqual mempty cip out
    136 
    137 crypt2 :: TestTree
    138 crypt2 = H.testCase "chacha20 encrypt (A.2 #2)" $ do
    139   let key = fromJust . B16.decode $
    140         "0000000000000000000000000000000000000000000000000000000000000001"
    141       non = fromJust . B16.decode $
    142         "000000000000000000000002"
    143       con = 1
    144       plain = fromJust . B16.decode $
    145         "416e79207375626d697373696f6e20746f20746865204945544620696e74656e6465642062792074686520436f6e7472696275746f7220666f72207075626c69636174696f6e20617320616c6c206f722070617274206f6620616e204945544620496e7465726e65742d4472616674206f722052464320616e6420616e792073746174656d656e74206d6164652077697468696e2074686520636f6e74657874206f6620616e204945544620616374697669747920697320636f6e7369646572656420616e20224945544620436f6e747269627574696f6e222e20537563682073746174656d656e747320696e636c756465206f72616c2073746174656d656e747320696e20494554462073657373696f6e732c2061732077656c6c206173207772697474656e20616e6420656c656374726f6e696320636f6d6d756e69636174696f6e73206d61646520617420616e792074696d65206f7220706c6163652c207768696368206172652061646472657373656420746f"
    146       cip = fromJust . B16.decode $
    147         "a3fbf07df3fa2fde4f376ca23e82737041605d9f4f4f57bd8cff2c1d4b7955ec2a97948bd3722915c8f3d337f7d370050e9e96d647b7c39f56e031ca5eb6250d4042e02785ececfa4b4bb5e8ead0440e20b6e8db09d881a7c6132f420e52795042bdfa7773d8a9051447b3291ce1411c680465552aa6c405b7764d5e87bea85ad00f8449ed8f72d0d662ab052691ca66424bc86d2df80ea41f43abf937d3259dc4b2d0dfb48a6c9139ddd7f76966e928e635553ba76c5c879d7b35d49eb2e62b0871cdac638939e25e8a1e0ef9d5280fa8ca328b351c3c765989cbcf3daa8b6ccc3aaf9f3979c92b3720fc88dc95ed84a1be059c6499b9fda236e7e818b04b0bc39c1e876b193bfe5569753f88128cc08aaa9b63d1a16f80ef2554d7189c411f5869ca52c5b83fa36ff216b9c1d30062bebcfd2dc5bce0911934fda79a86f6e698ced759c3ff9b6477338f3da4f9cd8514ea9982ccafb341b2384dd902f3d1ab7ac61dd29c6f21ba5b862f3730e37cfdc4fd806c22f221"
    148       Right out = ChaCha.cipher key con non plain
    149   H.assertEqual mempty cip out
    150 
    151 crypt3 :: TestTree
    152 crypt3 = H.testCase "chacha20 encrypt (A.2 #3)" $ do
    153   let key = fromJust . B16.decode $
    154         "1c9240a5eb55d38af333888604f6b5f0473917c1402b80099dca5cbc207075c0"
    155       non = fromJust . B16.decode $
    156         "000000000000000000000002"
    157       con = 42
    158       plain = fromJust . B16.decode $
    159         "2754776173206272696c6c69672c20616e642074686520736c6974687920746f7665730a446964206779726520616e642067696d626c6520696e2074686520776162653a0a416c6c206d696d737920776572652074686520626f726f676f7665732c0a416e6420746865206d6f6d65207261746873206f757467726162652e"
    160       cip = fromJust . B16.decode $
    161         "62e6347f95ed87a45ffae7426f27a1df5fb69110044c0d73118effa95b01e5cf166d3df2d721caf9b21e5fb14c616871fd84c54f9d65b283196c7fe4f60553ebf39c6402c42234e32a356b3e764312a61a5532055716ead6962568f87d3f3f7704c6a8d1bcd1bf4d50d6154b6da731b187b58dfd728afa36757a797ac188d1"
    162       Right out = ChaCha.cipher key con non plain
    163   H.assertEqual mempty cip out
    164