commit c8020aeca19443c657a234640944b6195bb4635d
parent 87c9dca265c7ff26e2a5aa0767d1780d21a50fc8
Author: Jared Tobin <jared@jtobin.io>
Date: Fri, 7 Mar 2025 16:11:41 +0400
lib: some renaming
(I'm growing to love underscores.)
Diffstat:
4 files changed, 348 insertions(+), 313 deletions(-)
diff --git a/lib/Crypto/Cipher/ChaCha.hs b/lib/Crypto/Cipher/ChaCha.hs
@@ -1,300 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE UnboxedTuples #-}
-
-module Crypto.Cipher.ChaCha where
-
-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)
-
--- for easy testing
-quarter'
- :: Word32 -> Word32 -> Word32 -> Word32 -> (Word32, Word32, Word32, Word32)
-quarter' (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' #-}
-
--- 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 #-}
-
--- XX can be optimised more (only change counter)
-
--- 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
-
-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 --------------------------------------------------------
-
-encrypt
- :: PrimMonad m
- => BS.ByteString
- -> Word32
- -> BS.ByteString
- -> BS.ByteString
- -> m BS.ByteString
-encrypt raw_key@(BI.PS _ _ kl) counter raw_nonce@(BI.PS _ _ nl) plaintext
- | kl /= 32 = error "ppad-chacha (encrypt): invalid key"
- | nl /= 12 = error "ppad-chacha (encrypt): invalid nonce"
- | otherwise = do
- let key = parse_key raw_key
- non = parse_nonce raw_nonce
- _encrypt key counter non plaintext
-
-_encrypt
- :: PrimMonad m
- => Key
- -> Word32
- -> Nonce
- -> BS.ByteString
- -> m BS.ByteString
-_encrypt 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 _encrypt #-}
-
diff --git a/lib/Crypto/Cipher/ChaCha20.hs b/lib/Crypto/Cipher/ChaCha20.hs
@@ -0,0 +1,335 @@
+{-# OPTIONS_HADDOCK prune #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Crypto.Cipher.ChaCha20 (
+ -- * ChaCha20 block function
+ block
+
+ -- * ChaCha20 stream cipher
+ , encrypt
+
+ -- testing
+ , ChaCha(..)
+ , _chacha
+ , _parse_key
+ , _parse_nonce
+ , _quarter
+ , _quarter_pure
+ , _rounds
+ ) where
+
+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
+
+block
+ :: PrimMonad m
+ => BS.ByteString
+ -> Word32
+ -> BS.ByteString
+ -> m BS.ByteString
+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 = 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 --------------------------------------------------------
+
+encrypt
+ :: PrimMonad m
+ => BS.ByteString
+ -> Word32
+ -> BS.ByteString
+ -> BS.ByteString
+ -> m BS.ByteString
+encrypt raw_key@(BI.PS _ _ kl) counter raw_nonce@(BI.PS _ _ nl) plaintext
+ | kl /= 32 = error "ppad-chacha (encrypt): invalid key"
+ | nl /= 12 = error "ppad-chacha (encrypt): invalid nonce"
+ | otherwise = do
+ let key = _parse_key raw_key
+ non = _parse_nonce raw_nonce
+ _encrypt key counter non plaintext
+
+_encrypt
+ :: PrimMonad m
+ => Key
+ -> Word32
+ -> Nonce
+ -> BS.ByteString
+ -> m BS.ByteString
+_encrypt 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 _encrypt #-}
+
diff --git a/ppad-chacha.cabal b/ppad-chacha.cabal
@@ -1,7 +1,7 @@
cabal-version: 3.0
name: ppad-chacha
version: 0.1.0
-synopsis: A pure ChaCha stream cipher
+synopsis: A pure ChaCha20 stream cipher
license: MIT
license-file: LICENSE
author: Jared Tobin
@@ -11,7 +11,7 @@ build-type: Simple
tested-with: GHC == 9.8.1
extra-doc-files: CHANGELOG
description:
- A pure ChaCha stream cipher
+ A pure ChaCha20 stream cipher
source-repository head
type: git
@@ -23,7 +23,7 @@ library
ghc-options:
-Wall
exposed-modules:
- Crypto.Cipher.ChaCha
+ Crypto.Cipher.ChaCha20
build-depends:
base >= 4.9 && < 5
, bytestring >= 0.9 && < 0.13
diff --git a/test/Main.hs b/test/Main.hs
@@ -5,7 +5,7 @@
module Main where
-import qualified Crypto.Cipher.ChaCha as ChaCha
+import qualified Crypto.Cipher.ChaCha20 as ChaCha
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import Data.Foldable (for_)
@@ -27,7 +27,7 @@ main = defaultMain $ testGroup "ppad-chacha" [
quarter :: TestTree
quarter = H.testCase "quarter round" $ do
let e = (0xea2a92f4, 0xcb1cf8ce, 0x4581472e, 0x5881c4bb)
- o = ChaCha.quarter' 0x11111111 0x01020304 0x9b8d6f43 0x01234567
+ o = ChaCha._quarter_pure 0x11111111 0x01020304 0x9b8d6f43 0x01234567
H.assertEqual mempty e o
quarter_fullstate :: TestTree
@@ -41,7 +41,7 @@ quarter_fullstate = H.testCase "quarter round (full chacha state)" $ do
]
hot <- PA.unsafeThawPrimArray inp
- ChaCha.quarter (ChaCha.ChaCha hot) 2 7 8 13
+ ChaCha._quarter (ChaCha.ChaCha hot) 2 7 8 13
o <- PA.unsafeFreezePrimArray hot
@@ -64,9 +64,9 @@ 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
+ 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
@@ -78,10 +78,10 @@ chacha20_block_init = H.testCase "chacha20 state init" $ do
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))
+ 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
