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