packages feed

ppad-chacha (empty) → 0.1.0

raw patch · 6 files changed

+606/−0 lines, 6 filesdep +basedep +bytestringdep +criterion

Dependencies added: base, bytestring, criterion, ppad-base16, ppad-chacha, primitive, tasty, tasty-hunit

Files

+ CHANGELOG view
@@ -0,0 +1,6 @@+# Changelog++- 0.1.0 (2025-03-09)+  * Initial release, supporting the chacha20 stream cipher and block+    function.+
+ 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,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+  ]+
+ lib/Crypto/Cipher/ChaCha20.hs view
@@ -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 <jared@ppad.tech>+--+-- 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 #-}+
+ ppad-chacha.cabal view
@@ -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+
+ test/Main.hs view
@@ -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+