ChaCha20Poly1305.hs (5176B)
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 -- | Error values. 76 data Error = 77 InvalidKey -- ^ the provided key was not 256 bits long 78 | InvalidNonce -- ^ the provided nonce was not 96 bits long 79 | InvalidMAC -- ^ the provided MAC does not authenticate the ciphertext 80 deriving (Eq, Show) 81 82 -- RFC8439 2.8 83 84 -- | Perform authenticated encryption on a plaintext and some additional 85 -- authenticated data, given a 256-bit key and 96-bit nonce, using 86 -- AEAD-ChaCha20-Poly1305. 87 -- 88 -- Produces a ciphertext and 128-bit message authentication code pair. 89 -- 90 -- >>> let key = "don't tell anyone my secret key!" 91 -- >>> let non = "or my nonce!" 92 -- >>> let pan = "and here's my plaintext" 93 -- >>> let aad = "i approve this message" 94 -- >>> let Right (cip, mac) = encrypt aad key nonce pan 95 -- >>> (cip, mac) 96 -- <(ciphertext, 128-bit MAC)> 97 encrypt 98 :: BS.ByteString -- ^ arbitrary-length additional authenticated data 99 -> BS.ByteString -- ^ 256-bit key 100 -> BS.ByteString -- ^ 96-bit nonce 101 -> BS.ByteString -- ^ arbitrary-length plaintext 102 -> Either Error (BS.ByteString, BS.ByteString) -- ^ (ciphertext, 128-bit MAC) 103 encrypt aad key nonce plaintext 104 | BS.length key /= 32 = Left InvalidKey 105 | BS.length nonce /= 12 = Left InvalidNonce 106 | otherwise = do 107 otk <- _poly1305_key_gen key nonce 108 case ChaCha20.cipher key 1 nonce plaintext of 109 Left ChaCha20.InvalidKey -> Left InvalidKey -- impossible, but.. 110 Left ChaCha20.InvalidNonce -> Left InvalidNonce -- ditto 111 Right cip -> do 112 let md0 = aad <> pad16 aad 113 md1 = md0 <> cip <> pad16 cip 114 md2 = md1 <> unroll8 (fi (BS.length aad)) 115 md3 = md2 <> unroll8 (fi (BS.length cip)) 116 case Poly1305.mac otk md3 of 117 Nothing -> Left InvalidKey 118 Just tag -> pure (cip, tag) 119 120 -- | Decrypt an authenticated ciphertext, given a message authentication 121 -- code and some additional authenticated data, via a 256-bit key and 122 -- 96-bit nonce. 123 -- 124 -- >>> decrypt aad key non (cip, mac) 125 -- Right "and here's my plaintext" 126 -- >>> decrypt aad key non (cip, "it's a valid mac") 127 -- Left InvalidMAC 128 decrypt 129 :: BS.ByteString -- ^ arbitrary-length AAD 130 -> BS.ByteString -- ^ 256-bit key 131 -> BS.ByteString -- ^ 96-bit nonce 132 -> (BS.ByteString, BS.ByteString) -- ^ (arbitrary-length ciphertext, 128-bit MAC) 133 -> Either Error BS.ByteString 134 decrypt aad key nonce (cip, mac) 135 | BS.length key /= 32 = Left InvalidKey 136 | BS.length nonce /= 12 = Left InvalidNonce 137 | BS.length mac /= 16 = Left InvalidMAC 138 | otherwise = do 139 otk <- _poly1305_key_gen key nonce 140 let md0 = aad <> pad16 aad 141 md1 = md0 <> cip <> pad16 cip 142 md2 = md1 <> unroll8 (fi (BS.length aad)) 143 md3 = md2 <> unroll8 (fi (BS.length cip)) 144 case Poly1305.mac otk md3 of 145 Nothing -> Left InvalidKey 146 Just tag 147 | mac == tag -> case ChaCha20.cipher key 1 nonce cip of 148 Left ChaCha20.InvalidKey -> Left InvalidKey 149 Left ChaCha20.InvalidNonce -> Left InvalidNonce 150 Right v -> pure v 151 | otherwise -> 152 Left InvalidMAC 153