commit 6f5292c1b951b470c72fae947ad315786e9a98b7
parent 67672cd83ac02ba23be4d32e9566d421b178d383
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Jan 2026 09:47:38 +0400
lib: add MAC wrapper
Diffstat:
7 files changed, 66 insertions(+), 20 deletions(-)
diff --git a/README.md b/README.md
@@ -19,6 +19,7 @@ A sample GHCi session:
> import qualified Crypto.Hash.SHA256 as SHA256
>
> -- 'hash' and 'hmac' operate on strict bytestrings
+ > -- 'hmac' returns a value of type 'MAC' with a constant-time Eq instance
>
> let hash_s = SHA256.hash "strict bytestring input"
> let hmac_s = SHA256.hmac "strict secret" "strict bytestring input"
@@ -27,9 +28,9 @@ A sample GHCi session:
> -- but note that the key for HMAC is always strict
>
> let hash_l = SHA256.hash_lazy "lazy bytestring input"
- > let hmac_l = SHA256.hmac_lazy "strict secret" "lazy bytestring input"
+ > let MAC hmac_l = SHA256.hmac_lazy "strict secret" "lazy bytestring input"
>
- > -- results are always unformatted 256-bit (32-byte) strict bytestrings
+ > -- digests are always unformatted 256-bit (32-byte) strict bytestrings
>
> import qualified Data.ByteString as BS
>
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -14,7 +14,7 @@ main = defaultMain [
]
suite :: Benchmark
-suite = env setup $ \ ~(bs, bl) ->
+suite = env setup $ \ ~(bs, bl, mac0, mac1, macl0, macl1) ->
bgroup "ppad-sha256" [
bgroup "SHA256 (32B input)" [
bench "hash" $ whnf SHA256.hash bs
@@ -26,10 +26,18 @@ suite = env setup $ \ ~(bs, bl) ->
, bench "hmac_lazy" $ whnf (SHA256.hmac_lazy "key") bl
, bench "SHA.hmacSha256" $ whnf (SHA.hmacSha256 "key") bl
]
+ , bgroup "MAC comparison" [
+ bench "hmac" $ nf (mac0 ==) mac1
+ , bench "hmac_lazy" $ nf (macl0 ==) macl1
+ ]
]
where
setup = do
let bs_32B = BS.replicate 32 0
bl_32B = BL.fromStrict bs_32B
- pure (bs_32B, bl_32B)
+ mac0 = SHA256.hmac "key" "foo"
+ mac1 = SHA256.hmac "key" "bar"
+ macl0 = SHA256.hmac_lazy "key" "foo"
+ macl1 = SHA256.hmac_lazy "key" "bar"
+ pure (bs_32B, bl_32B, mac0, mac1, macl0, macl1)
diff --git a/lib/Crypto/Hash/SHA256.hs b/lib/Crypto/Hash/SHA256.hs
@@ -26,6 +26,7 @@ module Crypto.Hash.SHA256 (
, Lazy.hash_lazy
-- * SHA256-based MAC functions
+ , MAC(..)
, hmac
, Lazy.hmac_lazy
) where
@@ -97,15 +98,15 @@ data KeyAndLen = KeyAndLen
hmac
:: BS.ByteString -- ^ key
-> BS.ByteString -- ^ text
- -> BS.ByteString
+ -> MAC
hmac mk@(BI.PS _ _ l) text
| sha256_arm_available =
let !inner = hash_arm_with ipad 64 text
- in hash_arm (opad <> inner)
+ in MAC (hash_arm (opad <> inner))
| otherwise =
let !ipad_state = block_hash (iv ()) (parse_block ipad 0)
!inner = cat (process_with ipad_state 64 text)
- in hash (opad <> inner)
+ in MAC (hash (opad <> inner))
where
!step1 = k <> BS.replicate (64 - lk) 0x00
!ipad = BS.map (B.xor 0x36) step1
diff --git a/lib/Crypto/Hash/SHA256/Internal.hs b/lib/Crypto/Hash/SHA256/Internal.hs
@@ -1,5 +1,7 @@
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE UnboxedTuples #-}
@@ -19,6 +21,8 @@ module Crypto.Hash.SHA256.Internal (
, Registers(..)
, pattern R
+ , MAC(..)
+
, iv
, block_hash
, cat
@@ -29,6 +33,7 @@ module Crypto.Hash.SHA256.Internal (
, unsafe_padding
) where
+import Control.DeepSeq (NFData(..))
import qualified Data.Bits as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BI
@@ -41,7 +46,29 @@ import GHC.Exts (Int#)
import qualified GHC.Exts as Exts
import qualified GHC.Word (Word8(..))
--- SHA-256 internals (unboxed types for performance)
+-- | A message authentication code.
+--
+-- Note that you should compare MACs for equality using the 'Eq'
+-- instance, which performs the comparison in constant time, instead
+-- of unwrapping and comparing the underlying 'ByteStrings'.
+--
+-- >>> let foo@(MAC bs0) = hmac key "hi"
+-- >>> let bar@(MAC bs1) = hmac key "there"
+-- >>> foo == bar -- do this
+-- False
+-- >>> bs0 == bs1 -- don't do this
+-- False
+newtype MAC = MAC BS.ByteString
+ deriving newtype (Show, NFData)
+
+instance Eq MAC where
+ -- | A constant-time equality check for message authentication codes.
+ --
+ -- Runs in variable-time only for invalid inputs.
+ (MAC a@(BI.PS _ _ la)) == (MAC b@(BI.PS _ _ lb))
+ | la /= lb = False
+ | otherwise = BS.foldl' (B..|.) 0 (BS.packZipWith B.xor a b) == 0
+
-- https://datatracker.ietf.org/doc/html/rfc6234
newtype Block = Block
diff --git a/lib/Crypto/Hash/SHA256/Lazy.hs b/lib/Crypto/Hash/SHA256/Lazy.hs
@@ -136,7 +136,7 @@ data KeyAndLen = KeyAndLen
hmac_lazy
:: BS.ByteString -- ^ key
-> BL.ByteString -- ^ text
- -> BS.ByteString
+ -> MAC
hmac_lazy mk@(BI.PS _ _ l) text =
let step1 = k <> BS.replicate (64 - lk) 0x00
step2 = BS.map (B.xor 0x36) step1
@@ -144,7 +144,7 @@ hmac_lazy mk@(BI.PS _ _ l) text =
step4 = hash_lazy step3
step5 = BS.map (B.xor 0x5C) step1
step6 = step5 <> step4
- in hash step6
+ in MAC (hash step6)
where
hash bs = cat (go (iv ()) (pad bs)) where
go :: Registers -> BS.ByteString -> Registers
diff --git a/ppad-sha256.cabal b/ppad-sha256.cabal
@@ -38,6 +38,7 @@ library
build-depends:
base >= 4.9 && < 5
, bytestring >= 0.9 && < 0.13
+ , deepseq >= 1.4 && < 1.6
c-sources:
cbits/sha256_arm.c
if arch(aarch64)
@@ -94,7 +95,6 @@ benchmark sha256-weigh
build-depends:
base
, bytestring
- , deepseq
, ppad-sha256
, weigh
diff --git a/test/Main.hs b/test/Main.hs
@@ -46,7 +46,8 @@ execute tag_size W.MacTest {..} = testCase t_msg $ do
let key = decodeLenient (TE.encodeUtf8 mt_key)
msg = decodeLenient (TE.encodeUtf8 mt_msg)
pec = decodeLenient (TE.encodeUtf8 mt_tag)
- out = BS.take bytes (SHA256.hmac key msg)
+ SHA256.MAC mac = SHA256.hmac key msg
+ out = BS.take bytes mac
if mt_result == "invalid"
then assertBool "invalid" (pec /= out)
else assertEqual mempty pec out
@@ -83,13 +84,16 @@ unit_tests = testGroup "unit tests" [
, cmp_hmac "hmv3" hmv3_key hmv3_put hmv3_pec
, cmp_hmac "hmv4" hmv4_key hmv4_put hmv4_pec
, testCase "hmv5" $ do
- let out = BS.take 32 $ B16.encode (SHA256.hmac hmv5_key hmv5_put)
+ let SHA256.MAC mac = SHA256.hmac hmv5_key hmv5_put
+ out = BS.take 32 $ B16.encode mac
assertEqual mempty hmv5_pec out
, testCase "hmv6" $ do
- let out = B16.encode (SHA256.hmac hmv6_key hmv6_put)
+ let SHA256.MAC mac = SHA256.hmac hmv6_key hmv6_put
+ out = B16.encode mac
assertEqual mempty hmv6_pec out
, testCase "hmv7" $ do
- let out = B16.encode (SHA256.hmac hmv7_key hmv7_put)
+ let SHA256.MAC mac = SHA256.hmac hmv7_key hmv7_put
+ out = B16.encode mac
assertEqual mempty hmv7_pec out
]
, testGroup "hmac_lazy" [
@@ -99,15 +103,18 @@ unit_tests = testGroup "unit tests" [
, cmp_hmac_lazy "hmv4" hmv4_key hmv4_put hmv4_pec
, testCase "hmv5" $ do
let lut = BL.fromStrict hmv5_put
- out = BS.take 32 $ B16.encode (SHA256.hmac_lazy hmv5_key lut)
+ SHA256.MAC mac = SHA256.hmac_lazy hmv5_key lut
+ out = BS.take 32 $ B16.encode mac
assertEqual mempty hmv5_pec out
, testCase "hmv6" $ do
let lut = BL.fromStrict hmv6_put
- out = B16.encode (SHA256.hmac_lazy hmv6_key lut)
+ SHA256.MAC mac = SHA256.hmac_lazy hmv6_key lut
+ out = B16.encode mac
assertEqual mempty hmv6_pec out
, testCase "hmv7" $ do
let lut = BL.fromStrict hmv7_put
- out = B16.encode (SHA256.hmac_lazy hmv7_key lut)
+ SHA256.MAC mac = SHA256.hmac_lazy hmv7_key lut
+ out = B16.encode mac
assertEqual mempty hmv7_pec out
]
]
@@ -229,12 +236,14 @@ cmp_hash_lazy msg (BL.fromStrict -> put) pec = testCase msg $ do
cmp_hmac
:: String -> BS.ByteString -> BS.ByteString -> BS.ByteString -> TestTree
cmp_hmac msg key put pec = testCase msg $ do
- let out = B16.encode (SHA256.hmac key put)
+ let SHA256.MAC mac = SHA256.hmac key put
+ out = B16.encode mac
assertEqual mempty pec out
cmp_hmac_lazy
:: String -> BS.ByteString -> BS.ByteString -> BS.ByteString -> TestTree
cmp_hmac_lazy msg key (BL.fromStrict -> put) pec = testCase msg $ do
- let out = B16.encode (SHA256.hmac_lazy key put)
+ let SHA256.MAC mac = SHA256.hmac_lazy key put
+ out = B16.encode mac
assertEqual mempty pec out
