aead

Pure Haskell AEAD-ChaCha20-Poly1305 (docs.ppad.tech/aead).
git clone git://git.ppad.tech/aead.git
Log | Files | Refs | README | LICENSE

Main.hs (5504B)

      1 {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
      2 {-# LANGUAGE BangPatterns #-}
      3 {-# LANGUAGE OverloadedStrings #-}
      4 {-# LANGUAGE RecordWildCards #-}
      5 
      6 module Main where
      7 
      8 import Control.Exception
      9 import qualified Crypto.AEAD.ChaCha20Poly1305 as AEAD
     10 import Data.ByteString as BS
     11 import qualified Data.Aeson as A
     12 import qualified Data.ByteString.Base16 as B16
     13 import qualified Data.Text.IO as TIO
     14 import Data.Maybe (fromJust)
     15 import Test.Tasty
     16 import qualified Test.Tasty.HUnit as H
     17 import qualified Wycheproof as W
     18 
     19 main :: IO ()
     20 main = do
     21   wycheproof_aead <- TIO.readFile "etc/chacha20_poly1305_test.json"
     22   let wycheproofs = A.decodeStrictText wycheproof_aead :: Maybe W.Wycheproof
     23   case wycheproofs of
     24     Nothing -> error "couldn't parse wycheproof vectors"
     25     Just w -> defaultMain $ testGroup "ppad-aead" [
     26         rfc8439
     27       , wycheproof_tests w
     28       ]
     29 
     30 rfc8439 :: TestTree
     31 rfc8439 = testGroup "RFC8439 vectors" [
     32     poly1305_key_gen
     33   , crypt
     34   ]
     35 
     36 poly1305_key_gen :: TestTree
     37 poly1305_key_gen = H.testCase "poly1305_key_gen" $ do
     38   let Just key = B16.decode
     39         "808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9f"
     40       Just non = B16.decode
     41         "000000000001020304050607"
     42 
     43       Just e = B16.decode
     44         "8ad5a08b905f81cc815040274ab29471a833b637e3fd0da508dbb8e2fdd1a646"
     45 
     46       o = AEAD._poly1305_key_gen key non
     47   H.assertEqual mempty e o
     48 
     49 crypt :: TestTree
     50 crypt = H.testCase "encrypt/decrypt" $ do
     51     let nonce = salt <> iv
     52 
     53         (o_cip, o_tag) = AEAD.encrypt aad key nonce sunscreen
     54 
     55         e_cip = fromJust . B16.decode $
     56           "d31a8d34648e60db7b86afbc53ef7ec2a4aded51296e08fea9e2b5a736ee62d63dbea45e8ca9671282fafb69da92728b1a71de0a9e060b2905d6a5b67ecd3b3692ddbd7f2d778b8c9803aee328091b58fab324e4fad675945585808b4831d7bc3ff4def08e4b7a9de576d26586cec64b6116"
     57 
     58         e_tag = fromJust . B16.decode $
     59           "1ae10b594f09e26a7e902ecbd0600691"
     60 
     61 
     62         o_dec = AEAD.decrypt aad key nonce (o_cip, o_tag)
     63 
     64     H.assertEqual mempty (e_cip, e_tag) (o_cip, o_tag)
     65     H.assertEqual mempty (Just sunscreen) o_dec
     66   where
     67     sunscreen :: BS.ByteString
     68     sunscreen = fromJust . B16.decode $
     69       "4c616469657320616e642047656e746c656d656e206f662074686520636c617373206f66202739393a204966204920636f756c64206f6666657220796f75206f6e6c79206f6e652074697020666f7220746865206675747572652c2073756e73637265656e20776f756c642062652069742e"
     70 
     71     aad = fromJust . B16.decode $ "50515253c0c1c2c3c4c5c6c7"
     72     key = fromJust . B16.decode $
     73       "808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9f"
     74 
     75     iv = fromJust . B16.decode $ "4041424344454647"
     76     salt = fromJust . B16.decode $ "07000000"
     77 
     78 crypt0 :: TestTree
     79 crypt0 = H.testCase "decrypt (A.5)" $ do
     80   let key = fromJust . B16.decode $
     81         "1c9240a5eb55d38af333888604f6b5f0473917c1402b80099dca5cbc207075c0"
     82 
     83       cip = fromJust . B16.decode $
     84         "64a0861575861af460f062c79be643bd5e805cfd345cf389f108670ac76c8cb24c6cfc18755d43eea09ee94e382d26b0bdb7b73c321b0100d4f03b7f355894cf332f830e710b97ce98c8a84abd0b948114ad176e008d33bd60f982b1ff37c8559797a06ef4f0ef61c186324e2b3506383606907b6a7c02b0f9f6157b53c867e4b9166c767b804d46a59b5216cde7a4e99040c5a40433225ee282a1b0a06c523eaf4534d7f83fa1155b0047718cbc546a0d072b04b3564eea1b422273f548271a0bb2316053fa76991955ebd63159434ecebb4e466dae5a1073a6727627097a1049e617d91d361094fa68f0ff77987130305beaba2eda04df997b714d6c6f2c29a6ad5cb4022b02709b"
     85 
     86       e_pan = fromJust . B16.decode $ "496e7465726e65742d4472616674732061726520647261667420646f63756d656e74732076616c696420666f722061206d6178696d756d206f6620736978206d6f6e74687320616e64206d617920626520757064617465642c207265706c616365642c206f72206f62736f6c65746564206279206f7468657220646f63756d656e747320617420616e792074696d652e20497420697320696e617070726f70726961746520746f2075736520496e7465726e65742d447261667473206173207265666572656e6365206d6174657269616c206f7220746f2063697465207468656d206f74686572207468616e206173202fe2809c776f726b20696e2070726f67726573732e2fe2809d"
     87 
     88       non = fromJust . B16.decode $
     89         "000000000102030405060708"
     90 
     91       aad = fromJust . B16.decode $
     92         "f33388860000000000004e91"
     93 
     94       tag = fromJust . B16.decode $
     95         "eead9d67890cbb22392336fea1851f38"
     96 
     97       Just pan = AEAD.decrypt aad key non (cip, tag)
     98 
     99   H.assertEqual mempty e_pan pan
    100 
    101 wycheproof_tests :: W.Wycheproof -> TestTree
    102 wycheproof_tests W.Wycheproof {..} =
    103   testGroup "wycheproof vectors (aead-chacha20-poly1305)" $
    104     fmap execute_group wp_testGroups
    105 
    106 execute_group :: W.AEADTestGroup -> TestTree
    107 execute_group W.AEADTestGroup {..} =
    108   testGroup mempty (fmap execute aeadtg_tests)
    109 
    110 execute :: W.AEADTest -> TestTree
    111 execute W.AEADTest {..} = H.testCase t_msg $ do
    112     let key = aeadt_key
    113         iv  = aeadt_iv
    114         aad = aeadt_aad
    115         msg = aeadt_msg
    116         ct  = aeadt_ct
    117         tag = aeadt_tag
    118     if   aeadt_result == "invalid"
    119     then do
    120       out <- try (pure $! AEAD.decrypt aad key iv (ct, tag))
    121                :: IO (Either ErrorCall (Maybe BS.ByteString))
    122       case out of
    123         Left _         -> H.assertBool "invalid (bogus key/nonce)" True
    124         Right Nothing  -> H.assertBool "invalid (bogus MAC)" True
    125         Right (Just o) -> H.assertBool "invalid" (msg /= o)
    126     else do
    127       let (out_cip, out_mac) = AEAD.encrypt aad key iv msg
    128           out_pan = AEAD.decrypt aad key iv (ct, tag)
    129       H.assertEqual mempty ct out_cip
    130       H.assertEqual mempty tag out_mac
    131       H.assertEqual mempty (Just msg) out_pan
    132   where
    133     t_msg = "test " <> show aeadt_tcId
    134 
    135