ChaCha20Poly1305.hs (5946B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE LambdaCase #-} 4 {-# LANGUAGE OverloadedStrings #-} 5 {-# LANGUAGE ViewPatterns #-} 6 7 -- | 8 -- Module: Crypto.AEAD.ChaCha20Poly1305 9 -- Copyright: (c) 2025 Jared Tobin 10 -- License: MIT 11 -- Maintainer: Jared Tobin <jared@ppad.tech> 12 -- 13 -- A pure AEAD-ChaCha20-Poly1305 implementation, as specified by 14 -- [RFC 8439](https://datatracker.ietf.org/doc/html/rfc8439). 15 16 module Crypto.AEAD.ChaCha20Poly1305 ( 17 -- * AEAD construction 18 encrypt 19 , decrypt 20 21 -- * Error information 22 , Error(..) 23 24 -- testing 25 , _poly1305_key_gen 26 ) where 27 28 import qualified Crypto.Cipher.ChaCha20 as ChaCha20 29 import qualified Crypto.MAC.Poly1305 as Poly1305 30 import Data.Bits ((.>>.)) 31 import qualified Data.Bits as B 32 import qualified Data.ByteString as BS 33 import qualified Data.ByteString.Internal as BI 34 import qualified Data.ByteString.Unsafe as BU 35 import Data.Word (Word8, Word64) 36 37 fi :: (Integral a, Num b) => a -> b 38 fi = fromIntegral 39 {-# INLINE fi #-} 40 41 -- constant-time equality comparison on bytestrings. fused fold: OR 42 -- the bytewise XORs into an accumulator directly, rather than via 43 -- packZipWith, so no intermediate ByteString holding the 44 -- (secret-derived) difference bytes is ever materialised on the 45 -- heap. 46 ct_eq :: BS.ByteString -> BS.ByteString -> Bool 47 ct_eq a@(BI.PS _ _ la) b@(BI.PS _ _ lb) 48 | la /= lb = False 49 | otherwise = go 0 0 50 where 51 go :: Word8 -> Int -> Bool 52 go !acc !i 53 | i == la = acc == 0 54 | otherwise = 55 let !x = BU.unsafeIndex a i 56 !y = BU.unsafeIndex b i 57 in go (acc B..|. B.xor x y) (i + 1) 58 {-# INLINE ct_eq #-} 59 60 -- little-endian bytestring encoding 61 unroll :: Word64 -> BS.ByteString 62 unroll i = case i of 63 0 -> BS.singleton 0 64 _ -> BS.unfoldr coalg i 65 where 66 coalg = \case 67 0 -> Nothing 68 m -> Just $! (fi m, m .>>. 8) 69 {-# INLINE unroll #-} 70 71 -- little-endian bytestring encoding for 64-bit ints, right-padding with zeros 72 unroll8 :: Word64 -> BS.ByteString 73 unroll8 (unroll -> u@(BI.PS _ _ l)) 74 | l < 8 = u <> BS.replicate (8 - l) 0 75 | otherwise = u 76 {-# INLINE unroll8 #-} 77 78 -- RFC8439 2.6 79 80 _poly1305_key_gen 81 :: BS.ByteString -- ^ 256-bit initial keying material 82 -> BS.ByteString -- ^ 96-bit nonce 83 -> Either Error BS.ByteString -- ^ 256-bit key (suitable for poly1305) 84 _poly1305_key_gen key nonce = case ChaCha20.block key 0 nonce of 85 Left ChaCha20.InvalidKey -> Left InvalidKey 86 Left ChaCha20.InvalidNonce -> Left InvalidNonce 87 Right k -> pure (BS.take 32 k) 88 {-# INLINEABLE _poly1305_key_gen #-} 89 90 pad16 :: BS.ByteString -> BS.ByteString 91 pad16 (BI.PS _ _ l) 92 | l `rem` 16 == 0 = mempty 93 | otherwise = BS.replicate (16 - l `rem` 16) 0 94 {-# INLINE pad16 #-} 95 96 -- | Error values. 97 data Error = 98 InvalidKey -- ^ the provided key was not 256 bits long 99 | InvalidNonce -- ^ the provided nonce was not 96 bits long 100 | InvalidMAC -- ^ the provided MAC does not authenticate the ciphertext 101 deriving (Eq, Show) 102 103 -- RFC8439 2.8 104 105 -- | Perform authenticated encryption on a plaintext and some additional 106 -- authenticated data, given a 256-bit key and 96-bit nonce, using 107 -- AEAD-ChaCha20-Poly1305. 108 -- 109 -- Produces a ciphertext and 128-bit message authentication code pair. 110 -- 111 -- >>> let key = "don't tell anyone my secret key!" 112 -- >>> let non = "or my nonce!" 113 -- >>> let pan = "and here's my plaintext" 114 -- >>> let aad = "i approve this message" 115 -- >>> let Right (cip, mac) = encrypt aad key nonce pan 116 -- >>> (cip, mac) 117 -- <(ciphertext, 128-bit MAC)> 118 encrypt 119 :: BS.ByteString -- ^ arbitrary-length additional authenticated data 120 -> BS.ByteString -- ^ 256-bit key 121 -> BS.ByteString -- ^ 96-bit nonce 122 -> BS.ByteString -- ^ arbitrary-length plaintext 123 -> Either Error (BS.ByteString, BS.ByteString) -- ^ (ciphertext, 128-bit MAC) 124 encrypt aad key nonce plaintext 125 | BS.length key /= 32 = Left InvalidKey 126 | BS.length nonce /= 12 = Left InvalidNonce 127 | otherwise = do 128 otk <- _poly1305_key_gen key nonce 129 case ChaCha20.cipher key 1 nonce plaintext of 130 Left ChaCha20.InvalidKey -> Left InvalidKey -- impossible, but.. 131 Left ChaCha20.InvalidNonce -> Left InvalidNonce -- ditto 132 Right cip -> do 133 let md0 = aad <> pad16 aad 134 md1 = md0 <> cip <> pad16 cip 135 md2 = md1 <> unroll8 (fi (BS.length aad)) 136 md3 = md2 <> unroll8 (fi (BS.length cip)) 137 case Poly1305.mac otk md3 of 138 Nothing -> Left InvalidKey 139 Just (Poly1305.MAC tag) -> pure (cip, tag) 140 141 -- | Decrypt an authenticated ciphertext, given a message authentication 142 -- code and some additional authenticated data, via a 256-bit key and 143 -- 96-bit nonce. 144 -- 145 -- >>> decrypt aad key non (cip, mac) 146 -- Right "and here's my plaintext" 147 -- >>> decrypt aad key non (cip, "it's a valid mac") 148 -- Left InvalidMAC 149 decrypt 150 :: BS.ByteString -- ^ arbitrary-length AAD 151 -> BS.ByteString -- ^ 256-bit key 152 -> BS.ByteString -- ^ 96-bit nonce 153 -> (BS.ByteString, BS.ByteString) -- ^ (arbitrary-length ciphertext, 128-bit MAC) 154 -> Either Error BS.ByteString 155 decrypt aad key nonce (cip, mac) 156 | BS.length key /= 32 = Left InvalidKey 157 | BS.length nonce /= 12 = Left InvalidNonce 158 | BS.length mac /= 16 = Left InvalidMAC 159 | otherwise = do 160 otk <- _poly1305_key_gen key nonce 161 let md0 = aad <> pad16 aad 162 md1 = md0 <> cip <> pad16 cip 163 md2 = md1 <> unroll8 (fi (BS.length aad)) 164 md3 = md2 <> unroll8 (fi (BS.length cip)) 165 case Poly1305.mac otk md3 of 166 Nothing -> Left InvalidKey 167 Just (Poly1305.MAC tag) 168 | ct_eq mac tag -> case ChaCha20.cipher key 1 nonce cip of 169 Left ChaCha20.InvalidKey -> Left InvalidKey 170 Left ChaCha20.InvalidNonce -> Left InvalidNonce 171 Right v -> pure v 172 | otherwise -> 173 Left InvalidMAC 174