ppad-aead (empty) → 0.1.0
raw patch · 7 files changed
+488/−0 lines, 7 filesdep +aesondep +basedep +bytestring
Dependencies added: aeson, base, bytestring, criterion, ppad-aead, ppad-base16, ppad-chacha, ppad-poly1305, primitive, tasty, tasty-hunit, text
Files
- CHANGELOG +6/−0
- LICENSE +20/−0
- bench/Main.hs +47/−0
- lib/Crypto/AEAD/ChaCha20Poly1305.hs +141/−0
- ppad-aead.cabal +72/−0
- test/Main.hs +132/−0
- test/Wycheproof.hs +70/−0
+ CHANGELOG view
@@ -0,0 +1,6 @@+# Changelog++- 0.1.0 (2025-03-09)+ * Initial release, supporting the ChaCha20-Poly1305 configuration.++
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2025 Jared Tobin++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ bench/Main.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Criterion.Main+import qualified Crypto.AEAD.ChaCha20Poly1305 as AEAD+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as B16+import Data.Maybe (fromJust)++main :: IO ()+main = defaultMain [+ suite+ ]++key :: BS.ByteString+key = fromJust . B16.decode $+ "1c9240a5eb55d38af333888604f6b5f0473917c1402b80099dca5cbc207075c0"++cip :: BS.ByteString+cip = fromJust . B16.decode $+ "64a0861575861af460f062c79be643bd5e805cfd345cf389f108670ac76c8cb24c6cfc18755d43eea09ee94e382d26b0bdb7b73c321b0100d4f03b7f355894cf332f830e710b97ce98c8a84abd0b948114ad176e008d33bd60f982b1ff37c8559797a06ef4f0ef61c186324e2b3506383606907b6a7c02b0f9f6157b53c867e4b9166c767b804d46a59b5216cde7a4e99040c5a40433225ee282a1b0a06c523eaf4534d7f83fa1155b0047718cbc546a0d072b04b3564eea1b422273f548271a0bb2316053fa76991955ebd63159434ecebb4e466dae5a1073a6727627097a1049e617d91d361094fa68f0ff77987130305beaba2eda04df997b714d6c6f2c29a6ad5cb4022b02709b"++plain :: BS.ByteString+plain = fromJust . B16.decode $+ "496e7465726e65742d4472616674732061726520647261667420646f63756d656e74732076616c696420666f722061206d6178696d756d206f6620736978206d6f6e74687320616e64206d617920626520757064617465642c207265706c616365642c206f72206f62736f6c65746564206279206f7468657220646f63756d656e747320617420616e792074696d652e20497420697320696e617070726f70726961746520746f2075736520496e7465726e65742d447261667473206173207265666572656e6365206d6174657269616c206f7220746f2063697465207468656d206f74686572207468616e206173202fe2809c776f726b20696e2070726f67726573732e2fe2809d"++nonce :: BS.ByteString+nonce = fromJust . B16.decode $+ "000000000102030405060708"++aad :: BS.ByteString+aad = fromJust . B16.decode $+ "f33388860000000000004e91"++tag :: BS.ByteString+tag = fromJust . B16.decode $+ "eead9d67890cbb22392336fea1851f38"++suite :: Benchmark+suite =+ bgroup "ppad-aead" [+ bench "encrypt" $ nf (AEAD.encrypt aad key nonce) plain+ , bench "decrypt" $ nf (AEAD.decrypt aad key nonce) (cip, tag)+ ]+
+ lib/Crypto/AEAD/ChaCha20Poly1305.hs view
@@ -0,0 +1,141 @@+{-# OPTIONS_HADDOCK prune #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module: Crypto.AEAD.ChaCha20Poly1305+-- Copyright: (c) 2025 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- A pure AEAD-ChaCha20-Poly1305 implementation, as specified by+-- [RFC 8439](https://datatracker.ietf.org/doc/html/rfc8439).++module Crypto.AEAD.ChaCha20Poly1305 (+ -- * AEAD construction+ encrypt+ , decrypt++ -- testing+ , _poly1305_key_gen+ ) where++import qualified Crypto.Cipher.ChaCha20 as ChaCha20+import qualified Crypto.MAC.Poly1305 as Poly1305+import Data.Bits ((.>>.))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BI+import Data.Word (Word64)++fi :: (Integral a, Num b) => a -> b+fi = fromIntegral+{-# INLINE fi #-}++-- little-endian bytestring encoding+unroll :: Word64 -> BS.ByteString+unroll i = case i of+ 0 -> BS.singleton 0+ _ -> BS.unfoldr coalg i+ where+ coalg = \case+ 0 -> Nothing+ m -> Just $! (fi m, m .>>. 8)+{-# INLINE unroll #-}++-- little-endian bytestring encoding for 64-bit ints, right-padding with zeros+unroll8 :: Word64 -> BS.ByteString+unroll8 (unroll -> u@(BI.PS _ _ l))+ | l < 8 = u <> BS.replicate (8 - l) 0+ | otherwise = u+{-# INLINE unroll8 #-}++-- RFC8439 2.6++_poly1305_key_gen+ :: BS.ByteString -- ^ 256-bit initial keying material+ -> BS.ByteString -- ^ 96-bit nonce+ -> BS.ByteString -- ^ 256-bit key (suitable for poly1305)+_poly1305_key_gen key@(BI.PS _ _ l) nonce+ | l /= 32 = error "ppad-aead (poly1305_key_gen): invalid key"+ | otherwise = BS.take 32 (ChaCha20.block key 0 nonce)+{-# INLINEABLE _poly1305_key_gen #-}++pad16 :: BS.ByteString -> BS.ByteString+pad16 (BI.PS _ _ l)+ | l `rem` 16 == 0 = mempty+ | otherwise = BS.replicate (16 - l `rem` 16) 0+{-# INLINE pad16 #-}++-- RFC8439 2.8++-- | Perform authenticated encryption on a plaintext and some additional+-- authenticated data, given a 256-bit key and 96-bit nonce, using+-- AEAD-ChaCha20-Poly1305.+--+-- Produces a ciphertext and 128-bit message authentication code pair.+--+-- Providing an invalid key or nonce will result in an 'ErrorCall'+-- exception being thrown.+--+-- >>> let key = "don't tell anyone my secret key!"+-- >>> let non = "or my nonce!"+-- >>> let pan = "and here's my plaintext"+-- >>> let aad = "i approve this message"+-- >>> let (cip, mac) = encrypt aad key nonce pan+-- >>> (cip, mac)+-- <(ciphertext, 128-bit MAC)>+encrypt+ :: BS.ByteString -- ^ arbitrary-length additional authenticated data+ -> BS.ByteString -- ^ 256-bit key+ -> BS.ByteString -- ^ 96-bit nonce+ -> BS.ByteString -- ^ arbitrary-length plaintext+ -> (BS.ByteString, BS.ByteString) -- ^ (ciphertext, 128-bit MAC)+encrypt aad key nonce plaintext+ | BS.length key /= 32 = error "ppad-aead (encrypt): invalid key"+ | BS.length nonce /= 12 = error "ppad-aead (encrypt): invalid nonce"+ | otherwise =+ let otk = _poly1305_key_gen key nonce+ cip = ChaCha20.cipher key 1 nonce plaintext+ md0 = aad <> pad16 aad+ md1 = md0 <> cip <> pad16 cip+ md2 = md1 <> unroll8 (fi (BS.length aad))+ md3 = md2 <> unroll8 (fi (BS.length cip))+ tag = Poly1305.mac otk md3+ in (cip, tag)++-- | Decrypt an authenticated ciphertext, given a message authentication+-- code and some additional authenticated data, via a 256-bit key and+-- 96-bit nonce.+--+-- Returns 'Nothing' if the MAC fails to validate.+--+-- Providing an invalid key or nonce will result in an 'ErrorCall'+-- exception being thrown.+--+-- >>> decrypt aad key non (cip, mac)+-- Just "and here's my plaintext"+-- >>> decrypt aad key non (cip, "it's a valid mac")+-- Nothing+decrypt+ :: BS.ByteString -- ^ arbitrary-length AAD+ -> BS.ByteString -- ^ 256-bit key+ -> BS.ByteString -- ^ 96-bit nonce+ -> (BS.ByteString, BS.ByteString) -- ^ (arbitrary-length ciphertext, 128-bit MAC)+ -> Maybe BS.ByteString+decrypt aad key nonce (cip, mac)+ | BS.length key /= 32 = error "ppad-aead (decrypt): invalid key"+ | BS.length nonce /= 12 = error "ppad-aead (decrypt): invalid nonce"+ | BS.length mac /= 16 = Nothing+ | otherwise =+ let otk = _poly1305_key_gen key nonce+ md0 = aad <> pad16 aad+ md1 = md0 <> cip <> pad16 cip+ md2 = md1 <> unroll8 (fi (BS.length aad))+ md3 = md2 <> unroll8 (fi (BS.length cip))+ tag = Poly1305.mac otk md3+ in if mac == tag+ then pure (ChaCha20.cipher key 1 nonce cip)+ else Nothing+
+ ppad-aead.cabal view
@@ -0,0 +1,72 @@+cabal-version: 3.0+name: ppad-aead+version: 0.1.0+synopsis: A pure AEAD-ChaCha20-Poly1305 construction+license: MIT+license-file: LICENSE+author: Jared Tobin+maintainer: jared@ppad.tech+category: Cryptography+build-type: Simple+tested-with: GHC == 9.8.1+extra-doc-files: CHANGELOG+description:+ A pure authenticated encryption with associated data+ (AEAD) implementation supporting ChaCha20-Poly1305, per+ [RFC8439](https://datatracker.ietf.org/doc/html/rfc8439).++source-repository head+ type: git+ location: git.ppad.tech/aead.git++library+ default-language: Haskell2010+ hs-source-dirs: lib+ ghc-options:+ -Wall+ exposed-modules:+ Crypto.AEAD.ChaCha20Poly1305+ build-depends:+ base >= 4.9 && < 5+ , bytestring >= 0.9 && < 0.13+ , ppad-chacha >= 0.1 && < 0.2+ , ppad-poly1305 >= 0.2 && < 0.3++test-suite aead-tests+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: test+ main-is: Main.hs+ other-modules:+ Wycheproof++ ghc-options:+ -rtsopts -Wall -O2++ build-depends:+ aeson+ , base+ , bytestring+ , ppad-base16+ , ppad-aead+ , primitive+ , tasty+ , tasty-hunit+ , text++benchmark aead-bench+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: bench+ main-is: Main.hs++ ghc-options:+ -rtsopts -O2 -Wall++ build-depends:+ base+ , bytestring+ , criterion+ , ppad-base16+ , ppad-aead+
+ test/Main.hs view
@@ -0,0 +1,132 @@+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Main where++import Control.Exception+import qualified Crypto.AEAD.ChaCha20Poly1305 as AEAD+import Data.ByteString as BS+import qualified Data.Aeson as A+import qualified Data.ByteString.Base16 as B16+import qualified Data.Text.IO as TIO+import Data.Maybe (fromJust)+import Test.Tasty+import qualified Test.Tasty.HUnit as H+import qualified Wycheproof as W++main :: IO ()+main = do+ wycheproof_aead <- TIO.readFile "etc/chacha20_poly1305_test.json"+ let wycheproofs = A.decodeStrictText wycheproof_aead :: Maybe W.Wycheproof+ case wycheproofs of+ Nothing -> error "couldn't parse wycheproof vectors"+ Just w -> defaultMain $ testGroup "ppad-aead" [+ rfc8439+ , wycheproof_tests w+ ]++rfc8439 :: TestTree+rfc8439 = testGroup "RFC8439 vectors" [+ poly1305_key_gen+ , crypt+ ]++poly1305_key_gen :: TestTree+poly1305_key_gen = H.testCase "poly1305_key_gen" $ do+ let Just key = B16.decode+ "808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9f"+ Just non = B16.decode+ "000000000001020304050607"++ Just e = B16.decode+ "8ad5a08b905f81cc815040274ab29471a833b637e3fd0da508dbb8e2fdd1a646"++ o = AEAD._poly1305_key_gen key non+ H.assertEqual mempty e o++crypt :: TestTree+crypt = H.testCase "encrypt/decrypt" $ do+ let nonce = salt <> iv++ (o_cip, o_tag) = AEAD.encrypt aad key nonce sunscreen++ e_cip = fromJust . B16.decode $+ "d31a8d34648e60db7b86afbc53ef7ec2a4aded51296e08fea9e2b5a736ee62d63dbea45e8ca9671282fafb69da92728b1a71de0a9e060b2905d6a5b67ecd3b3692ddbd7f2d778b8c9803aee328091b58fab324e4fad675945585808b4831d7bc3ff4def08e4b7a9de576d26586cec64b6116"++ e_tag = fromJust . B16.decode $+ "1ae10b594f09e26a7e902ecbd0600691"+++ o_dec = AEAD.decrypt aad key nonce (o_cip, o_tag)++ H.assertEqual mempty (e_cip, e_tag) (o_cip, o_tag)+ H.assertEqual mempty (Just sunscreen) o_dec+ where+ sunscreen :: BS.ByteString+ sunscreen = fromJust . B16.decode $+ "4c616469657320616e642047656e746c656d656e206f662074686520636c617373206f66202739393a204966204920636f756c64206f6666657220796f75206f6e6c79206f6e652074697020666f7220746865206675747572652c2073756e73637265656e20776f756c642062652069742e"++ aad = fromJust . B16.decode $ "50515253c0c1c2c3c4c5c6c7"+ key = fromJust . B16.decode $+ "808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9f"++ iv = fromJust . B16.decode $ "4041424344454647"+ salt = fromJust . B16.decode $ "07000000"++crypt0 :: TestTree+crypt0 = H.testCase "decrypt (A.5)" $ do+ let key = fromJust . B16.decode $+ "1c9240a5eb55d38af333888604f6b5f0473917c1402b80099dca5cbc207075c0"++ cip = fromJust . B16.decode $+ "64a0861575861af460f062c79be643bd5e805cfd345cf389f108670ac76c8cb24c6cfc18755d43eea09ee94e382d26b0bdb7b73c321b0100d4f03b7f355894cf332f830e710b97ce98c8a84abd0b948114ad176e008d33bd60f982b1ff37c8559797a06ef4f0ef61c186324e2b3506383606907b6a7c02b0f9f6157b53c867e4b9166c767b804d46a59b5216cde7a4e99040c5a40433225ee282a1b0a06c523eaf4534d7f83fa1155b0047718cbc546a0d072b04b3564eea1b422273f548271a0bb2316053fa76991955ebd63159434ecebb4e466dae5a1073a6727627097a1049e617d91d361094fa68f0ff77987130305beaba2eda04df997b714d6c6f2c29a6ad5cb4022b02709b"++ e_pan = fromJust . B16.decode $ "496e7465726e65742d4472616674732061726520647261667420646f63756d656e74732076616c696420666f722061206d6178696d756d206f6620736978206d6f6e74687320616e64206d617920626520757064617465642c207265706c616365642c206f72206f62736f6c65746564206279206f7468657220646f63756d656e747320617420616e792074696d652e20497420697320696e617070726f70726961746520746f2075736520496e7465726e65742d447261667473206173207265666572656e6365206d6174657269616c206f7220746f2063697465207468656d206f74686572207468616e206173202fe2809c776f726b20696e2070726f67726573732e2fe2809d"++ non = fromJust . B16.decode $+ "000000000102030405060708"++ aad = fromJust . B16.decode $+ "f33388860000000000004e91"++ tag = fromJust . B16.decode $+ "eead9d67890cbb22392336fea1851f38"++ Just pan = AEAD.decrypt aad key non (cip, tag)++ H.assertEqual mempty e_pan pan++wycheproof_tests :: W.Wycheproof -> TestTree+wycheproof_tests W.Wycheproof {..} =+ testGroup "wycheproof vectors (aead-chacha20-poly1305)" $+ fmap execute_group wp_testGroups++execute_group :: W.AEADTestGroup -> TestTree+execute_group W.AEADTestGroup {..} =+ testGroup mempty (fmap execute aeadtg_tests)++execute :: W.AEADTest -> TestTree+execute W.AEADTest {..} = H.testCase t_msg $ do+ let key = aeadt_key+ iv = aeadt_iv+ aad = aeadt_aad+ msg = aeadt_msg+ ct = aeadt_ct+ tag = aeadt_tag+ if aeadt_result == "invalid"+ then do+ out <- try (pure $! AEAD.decrypt aad key iv (ct, tag))+ :: IO (Either ErrorCall (Maybe BS.ByteString))+ case out of+ Left _ -> H.assertBool "invalid (bogus key/nonce)" True+ Right Nothing -> H.assertBool "invalid (bogus MAC)" True+ Right (Just o) -> H.assertBool "invalid" (msg /= o)+ else do+ let out = AEAD.decrypt aad key iv (ct, tag)+ H.assertEqual mempty (Just msg) out+ where+ t_msg = "test " <> show aeadt_tcId++
+ test/Wycheproof.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}++module Wycheproof (+ Wycheproof(..)+ , AEADTestGroup(..)+ , AEADTest(..)+ ) where++import Data.Aeson ((.:))+import qualified Data.Aeson as A+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as B16+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE++data Wycheproof = Wycheproof {+ wp_numberOfTests :: !Int+ , wp_testGroups :: ![AEADTestGroup]+ } deriving Show++instance A.FromJSON Wycheproof where+ parseJSON = A.withObject "Wycheproof" $ \m -> Wycheproof+ <$> m .: "numberOfTests"+ <*> m .: "testGroups"++data AEADTestGroup = AEADTestGroup {+ aeadtg_type :: !T.Text+ , aeadtg_ivSize :: !Int+ , aeadtg_keySize :: !Int+ , aeadtg_tagSize :: !Int+ , aeadtg_tests :: ![AEADTest]+ } deriving Show++instance A.FromJSON AEADTestGroup where+ parseJSON = A.withObject "AEADTestGroup" $ \m -> AEADTestGroup+ <$> m .: "type"+ <*> m .: "ivSize"+ <*> m .: "keySize"+ <*> m .: "tagSize"+ <*> m .: "tests"++data AEADTest = AEADTest {+ aeadt_tcId :: !Int+ , aeadt_comment :: !T.Text+ , aeadt_key :: !BS.ByteString+ , aeadt_iv :: !BS.ByteString+ , aeadt_aad :: !BS.ByteString+ , aeadt_msg :: !BS.ByteString+ , aeadt_ct :: !BS.ByteString+ , aeadt_tag :: !BS.ByteString+ , aeadt_result :: !T.Text+ } deriving Show++decodehex :: T.Text -> BS.ByteString+decodehex t = case B16.decode (TE.encodeUtf8 t) of+ Nothing -> error "bang"+ Just bs -> bs++instance A.FromJSON AEADTest where+ parseJSON = A.withObject "AEADTest" $ \m -> AEADTest+ <$> m .: "tcId"+ <*> m .: "comment"+ <*> fmap decodehex (m .: "key")+ <*> fmap decodehex (m .: "iv")+ <*> fmap decodehex (m .: "aad")+ <*> fmap decodehex (m .: "msg")+ <*> fmap decodehex (m .: "ct")+ <*> fmap decodehex (m .: "tag")+ <*> m .: "result"+