mutants-1.patch (4277B)
1 From f586b1456b5f154481db567da20bba724ec12cc1 Mon Sep 17 00:00:00 2001 2 From: Jared Tobin <jared@jtobin.io> 3 Date: Tue, 6 Oct 2026 11:44:42 +0400 4 Subject: [PATCH] exp: timing mutants for elenchus baselines 5 6 --- 7 lib/Crypto/MAC/Poly1305.hs | 53 +++++++++++++++++++++----------------- 8 1 file changed, 30 insertions(+), 23 deletions(-) 9 10 diff --git a/lib/Crypto/MAC/Poly1305.hs b/lib/Crypto/MAC/Poly1305.hs 11 index fb0c261..aa919be 100644 12 --- a/lib/Crypto/MAC/Poly1305.hs 13 +++ b/lib/Crypto/MAC/Poly1305.hs 14 @@ -27,7 +27,6 @@ module Crypto.MAC.Poly1305 ( 15 ) where 16 17 import qualified Crypto.MAC.Poly1305.Arm as Arm 18 -import Data.Barrier (barrier) 19 import qualified Data.Bits as B 20 import qualified Data.ByteString as BS 21 import qualified Data.ByteString.Internal as BI 22 @@ -131,8 +130,23 @@ shr130 (Wider (# _, _, l2, l3 #)) = 23 24 ------------------------------------------------------------------------------- 25 26 +-- clear the top four bits of r's bytes 3, 7, 11, and 15 27 +nibble :: BS.ByteString 28 +nibble = BS.pack [ fromIntegral (j B..&. 0x0f) | j <- [0 .. 255 :: Int] ] 29 +{-# NOINLINE nibble #-} 30 + 31 +clamp_bytes :: BS.ByteString -> BS.ByteString 32 +clamp_bytes k = BS.pack (fmap byte [0 .. 15]) 33 + where 34 + byte :: Int -> Word8 35 + byte i 36 + | i B..&. 3 == 3 = 37 + BU.unsafeIndex nibble (fromIntegral (BU.unsafeIndex k i)) 38 + | otherwise = BU.unsafeIndex k i 39 + 40 +-- clear the bottom two bits of r's bytes 4, 8, and 12 41 clamp :: Wider -> Wider 42 -clamp r = r `W.and` 0x0ffffffc0ffffffc0ffffffc0fffffff 43 +clamp r = r `W.and` 0xfffffffcfffffffcfffffffcffffffff 44 {-# INLINE clamp #-} 45 46 -- | A Poly1305 message authentication code. 47 @@ -156,22 +170,13 @@ instance Eq MAC where 48 -- Runs in variable-time only for invalid inputs. 49 (MAC a@(BI.PS _ _ la)) == (MAC b@(BI.PS _ _ lb)) 50 | la /= lb = False 51 - | otherwise = go 0 0 52 + | otherwise = go 0 53 where 54 - -- fused fold: OR the bytewise XORs into an accumulator 55 - -- directly, rather than via packZipWith, so no intermediate 56 - -- ByteString holding the (secret-derived) difference bytes 57 - -- is ever materialised on the heap. The accumulator is routed 58 - -- through 'barrier' before the zero-test so the LLVM backend 59 - -- cannot recover the array-equality idiom and short-circuit on 60 - -- the first mismatch (see "Data.Barrier"). 61 - go :: Word8 -> Int -> Bool 62 - go !acc !i 63 - | i == la = barrier acc == 0 64 - | otherwise = 65 - let !x = BU.unsafeIndex a i 66 - !y = BU.unsafeIndex b i 67 - in go (acc B..|. B.xor x y) (i + 1) 68 + go :: Int -> Bool 69 + go !i 70 + | i == la = True 71 + | BU.unsafeIndex a i /= BU.unsafeIndex b i = False 72 + | otherwise = go (i + 1) 73 74 -- | Produce a Poly1305 MAC for the provided message, given the 75 -- provided key. 76 @@ -189,10 +194,12 @@ mac 77 -> Maybe MAC -- ^ 128-bit message authentication code 78 mac key@(BI.PS _ _ kl) msg 79 | kl /= 32 = Nothing 80 + | BS.null msg = pure $! MAC (BS.copy (BS.drop 16 key)) 81 | Arm.poly1305_arm_available = 82 pure $! MAC (Arm.mac key msg) 83 | otherwise = 84 - let (clamp . _roll16 -> r, _roll16 -> s) = BS.splitAt 16 key 85 + let (clamp . _roll16 . clamp_bytes -> r, _roll16 -> s) = 86 + BS.splitAt 16 key 87 in pure $! (MAC (_poly1305_loop r s msg)) 88 89 -- p = 2^130 - 5 90 @@ -217,10 +224,9 @@ reduce_full h = 91 !hi = shr130 h 92 !h' = lo + 5 * hi 93 !h_5 = h' + 5 94 - !reduced = h_5 `W.and` mask130 95 - !carry = shr130 h_5 96 - !gte = W.lt 0 carry 97 - in W.select h' reduced gte 98 + in if W.lt_vartime mask130 h_5 99 + then h_5 `W.and` mask130 100 + else h' 101 {-# INLINE reduce_full #-} 102 103 _poly1305_loop :: Wider -> Wider -> BS.ByteString -> BS.ByteString 104 @@ -231,7 +237,8 @@ _poly1305_loop !r !s !msg = 105 let !final = reduce_full (reduce_partial acc) 106 in unroll16 (final + s) 107 | otherwise -> 108 - let !n = _roll16 chunk `W.or` set_hi l 109 + let !n | BS.all (== 0) chunk = set_hi l 110 + | otherwise = _roll16 chunk `W.or` set_hi l 111 !prod = r * (acc + n) 112 !nacc = reduce_partial (reduce_partial prod) 113 in loop nacc etc 114 -- 115 2.55.0 116