commit c72d66cb11817cc50ae0520207bec80c5a518c2d
parent 5c5a4fdb1870422c35cd56df19e6672a7b782264
Author: Jared Tobin <jared@jtobin.io>
Date: Mon, 6 Jul 2026 13:08:15 -0230
Revert "lib: unroll the constant-time MAC comparison"
This reverts commit 5ee9ea2.
Under the LLVM backend the unrolled OR-tree over four 64-bit lanes
compiles to a lane-by-lane short-circuit: LLVM lowers
(d0 .|. d1 .|. ...) == 0 into a cascade of per-lane comparisons
with early-exit branches, reintroducing a data-dependent early
termination that leaks which lane first differs. The byte-serial
fold restored here is a fixed-trip loop that is constant-time in
the tag bytes under both the NCG and LLVM backends (verified
against the compiled assembly).
Diffstat:
1 file changed, 6 insertions(+), 58 deletions(-)
diff --git a/lib/Crypto/Hash/SHA256/Internal.hs b/lib/Crypto/Hash/SHA256/Internal.hs
@@ -83,30 +83,13 @@ instance Eq MAC where
--
-- Runs in variable-time only for invalid inputs.
(MAC a@(BI.PS _ _ la)) == (MAC b@(BI.PS _ _ lb))
- | la /= lb = False
- | la == 32 =
- -- fully-unrolled, fixed OR-tree over four 64-bit lanes.
- -- A standard 32-byte MAC folds through no loop-carried
- -- accumulator, so there is no per-byte accumulator whose
- -- nonzero span tracks the position of a differing byte:
- -- the comparison time is independent of where (or whether)
- -- the tags differ.
- let !d0 = Exts.xor64# (word64le a 00) (word64le b 00)
- !d1 = Exts.xor64# (word64le a 08) (word64le b 08)
- !d2 = Exts.xor64# (word64le a 16) (word64le b 16)
- !d3 = Exts.xor64# (word64le a 24) (word64le b 24)
- !d = (d0 `Exts.or64#` d1) `Exts.or64#`
- (d2 `Exts.or64#` d3)
- in Exts.isTrue# (Exts.eqWord64# d (Exts.wordToWord64# 0##))
- | otherwise = go 0 0
+ | la /= lb = False
+ | otherwise = go 0 0
where
- -- byte-serial fallback for nonstandard MAC lengths. 'hmac'
- -- always yields 32 bytes, so this path is unreachable through
- -- it; it exists only to keep the instance total for MACs built
- -- directly via the exported constructor. The fused fold ORs the
- -- bytewise XORs into an accumulator directly, rather than via
- -- packZipWith, so no intermediate ByteString holding the
- -- (secret-derived) difference bytes is ever materialised.
+ -- fused fold: OR the bytewise XORs into an accumulator
+ -- directly, rather than via packZipWith, so no intermediate
+ -- ByteString holding the (secret-derived) difference bytes
+ -- is ever materialised on the heap.
go :: Word8 -> Int -> Bool
go !acc !i
| i == la = acc == 0
@@ -202,41 +185,6 @@ word32be bs m =
in sa `Exts.orWord32#` sb `Exts.orWord32#` sc `Exts.orWord32#` d
{-# INLINE word32be #-}
--- | Assemble the 64-bit word at the given byte offset, little-endian.
---
--- Byte order is immaterial to an equality test as long as both
--- operands are assembled the same way; this is used only by the
--- constant-time 'MAC' comparison. The length is not checked.
-word64le :: BS.ByteString -> Int -> Exts.Word64#
-word64le bs m =
- let !(GHC.Word.W8# r0) = BU.unsafeIndex bs m
- !(GHC.Word.W8# r1) = BU.unsafeIndex bs (m + 1)
- !(GHC.Word.W8# r2) = BU.unsafeIndex bs (m + 2)
- !(GHC.Word.W8# r3) = BU.unsafeIndex bs (m + 3)
- !(GHC.Word.W8# r4) = BU.unsafeIndex bs (m + 4)
- !(GHC.Word.W8# r5) = BU.unsafeIndex bs (m + 5)
- !(GHC.Word.W8# r6) = BU.unsafeIndex bs (m + 6)
- !(GHC.Word.W8# r7) = BU.unsafeIndex bs (m + 7)
- !w0 = Exts.word8ToWord# r0
- !w1 = Exts.word8ToWord# r1
- !w2 = Exts.word8ToWord# r2
- !w3 = Exts.word8ToWord# r3
- !w4 = Exts.word8ToWord# r4
- !w5 = Exts.word8ToWord# r5
- !w6 = Exts.word8ToWord# r6
- !w7 = Exts.word8ToWord# r7
- !s1 = Exts.uncheckedShiftL# w1 8#
- !s2 = Exts.uncheckedShiftL# w2 16#
- !s3 = Exts.uncheckedShiftL# w3 24#
- !s4 = Exts.uncheckedShiftL# w4 32#
- !s5 = Exts.uncheckedShiftL# w5 40#
- !s6 = Exts.uncheckedShiftL# w6 48#
- !s7 = Exts.uncheckedShiftL# w7 56#
- in Exts.wordToWord64#
- (w0 `Exts.or#` s1 `Exts.or#` s2 `Exts.or#` s3 `Exts.or#`
- s4 `Exts.or#` s5 `Exts.or#` s6 `Exts.or#` s7)
-{-# INLINE word64le #-}
-
-- parsing (final input) ------------------------------------------------------
-- | Parse the final chunk of an input message, assuming it is less than
