ChaCha20Poly1305.hs (5462B)
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 Data.Word (Word64) 35 36 fi :: (Integral a, Num b) => a -> b 37 fi = fromIntegral 38 {-# INLINE fi #-} 39 40 -- constant-time equality comparison on bytestrings 41 ct_eq :: BS.ByteString -> BS.ByteString -> Bool 42 ct_eq a@(BI.PS _ _ la) b@(BI.PS _ _ lb) 43 | la /= lb = False 44 | otherwise = BS.foldl' (B..|.) 0 (BS.packZipWith B.xor a b) == 0 45 {-# INLINE ct_eq #-} 46 47 -- little-endian bytestring encoding 48 unroll :: Word64 -> BS.ByteString 49 unroll i = case i of 50 0 -> BS.singleton 0 51 _ -> BS.unfoldr coalg i 52 where 53 coalg = \case 54 0 -> Nothing 55 m -> Just $! (fi m, m .>>. 8) 56 {-# INLINE unroll #-} 57 58 -- little-endian bytestring encoding for 64-bit ints, right-padding with zeros 59 unroll8 :: Word64 -> BS.ByteString 60 unroll8 (unroll -> u@(BI.PS _ _ l)) 61 | l < 8 = u <> BS.replicate (8 - l) 0 62 | otherwise = u 63 {-# INLINE unroll8 #-} 64 65 -- RFC8439 2.6 66 67 _poly1305_key_gen 68 :: BS.ByteString -- ^ 256-bit initial keying material 69 -> BS.ByteString -- ^ 96-bit nonce 70 -> Either Error BS.ByteString -- ^ 256-bit key (suitable for poly1305) 71 _poly1305_key_gen key nonce = case ChaCha20.block key 0 nonce of 72 Left ChaCha20.InvalidKey -> Left InvalidKey 73 Left ChaCha20.InvalidNonce -> Left InvalidNonce 74 Right k -> pure (BS.take 32 k) 75 {-# INLINEABLE _poly1305_key_gen #-} 76 77 pad16 :: BS.ByteString -> BS.ByteString 78 pad16 (BI.PS _ _ l) 79 | l `rem` 16 == 0 = mempty 80 | otherwise = BS.replicate (16 - l `rem` 16) 0 81 {-# INLINE pad16 #-} 82 83 -- | Error values. 84 data Error = 85 InvalidKey -- ^ the provided key was not 256 bits long 86 | InvalidNonce -- ^ the provided nonce was not 96 bits long 87 | InvalidMAC -- ^ the provided MAC does not authenticate the ciphertext 88 deriving (Eq, Show) 89 90 -- RFC8439 2.8 91 92 -- | Perform authenticated encryption on a plaintext and some additional 93 -- authenticated data, given a 256-bit key and 96-bit nonce, using 94 -- AEAD-ChaCha20-Poly1305. 95 -- 96 -- Produces a ciphertext and 128-bit message authentication code pair. 97 -- 98 -- >>> let key = "don't tell anyone my secret key!" 99 -- >>> let non = "or my nonce!" 100 -- >>> let pan = "and here's my plaintext" 101 -- >>> let aad = "i approve this message" 102 -- >>> let Right (cip, mac) = encrypt aad key nonce pan 103 -- >>> (cip, mac) 104 -- <(ciphertext, 128-bit MAC)> 105 encrypt 106 :: BS.ByteString -- ^ arbitrary-length additional authenticated data 107 -> BS.ByteString -- ^ 256-bit key 108 -> BS.ByteString -- ^ 96-bit nonce 109 -> BS.ByteString -- ^ arbitrary-length plaintext 110 -> Either Error (BS.ByteString, BS.ByteString) -- ^ (ciphertext, 128-bit MAC) 111 encrypt aad key nonce plaintext 112 | BS.length key /= 32 = Left InvalidKey 113 | BS.length nonce /= 12 = Left InvalidNonce 114 | otherwise = do 115 otk <- _poly1305_key_gen key nonce 116 case ChaCha20.cipher key 1 nonce plaintext of 117 Left ChaCha20.InvalidKey -> Left InvalidKey -- impossible, but.. 118 Left ChaCha20.InvalidNonce -> Left InvalidNonce -- ditto 119 Right cip -> do 120 let md0 = aad <> pad16 aad 121 md1 = md0 <> cip <> pad16 cip 122 md2 = md1 <> unroll8 (fi (BS.length aad)) 123 md3 = md2 <> unroll8 (fi (BS.length cip)) 124 case Poly1305.mac otk md3 of 125 Nothing -> Left InvalidKey 126 Just tag -> pure (cip, tag) 127 128 -- | Decrypt an authenticated ciphertext, given a message authentication 129 -- code and some additional authenticated data, via a 256-bit key and 130 -- 96-bit nonce. 131 -- 132 -- >>> decrypt aad key non (cip, mac) 133 -- Right "and here's my plaintext" 134 -- >>> decrypt aad key non (cip, "it's a valid mac") 135 -- Left InvalidMAC 136 decrypt 137 :: BS.ByteString -- ^ arbitrary-length AAD 138 -> BS.ByteString -- ^ 256-bit key 139 -> BS.ByteString -- ^ 96-bit nonce 140 -> (BS.ByteString, BS.ByteString) -- ^ (arbitrary-length ciphertext, 128-bit MAC) 141 -> Either Error BS.ByteString 142 decrypt aad key nonce (cip, mac) 143 | BS.length key /= 32 = Left InvalidKey 144 | BS.length nonce /= 12 = Left InvalidNonce 145 | BS.length mac /= 16 = Left InvalidMAC 146 | otherwise = do 147 otk <- _poly1305_key_gen key nonce 148 let md0 = aad <> pad16 aad 149 md1 = md0 <> cip <> pad16 cip 150 md2 = md1 <> unroll8 (fi (BS.length aad)) 151 md3 = md2 <> unroll8 (fi (BS.length cip)) 152 case Poly1305.mac otk md3 of 153 Nothing -> Left InvalidKey 154 Just tag 155 | ct_eq mac tag -> case ChaCha20.cipher key 1 nonce cip of 156 Left ChaCha20.InvalidKey -> Left InvalidKey 157 Left ChaCha20.InvalidNonce -> Left InvalidNonce 158 Right v -> pure v 159 | otherwise -> 160 Left InvalidMAC 161