diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,10 @@ # Changelog +- 0.2.0 (2026-01-10) + * The HMAC functions now produce a value of type MAC, which is a + newtype over a ByteString. The 'Eq' instance for MAC compares values + in constant time. + - 0.1.5 (2026-01-08) * We now check if the ARM cryptographic extensions are available, and, if so, use them to calculate hashes. If they're unavailable we diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} module Main where @@ -14,22 +15,31 @@ ] 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 - ] - , 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 +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 + ] ] - ] - where - setup = do - let bs_32B = BS.replicate 32 0 - bl_32B = BL.fromStrict bs_32B - pure (bs_32B, bl_32B) diff --git a/bench/Weight.hs b/bench/Weight.hs --- a/bench/Weight.hs +++ b/bench/Weight.hs @@ -1,13 +1,18 @@ {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns -fno-warn-type-defaults #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} module Main where +import Control.DeepSeq import qualified Crypto.Hash.SHA512 as SHA512 import qualified Data.ByteString as BS import Weigh +instance NFData SHA512.MAC where + rnf (SHA512.MAC b) = rnf b + -- note that 'weigh' doesn't work properly in a repl main :: IO () main = mainWith $ do @@ -21,10 +26,10 @@ !bs2 = BS.replicate 128 0 !bs3 = BS.replicate 12288 0 in wgroup "hash" $ do - func' "hash (32B input)" SHA512.hash bs0 - func' "hash (64B input)" SHA512.hash bs1 - func' "hash (128B input)" SHA512.hash bs2 - func' "hash (12288B input)" SHA512.hash bs3 + func "hash (32B input)" SHA512.hash bs0 + func "hash (64B input)" SHA512.hash bs1 + func "hash (128B input)" SHA512.hash bs2 + func "hash (12288B input)" SHA512.hash bs3 hmac :: Weigh () hmac = @@ -34,8 +39,8 @@ !bs2 = BS.replicate 128 0 !bs3 = BS.replicate 12288 0 in wgroup "hmac" $ do - func' "hmac (32B input)" (SHA512.hmac key) bs0 - func' "hmac (64B input)" (SHA512.hmac key) bs1 - func' "hmac (128B input)" (SHA512.hmac key) bs2 - func' "hmac (12288B input)" (SHA512.hmac key) bs3 + func "hmac (32B input)" (SHA512.hmac key) bs0 + func "hmac (64B input)" (SHA512.hmac key) bs1 + func "hmac (128B input)" (SHA512.hmac key) bs2 + func "hmac (12288B input)" (SHA512.hmac key) bs3 diff --git a/lib/Crypto/Hash/SHA512.hs b/lib/Crypto/Hash/SHA512.hs --- a/lib/Crypto/Hash/SHA512.hs +++ b/lib/Crypto/Hash/SHA512.hs @@ -22,6 +22,7 @@ , Lazy.hash_lazy -- * SHA512-based MAC functions + , MAC(..) , hmac , Lazy.hmac_lazy ) where @@ -94,15 +95,15 @@ 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 --- 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 @@ , Block(..) , Schedule(..) + , MAC(..) + , iv , block_hash , prepare_schedule @@ -41,6 +45,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 --------------------------------------------------------- diff --git a/lib/Crypto/Hash/SHA512/Lazy.hs b/lib/Crypto/Hash/SHA512/Lazy.hs --- a/lib/Crypto/Hash/SHA512/Lazy.hs +++ b/lib/Crypto/Hash/SHA512/Lazy.hs @@ -21,6 +21,7 @@ , 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.Internal as BLI import Data.Word (Word64) import Foreign.ForeignPtr (plusForeignPtr) -import Crypto.Hash.SHA512.Internal -- preliminary utils @@ -136,7 +136,7 @@ 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 @@ 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-sha512.cabal b/ppad-sha512.cabal --- a/ppad-sha512.cabal +++ b/ppad-sha512.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-sha512 -version: 0.1.5 +version: 0.2.0 synopsis: The SHA-512 and HMAC-SHA512 algorithms license: MIT license-file: LICENSE diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -46,7 +46,8 @@ 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 @@ , 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 @@ , 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_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