commit b632003b6905979aacdd34cf507643ca2b531f01
parent 428e2e09c345a0cb255d9aab432606308872c014
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Jan 2026 15:41:19 +0400
lib: add MAC type
Diffstat:
5 files changed, 81 insertions(+), 32 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
@@ -14,22 +15,31 @@ main = defaultMain [
]
suite :: Benchmark
-suite = env setup $ \ ~(bs, bl) ->
- bgroup "ppad-sha512" [
- bgroup "SHA512 (32B input)" [
- bench "hash" $ whnf SHA512.hash bs
- , bench "hash_lazy" $ whnf SHA512.hash_lazy bl
- , bench "SHA.sha512" $ whnf SHA.sha512 bl
+suite =
+ let !bs = BS.replicate 32 0
+ !bl = BL.fromStrict bs
+ !mac0 = SHA512.hmac "key" "foo"
+ !mac1 = SHA512.hmac "key" "bar"
+ !mac2 = SHA512.hmac "key" "foo"
+ !macl0 = SHA512.hmac_lazy "key" "foo"
+ !macl1 = SHA512.hmac_lazy "key" "bar"
+ !macl2 = SHA512.hmac_lazy "key" "foo"
+ in bgroup "ppad-sha512" [
+ bgroup "SHA512 (32B input)" [
+ bench "hash" $ whnf SHA512.hash bs
+ , bench "hash_lazy" $ whnf SHA512.hash_lazy bl
+ , bench "SHA.sha512" $ whnf SHA.sha512 bl
+ ]
+ , bgroup "HMAC-SHA512 (32B input)" [
+ bench "hmac" $ whnf (SHA512.hmac "key") bs
+ , bench "hmac_lazy" $ whnf (SHA512.hmac_lazy "key") bl
+ , bench "SHA.hmacSha512" $ whnf (SHA.hmacSha512 "key") bl
+ ]
+ , bgroup "MAC comparison" [
+ bench "hmac, unequal" $ whnf (mac0 ==) mac1
+ , bench "hmac, equal" $ whnf (mac0 ==) mac2
+ , bench "hmac_lazy, unequal" $ whnf (macl0 ==) macl1
+ , bench "hmac_lazy, equal" $ whnf (macl0 ==) macl2
+ ]
]
- , bgroup "HMAC-SHA512 (32B input)" [
- bench "hmac" $ whnf (SHA512.hmac "key") bs
- , bench "hmac_lazy" $ whnf (SHA512.hmac_lazy "key") bl
- , bench "SHA.hmacSha512" $ whnf (SHA.hmacSha512 "key") bl
- ]
- ]
- where
- setup = do
- let bs_32B = BS.replicate 32 0
- bl_32B = BL.fromStrict bs_32B
- pure (bs_32B, bl_32B)
diff --git a/lib/Crypto/Hash/SHA512.hs b/lib/Crypto/Hash/SHA512.hs
@@ -22,6 +22,7 @@ module Crypto.Hash.SHA512 (
, Lazy.hash_lazy
-- * SHA512-based MAC functions
+ , MAC(..)
, hmac
, Lazy.hmac_lazy
) where
@@ -94,15 +95,15 @@ data KeyAndLen = KeyAndLen
hmac
:: BS.ByteString -- ^ key
-> BS.ByteString -- ^ text
- -> BS.ByteString
+ -> MAC
hmac mk@(BI.PS _ _ l) text
| sha512_arm_available =
let !inner = hash_arm_with ipad 128 text
- in hash_arm (opad <> inner)
+ in MAC (hash_arm (opad <> inner))
| otherwise =
let !ipad_state = block_hash iv (prepare_schedule (parse_block ipad 0))
!inner = cat (process_with ipad_state 128 text)
- in hash (opad <> inner)
+ in MAC (hash (opad <> inner))
where
!step1 = k <> BS.replicate (128 - lk) 0x00
!ipad = BS.map (B.xor 0x36) step1
diff --git a/lib/Crypto/Hash/SHA512/Internal.hs b/lib/Crypto/Hash/SHA512/Internal.hs
@@ -1,5 +1,7 @@
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}
-- |
@@ -15,6 +17,8 @@ module Crypto.Hash.SHA512.Internal (
, Block(..)
, Schedule(..)
+ , MAC(..)
+
, iv
, block_hash
, prepare_schedule
@@ -42,6 +46,31 @@ import Foreign.Marshal.Utils (copyBytes, fillBytes)
import Foreign.Ptr (Ptr, plusPtr)
import Foreign.Storable (poke)
+-- MAC type ------------------------------------------------------------------
+
+-- | 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
+
+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
+
-- preliminary utils ---------------------------------------------------------
fi :: (Integral a, Num b) => a -> b
diff --git a/lib/Crypto/Hash/SHA512/Lazy.hs b/lib/Crypto/Hash/SHA512/Lazy.hs
@@ -21,6 +21,7 @@ module Crypto.Hash.SHA512.Lazy (
, hmac_lazy
) where
+import Crypto.Hash.SHA512.Internal
import qualified Data.Bits as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BSB
@@ -30,7 +31,6 @@ import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Internal as BLI
import Data.Word (Word64)
import Foreign.ForeignPtr (plusForeignPtr)
-import Crypto.Hash.SHA512.Internal
-- preliminary utils
@@ -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 (128 - 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/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 (SHA512.hmac key msg)
+ SHA512.MAC mac = SHA512.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 (SHA512.hmac hmv5_key hmv5_put)
+ let SHA512.MAC mac = SHA512.hmac hmv5_key hmv5_put
+ out = BS.take 32 $ B16.encode mac
assertEqual mempty hmv5_pec out
, testCase "hmv6" $ do
- let out = B16.encode (SHA512.hmac hmv6_key hmv6_put)
+ let SHA512.MAC mac = SHA512.hmac hmv6_key hmv6_put
+ out = B16.encode mac
assertEqual mempty hmv6_pec out
, testCase "hmv7" $ do
- let out = B16.encode (SHA512.hmac hmv7_key hmv7_put)
+ let SHA512.MAC mac = SHA512.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 (SHA512.hmac_lazy hmv5_key lut)
+ SHA512.MAC mac = SHA512.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 (SHA512.hmac_lazy hmv6_key lut)
+ SHA512.MAC mac = SHA512.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 (SHA512.hmac_lazy hmv7_key lut)
+ SHA512.MAC mac = SHA512.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 (SHA512.hmac key put)
+ let SHA512.MAC mac = SHA512.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 (SHA512.hmac_lazy key put)
+ let SHA512.MAC mac = SHA512.hmac_lazy key put
+ out = B16.encode mac
assertEqual mempty pec out
