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 stream cipher and block + function. + 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,34 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Criterion.Main +import qualified Crypto.Cipher.ChaCha20 as ChaCha20 +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as B16 +import Data.Maybe (fromJust) + +main :: IO () +main = defaultMain [ + suite + ] + +plain :: BS.ByteString +plain = fromJust . B16.decode $ + "4c616469657320616e642047656e746c656d656e206f662074686520636c617373206f66202739393a204966204920636f756c64206f6666657220796f75206f6e6c79206f6e652074697020666f7220746865206675747572652c2073756e73637265656e20776f756c642062652069742e" + +key :: BS.ByteString +key = fromJust . B16.decode $ + "000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f" + +non :: BS.ByteString +non = fromJust . B16.decode $ + "000000090000004a00000000" + +suite :: Benchmark +suite = + bgroup "ppad-chacha" [ + bench "cipher" $ nf (ChaCha20.cipher key 1 non) plain + ] + diff --git a/lib/Crypto/Cipher/ChaCha20.hs b/lib/Crypto/Cipher/ChaCha20.hs new file mode 100644 --- /dev/null +++ b/lib/Crypto/Cipher/ChaCha20.hs @@ -0,0 +1,365 @@ +{-# OPTIONS_HADDOCK prune #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE UnboxedTuples #-} + +-- | +-- Module: Crypto.Cipher.ChaCha20 +-- Copyright: (c) 2025 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- A pure ChaCha20 implementation, as specified by +-- [RFC 8439](https://datatracker.ietf.org/doc/html/rfc8439). + +module Crypto.Cipher.ChaCha20 ( + -- * ChaCha20 stream cipher + cipher + + -- * ChaCha20 block function + , block + + -- testing + , ChaCha(..) + , _chacha + , _parse_key + , _parse_nonce + , _quarter + , _quarter_pure + , _rounds + ) where + +import Control.Monad.ST +import qualified Data.Bits as B +import Data.Bits ((.|.), (.<<.), (.^.)) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as BSB +import qualified Data.ByteString.Internal as BI +import qualified Data.ByteString.Unsafe as BU +import Control.Monad.Primitive (PrimMonad, PrimState) +import Data.Foldable (for_) +import qualified Data.Primitive.PrimArray as PA +import Foreign.ForeignPtr +import GHC.Exts +import GHC.Word + +-- utils ---------------------------------------------------------------------- + +-- keystroke saver +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral +{-# INLINE fi #-} + +-- parse strict ByteString in LE order to Word32 (verbatim from +-- Data.Binary) +unsafe_word32le :: BS.ByteString -> Word32 +unsafe_word32le s = + (fi (s `BU.unsafeIndex` 3) `B.unsafeShiftL` 24) .|. + (fi (s `BU.unsafeIndex` 2) `B.unsafeShiftL` 16) .|. + (fi (s `BU.unsafeIndex` 1) `B.unsafeShiftL` 8) .|. + (fi (s `BU.unsafeIndex` 0)) +{-# INLINE unsafe_word32le #-} + +data WSPair = WSPair + {-# UNPACK #-} !Word32 + {-# UNPACK #-} !BS.ByteString + +-- variant of Data.ByteString.splitAt that behaves like an incremental +-- Word32 parser +unsafe_parseWsPair :: BS.ByteString -> WSPair +unsafe_parseWsPair (BI.BS x l) = + WSPair (unsafe_word32le (BI.BS x 4)) (BI.BS (plusForeignPtr x 4) (l - 4)) +{-# INLINE unsafe_parseWsPair #-} + +-- chacha quarter round ------------------------------------------------------- + +-- RFC8439 2.2 +_quarter + :: PrimMonad m + => ChaCha (PrimState m) + -> Int + -> Int + -> Int + -> Int + -> m () +_quarter (ChaCha m) i0 i1 i2 i3 = do + !(W32# a) <- PA.readPrimArray m i0 + !(W32# b) <- PA.readPrimArray m i1 + !(W32# c) <- PA.readPrimArray m i2 + !(W32# d) <- PA.readPrimArray m i3 + + let !(# a1, b1, c1, d1 #) = quarter# a b c d + + PA.writePrimArray m i0 (W32# a1) + PA.writePrimArray m i1 (W32# b1) + PA.writePrimArray m i2 (W32# c1) + PA.writePrimArray m i3 (W32# d1) +{-# INLINEABLE _quarter #-} + +_quarter_pure + :: Word32 -> Word32 -> Word32 -> Word32 -> (Word32, Word32, Word32, Word32) +_quarter_pure (W32# a) (W32# b) (W32# c) (W32# d) = + let !(# a', b', c', d' #) = quarter# a b c d + in (W32# a', W32# b', W32# c', W32# d') +{-# INLINE _quarter_pure #-} + +-- RFC8439 2.1 +quarter# + :: Word32# -> Word32# -> Word32# -> Word32# + -> (# Word32#, Word32#, Word32#, Word32# #) +quarter# a b c d = + let a0 = plusWord32# a b + d0 = xorWord32# d a0 + d1 = rotateL# d0 16# + + c0 = plusWord32# c d1 + b0 = xorWord32# b c0 + b1 = rotateL# b0 12# + + a1 = plusWord32# a0 b1 + d2 = xorWord32# d1 a1 + d3 = rotateL# d2 8# + + c1 = plusWord32# c0 d3 + b2 = xorWord32# b1 c1 + b3 = rotateL# b2 7# + + in (# a1, b3, c1, d3 #) +{-# INLINE quarter# #-} + +rotateL# :: Word32# -> Int# -> Word32# +rotateL# w i + | isTrue# (i ==# 0#) = w + | otherwise = wordToWord32# ( + ((word32ToWord# w) `uncheckedShiftL#` i) + `or#` ((word32ToWord# w) `uncheckedShiftRL#` (32# -# i))) +{-# INLINE rotateL# #-} + +-- key and nonce parsing ------------------------------------------------------ + +data Key = Key { + k0 :: {-# UNPACK #-} !Word32 + , k1 :: {-# UNPACK #-} !Word32 + , k2 :: {-# UNPACK #-} !Word32 + , k3 :: {-# UNPACK #-} !Word32 + , k4 :: {-# UNPACK #-} !Word32 + , k5 :: {-# UNPACK #-} !Word32 + , k6 :: {-# UNPACK #-} !Word32 + , k7 :: {-# UNPACK #-} !Word32 + } + deriving (Eq, Show) + +-- parse strict 256-bit bytestring (length unchecked) to key +_parse_key :: BS.ByteString -> Key +_parse_key bs = + let !(WSPair k0 t0) = unsafe_parseWsPair bs + !(WSPair k1 t1) = unsafe_parseWsPair t0 + !(WSPair k2 t2) = unsafe_parseWsPair t1 + !(WSPair k3 t3) = unsafe_parseWsPair t2 + !(WSPair k4 t4) = unsafe_parseWsPair t3 + !(WSPair k5 t5) = unsafe_parseWsPair t4 + !(WSPair k6 t6) = unsafe_parseWsPair t5 + !(WSPair k7 t7) = unsafe_parseWsPair t6 + in if BS.null t7 + then Key {..} + else error "ppad-chacha (_parse_key): bytes remaining" + +data Nonce = Nonce { + n0 :: {-# UNPACK #-} !Word32 + , n1 :: {-# UNPACK #-} !Word32 + , n2 :: {-# UNPACK #-} !Word32 + } + deriving (Eq, Show) + +-- parse strict 96-bit bytestring (length unchecked) to nonce +_parse_nonce :: BS.ByteString -> Nonce +_parse_nonce bs = + let !(WSPair n0 t0) = unsafe_parseWsPair bs + !(WSPair n1 t1) = unsafe_parseWsPair t0 + !(WSPair n2 t2) = unsafe_parseWsPair t1 + in if BS.null t2 + then Nonce {..} + else error "ppad-chacha (_parse_nonce): bytes remaining" + +-- chacha20 block function ---------------------------------------------------- + +newtype ChaCha s = ChaCha (PA.MutablePrimArray s Word32) + deriving Eq + +_chacha + :: PrimMonad m + => Key + -> Word32 + -> Nonce + -> m (ChaCha (PrimState m)) +_chacha key counter nonce = do + state <- _chacha_alloc + _chacha_set state key counter nonce + pure state + +-- allocate a new chacha state +_chacha_alloc :: PrimMonad m => m (ChaCha (PrimState m)) +_chacha_alloc = fmap ChaCha (PA.newPrimArray 16) +{-# INLINE _chacha_alloc #-} + +-- set the values of a chacha state +_chacha_set + :: PrimMonad m + => ChaCha (PrimState m) + -> Key + -> Word32 + -> Nonce + -> m () +_chacha_set (ChaCha arr) Key {..} counter Nonce {..}= do + PA.writePrimArray arr 00 0x61707865 + PA.writePrimArray arr 01 0x3320646e + PA.writePrimArray arr 02 0x79622d32 + PA.writePrimArray arr 03 0x6b206574 + PA.writePrimArray arr 04 k0 + PA.writePrimArray arr 05 k1 + PA.writePrimArray arr 06 k2 + PA.writePrimArray arr 07 k3 + PA.writePrimArray arr 08 k4 + PA.writePrimArray arr 09 k5 + PA.writePrimArray arr 10 k6 + PA.writePrimArray arr 11 k7 + PA.writePrimArray arr 12 counter + PA.writePrimArray arr 13 n0 + PA.writePrimArray arr 14 n1 + PA.writePrimArray arr 15 n2 +{-# INLINEABLE _chacha_set #-} + +_chacha_counter + :: PrimMonad m + => ChaCha (PrimState m) + -> Word32 + -> m () +_chacha_counter (ChaCha arr) counter = + PA.writePrimArray arr 12 counter + +-- two full rounds (eight quarter rounds) +_rounds :: PrimMonad m => ChaCha (PrimState m) -> m () +_rounds state = do + _quarter state 00 04 08 12 + _quarter state 01 05 09 13 + _quarter state 02 06 10 14 + _quarter state 03 07 11 15 + _quarter state 00 05 10 15 + _quarter state 01 06 11 12 + _quarter state 02 07 08 13 + _quarter state 03 04 09 14 +{-# INLINEABLE _rounds #-} + +_block + :: PrimMonad m + => ChaCha (PrimState m) + -> Word32 + -> m BS.ByteString +_block state@(ChaCha s) counter = do + _chacha_counter state counter + i <- PA.freezePrimArray s 0 16 + for_ [1..10 :: Int] (const (_rounds state)) + for_ [0..15 :: Int] $ \idx -> do + let iv = PA.indexPrimArray i idx + sv <- PA.readPrimArray s idx + PA.writePrimArray s idx (iv + sv) + serialize state + +-- RFC8439 2.3 + +-- | The ChaCha20 block function. Useful for generating a keystream. +-- +-- Per [RFC8439](https://datatracker.ietf.org/doc/html/rfc8439), the +-- key must be exactly 256 bits, and the nonce exactly 96 bits. +block + :: BS.ByteString -- ^ 256-bit key + -> Word32 -- ^ 32-bit counter + -> BS.ByteString -- ^ 96-bit nonce + -> BS.ByteString -- ^ 512-bit keystream +block key@(BI.PS _ _ kl) counter nonce@(BI.PS _ _ nl) + | kl /= 32 = error "ppad-chacha (block): invalid key" + | nl /= 12 = error "ppad-chacha (block): invalid nonce" + | otherwise = runST $ do + let k = _parse_key key + n = _parse_nonce nonce + state@(ChaCha s) <- _chacha k counter n + i <- PA.freezePrimArray s 0 16 + for_ [1..10 :: Int] (const (_rounds state)) + for_ [0..15 :: Int] $ \idx -> do + let iv = PA.indexPrimArray i idx + sv <- PA.readPrimArray s idx + PA.writePrimArray s idx (iv + sv) + serialize state + +serialize :: PrimMonad m => ChaCha (PrimState m) -> m BS.ByteString +serialize (ChaCha m) = do + w64_0 <- w64 <$> PA.readPrimArray m 00 <*> PA.readPrimArray m 01 + w64_1 <- w64 <$> PA.readPrimArray m 02 <*> PA.readPrimArray m 03 + w64_2 <- w64 <$> PA.readPrimArray m 04 <*> PA.readPrimArray m 05 + w64_3 <- w64 <$> PA.readPrimArray m 06 <*> PA.readPrimArray m 07 + w64_4 <- w64 <$> PA.readPrimArray m 08 <*> PA.readPrimArray m 09 + w64_5 <- w64 <$> PA.readPrimArray m 10 <*> PA.readPrimArray m 11 + w64_6 <- w64 <$> PA.readPrimArray m 12 <*> PA.readPrimArray m 13 + w64_7 <- w64 <$> PA.readPrimArray m 14 <*> PA.readPrimArray m 15 + pure . BS.toStrict . BSB.toLazyByteString . mconcat $ + [w64_0, w64_1, w64_2, w64_3, w64_4, w64_5, w64_6, w64_7] + where + w64 a b = BSB.word64LE (fi a .|. (fi b .<<. 32)) + +-- chacha20 encryption -------------------------------------------------------- + +-- RFC8439 2.4 + +-- | The ChaCha20 stream cipher. Generates a keystream and then XOR's +-- the supplied input with it; use it both to encrypt plaintext and +-- decrypt ciphertext. +-- +-- Per [RFC8439](https://datatracker.ietf.org/doc/html/rfc8439), the +-- key must be exactly 256 bits, and the nonce exactly 96 bits. +-- +-- >>> let key = "don't tell anyone my secret key!" +-- >>> let non = "or my nonce!" +-- >>> let cip = cipher key 1 non "but you can share the plaintext" +-- >>> cip +-- "\192*c\248A\204\211n\130y8\197\146k\245\178Y\197=\180_\223\138\146:^\206\&0\v[\201" +-- >>> cipher key 1 non cip +-- "but you can share the plaintext" +cipher + :: BS.ByteString -- ^ 256-bit key + -> Word32 -- ^ 32-bit counter + -> BS.ByteString -- ^ 96-bit nonce + -> BS.ByteString -- ^ arbitrary-length plaintext + -> BS.ByteString -- ^ ciphertext +cipher raw_key@(BI.PS _ _ kl) counter raw_nonce@(BI.PS _ _ nl) plaintext + | kl /= 32 = error "ppad-chacha (cipher): invalid key" + | nl /= 12 = error "ppad-chacha (cipher): invalid nonce" + | otherwise = runST $ do + let key = _parse_key raw_key + non = _parse_nonce raw_nonce + _cipher key counter non plaintext + +_cipher + :: PrimMonad m + => Key + -> Word32 + -> Nonce + -> BS.ByteString + -> m BS.ByteString +_cipher key counter nonce plaintext = do + ChaCha initial <- _chacha key counter nonce + state@(ChaCha s) <- _chacha_alloc + + let loop acc !j bs = case BS.splitAt 64 bs of + (chunk@(BI.PS _ _ l), etc) + | l == 0 && BS.length etc == 0 -> pure $ + BS.toStrict (BSB.toLazyByteString acc) + | otherwise -> do + PA.copyMutablePrimArray s 0 initial 0 16 + stream <- _block state j + let cip = BS.packZipWith (.^.) chunk stream + loop (acc <> BSB.byteString cip) (j + 1) etc + + loop mempty counter plaintext +{-# INLINE _cipher #-} + diff --git a/ppad-chacha.cabal b/ppad-chacha.cabal new file mode 100644 --- /dev/null +++ b/ppad-chacha.cabal @@ -0,0 +1,65 @@ +cabal-version: 3.0 +name: ppad-chacha +version: 0.1.0 +synopsis: A pure ChaCha20 stream cipher +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 ChaCha20 stream cipher and block function. + +source-repository head + type: git + location: git.ppad.tech/chacha.git + +library + default-language: Haskell2010 + hs-source-dirs: lib + ghc-options: + -Wall + exposed-modules: + Crypto.Cipher.ChaCha20 + build-depends: + base >= 4.9 && < 5 + , bytestring >= 0.9 && < 0.13 + , primitive >= 0.8 && < 0.10 + +test-suite chacha-tests + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs + + ghc-options: + -rtsopts -Wall -O2 + + build-depends: + base + , bytestring + , ppad-base16 + , ppad-chacha + , primitive + , tasty + , tasty-hunit + +benchmark chacha-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-chacha + diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE UnboxedTuples #-} + +module Main where + +import qualified Crypto.Cipher.ChaCha20 as ChaCha +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as B16 +import Data.Foldable (for_) +import Data.Maybe (fromJust) +import qualified Data.Primitive.PrimArray as PA +import Data.Word (Word32) +import Test.Tasty +import qualified Test.Tasty.HUnit as H + +main :: IO () +main = defaultMain $ testGroup "ppad-chacha" [ + quarter + , quarter_fullstate + , chacha20_block_init + , chacha20_rounds + , encrypt + ] + +quarter :: TestTree +quarter = H.testCase "quarter round" $ do + let e = (0xea2a92f4, 0xcb1cf8ce, 0x4581472e, 0x5881c4bb) + o = ChaCha._quarter_pure 0x11111111 0x01020304 0x9b8d6f43 0x01234567 + H.assertEqual mempty e o + +quarter_fullstate :: TestTree +quarter_fullstate = H.testCase "quarter round (full chacha state)" $ do + let inp :: PA.PrimArray Word32 + inp = PA.primArrayFromList [ + 0x879531e0, 0xc5ecf37d, 0x516461b1, 0xc9a62f8a + , 0x44c20ef3, 0x3390af7f, 0xd9fc690b, 0x2a5f714c + , 0x53372767, 0xb00a5631, 0x974c541a, 0x359e9963 + , 0x5c971061, 0x3d631689, 0x2098d9d6, 0x91dbd320 + ] + hot <- PA.unsafeThawPrimArray inp + + ChaCha._quarter (ChaCha.ChaCha hot) 2 7 8 13 + + o <- PA.unsafeFreezePrimArray hot + + let e :: PA.PrimArray Word32 + e = PA.primArrayFromList [ + 0x879531e0, 0xc5ecf37d, 0xbdb886dc, 0xc9a62f8a + , 0x44c20ef3, 0x3390af7f, 0xd9fc690b, 0xcfacafd2 + , 0xe46bea80, 0xb00a5631, 0x974c541a, 0x359e9963 + , 0x5c971061, 0xccc07c79, 0x2098d9d6, 0x91dbd320 + ] + + H.assertEqual mempty e o + +block_key :: BS.ByteString +block_key = fromJust $ + B16.decode "000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f" + +block_non :: BS.ByteString +block_non = fromJust $ B16.decode "000000090000004a00000000" + +chacha20_block_init :: TestTree +chacha20_block_init = H.testCase "chacha20 state init" $ do + let key = ChaCha._parse_key block_key + non = ChaCha._parse_nonce block_non + ChaCha.ChaCha foo <- ChaCha._chacha key 1 non + state <- PA.freezePrimArray foo 0 16 + let ref = PA.primArrayFromList [ + 0x61707865, 0x3320646e, 0x79622d32, 0x6b206574 + , 0x03020100, 0x07060504, 0x0b0a0908, 0x0f0e0d0c + , 0x13121110, 0x17161514, 0x1b1a1918, 0x1f1e1d1c + , 0x00000001, 0x09000000, 0x4a000000, 0x00000000 + ] + H.assertEqual mempty ref state + +chacha20_rounds :: TestTree +chacha20_rounds = H.testCase "chacha20 20 rounds" $ do + let key = ChaCha._parse_key block_key + non = ChaCha._parse_nonce block_non + state@(ChaCha.ChaCha s) <- ChaCha._chacha key 1 non + for_ [1..10 :: Int] (const (ChaCha._rounds state)) + + out <- PA.freezePrimArray s 0 16 + + let ref = PA.primArrayFromList [ + 0x837778ab, 0xe238d763, 0xa67ae21e, 0x5950bb2f + , 0xc4f2d0c7, 0xfc62bb2f, 0x8fa018fc, 0x3f5ec7b7 + , 0x335271c2, 0xf29489f3, 0xeabda8fc, 0x82e46ebd + , 0xd19c12b4, 0xb04e16de, 0x9e83d0cb, 0x4e3c50a2 + ] + + H.assertEqual mempty ref out + +crypt_plain :: BS.ByteString +crypt_plain = case B16.decode "4c616469657320616e642047656e746c656d656e206f662074686520636c617373206f66202739393a204966204920636f756c64206f6666657220796f75206f6e6c79206f6e652074697020666f7220746865206675747572652c2073756e73637265656e20776f756c642062652069742e" of + Nothing -> error "bang" + Just x -> x + +crypt_cip :: BS.ByteString +crypt_cip = case B16.decode "6e2e359a2568f98041ba0728dd0d6981e97e7aec1d4360c20a27afccfd9fae0bf91b65c5524733ab8f593dabcd62b3571639d624e65152ab8f530c359f0861d807ca0dbf500d6a6156a38e088a22b65e52bc514d16ccf806818ce91ab77937365af90bbf74a35be6b40b8eedf2785e42874d" of + Nothing -> error "bang" + Just x -> x + +crypt_non :: BS.ByteString +crypt_non = case B16.decode "000000000000004a00000000" of + Nothing -> error "bang" + Just x -> x + +encrypt :: TestTree +encrypt = H.testCase "chacha20 encrypt" $ do + let o = ChaCha.cipher block_key 1 crypt_non crypt_plain + H.assertEqual mempty crypt_cip o +