diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,6 @@ +# Changelog + +- 0.1.0 (2025-03-09) + * Initial release, supporting the ChaCha20-Poly1305 configuration. + + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -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) + ] + diff --git a/lib/Crypto/AEAD/ChaCha20Poly1305.hs b/lib/Crypto/AEAD/ChaCha20Poly1305.hs new file mode 100644 --- /dev/null +++ b/lib/Crypto/AEAD/ChaCha20Poly1305.hs @@ -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 +-- +-- 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 + diff --git a/ppad-aead.cabal b/ppad-aead.cabal new file mode 100644 --- /dev/null +++ b/ppad-aead.cabal @@ -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 + diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -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 + + diff --git a/test/Wycheproof.hs b/test/Wycheproof.hs new file mode 100644 --- /dev/null +++ b/test/Wycheproof.hs @@ -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" +