diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,11 +1,14 @@ # Changelog -- 0.2.0 (2024-10-07) +- 0.2.1 (2024-10-13) + * Adds an INLINE pragma to an internal step function. + * 'hmac' no longer calls 'hmac_lazy', which has no practical effect + other than to clean up profiling reports generated by GHC. +- 0.2.0 (2024-10-07) * 'hmac' and 'hmac_lazy' now hash long keys before computing a HMAC, instead of throwing an error, matching RFC 2104's suggested behaviour. - 0.1.0 (2024-09-14) - * Initial release, supporting SHA256 and HMAC-SHA256 on strict and lazy bytestrings. diff --git a/lib/Crypto/Hash/SHA256.hs b/lib/Crypto/Hash/SHA256.hs --- a/lib/Crypto/Hash/SHA256.hs +++ b/lib/Crypto/Hash/SHA256.hs @@ -346,6 +346,7 @@ let t1 = h + bsig1 e + ch e f g + k + w t2 = bsig0 a + maj a b c in Registers (t1 + t2) a b c (d + t1) e f g +{-# INLINE step #-} -- RFC 6234 6.2 block pipeline -- @@ -420,6 +421,10 @@ -- HMAC ----------------------------------------------------------------------- -- https://datatracker.ietf.org/doc/html/rfc2104#section-2 +data KeyAndLen = KeyAndLen + {-# UNPACK #-} !BS.ByteString + {-# UNPACK #-} !Int + -- | Produce a message authentication code for a strict bytestring, -- based on the provided (strict, bytestring) key, via SHA-256. -- @@ -434,11 +439,20 @@ :: BS.ByteString -- ^ key -> BS.ByteString -- ^ text -> BS.ByteString -hmac k = hmac_lazy k . BL.fromStrict - -data KeyAndLen = KeyAndLen - {-# UNPACK #-} !BS.ByteString - {-# UNPACK #-} !Int +hmac mk text = + let step1 = k <> BS.replicate (64 - lk) 0x00 + step2 = BS.map (B.xor 0x36) step1 + step3 = step2 <> text + step4 = hash step3 + step5 = BS.map (B.xor 0x5C) step1 + step6 = step5 <> step4 + in hash step6 + where + !(KeyAndLen k lk) = + let l = BS.length mk + in if l > 64 + then KeyAndLen (hash mk) 32 + else KeyAndLen mk l -- | Produce a message authentication code for a lazy bytestring, based -- on the provided (strict, bytestring) key, via SHA-256. diff --git a/ppad-sha256.cabal b/ppad-sha256.cabal --- a/ppad-sha256.cabal +++ b/ppad-sha256.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-sha256 -version: 0.2.0 +version: 0.2.1 synopsis: The SHA-256 and HMAC-SHA256 algorithms license: MIT license-file: LICENSE @@ -34,17 +34,21 @@ default-language: Haskell2010 hs-source-dirs: test main-is: Main.hs + other-modules: + Wycheproof ghc-options: -rtsopts -Wall -O2 build-depends: - base + aeson + , base , base16-bytestring , bytestring , ppad-sha256 , tasty , tasty-hunit + , text benchmark sha256-bench type: exitcode-stdio-1.0 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,19 +1,112 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} module Main where import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.Aeson as A import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as BSB import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Base16 as B16 +import qualified Data.Text.Encoding as TE +import qualified Data.Text.IO as TIO import Test.Tasty import Test.Tasty.HUnit +import qualified Wycheproof as W main :: IO () -main = defaultMain unit_tests +main = do + wycheproof <- TIO.readFile "etc/wycheproof_hmac_sha256.json" + case A.decodeStrictText wycheproof :: Maybe W.Wycheproof of + Nothing -> error "couldn't parse wycheproof vectors" + Just w -> defaultMain $ testGroup "ppad-sha256" [ + unit_tests + , wycheproof_tests w + ] +wycheproof_tests :: W.Wycheproof -> TestTree +wycheproof_tests W.Wycheproof {..} = testGroup "wycheproof vectors (hmac)" $ + fmap execute_group wp_testGroups + +execute_group :: W.MacTestGroup -> TestTree +execute_group W.MacTestGroup {..} = + testGroup msg (fmap (execute mtg_tagSize) mtg_tests) + where + msg = "keysize " <> show mtg_keySize <> ", tagsize " <> show mtg_tagSize + +execute :: Int -> W.MacTest -> TestTree +execute tag_size W.MacTest {..} = testCase t_msg $ do + let key = B16.decodeLenient (TE.encodeUtf8 mt_key) + msg = B16.decodeLenient (TE.encodeUtf8 mt_msg) + pec = B16.decodeLenient (TE.encodeUtf8 mt_tag) + out = BS.take bytes (SHA256.hmac key msg) + if mt_result == "invalid" + then assertBool "invalid" (pec /= out) + else assertEqual mempty pec out + where + t_msg = "test " <> show mt_tcId -- XX embellish + bytes = tag_size `div` 8 + +unit_tests :: TestTree +unit_tests = testGroup "unit tests" [ + testGroup "hash" [ + cmp_hash "hv0" hv0_put hv0_pec + , cmp_hash "hv1" hv1_put hv1_pec + , cmp_hash "hv2" hv2_put hv2_pec + , cmp_hash "hv3" hv3_put hv3_pec + , cmp_hash "hv4" hv4_put hv4_pec + ] + , testGroup "hash_lazy" [ + cmp_hash_lazy "hv0" hv0_put hv0_pec + , cmp_hash_lazy "hv1" hv1_put hv1_pec + , cmp_hash_lazy "hv2" hv2_put hv2_pec + , cmp_hash_lazy "hv3" hv3_put hv3_pec + , cmp_hash_lazy "hv4" hv4_put hv4_pec + ] + -- uncomment me to run (slow, ~30s) + -- + -- , testGroup "hash_lazy (1GB input)" [ + -- testCase "hv5" $ do + -- let out = B16.encode (SHA256.hash_lazy hv5_put) + -- assertEqual mempty hv5_pec out + -- ] + , testGroup "hmac" [ + cmp_hmac "hmv1" hmv1_key hmv1_put hmv1_pec + , cmp_hmac "hmv2" hmv2_key hmv2_put hmv2_pec + , 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) + assertEqual mempty hmv5_pec out + , testCase "hmv6" $ do + let out = B16.encode (SHA256.hmac hmv6_key hmv6_put) + assertEqual mempty hmv6_pec out + , testCase "hmv7" $ do + let out = B16.encode (SHA256.hmac hmv7_key hmv7_put) + assertEqual mempty hmv7_pec out + ] + , testGroup "hmac_lazy" [ + cmp_hmac_lazy "hmv1" hmv1_key hmv1_put hmv1_pec + , cmp_hmac_lazy "hmv2" hmv2_key hmv2_put hmv2_pec + , cmp_hmac_lazy "hmv3" hmv3_key hmv3_put hmv3_pec + , 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) + assertEqual mempty hmv5_pec out + , testCase "hmv6" $ do + let lut = BL.fromStrict hmv6_put + out = B16.encode (SHA256.hmac_lazy hmv6_key lut) + assertEqual mempty hmv6_pec out + , testCase "hmv7" $ do + let lut = BL.fromStrict hmv7_put + out = B16.encode (SHA256.hmac_lazy hmv7_key lut) + assertEqual mempty hmv7_pec out + ] + ] + -- vectors from -- https://www.di-mgt.com.au/sha_testvectors.html @@ -117,64 +210,6 @@ hmv7_pec :: BS.ByteString hmv7_pec = "9b09ffa71b942fcb27635fbcd5b0e944bfdc63644f0713938a7f51535c3a35e2" - -unit_tests :: TestTree -unit_tests = testGroup "ppad-sha256" [ - testGroup "hash" [ - cmp_hash "hv0" hv0_put hv0_pec - , cmp_hash "hv1" hv1_put hv1_pec - , cmp_hash "hv2" hv2_put hv2_pec - , cmp_hash "hv3" hv3_put hv3_pec - , cmp_hash "hv4" hv4_put hv4_pec - ] - , testGroup "hash_lazy" [ - cmp_hash_lazy "hv0" hv0_put hv0_pec - , cmp_hash_lazy "hv1" hv1_put hv1_pec - , cmp_hash_lazy "hv2" hv2_put hv2_pec - , cmp_hash_lazy "hv3" hv3_put hv3_pec - , cmp_hash_lazy "hv4" hv4_put hv4_pec - ] - -- uncomment me to run (slow, ~30s) - -- - -- , testGroup "hash_lazy (1GB input)" [ - -- testCase "hv5" $ do - -- let out = B16.encode (SHA256.hash_lazy hv5_put) - -- assertEqual mempty hv5_pec out - -- ] - , testGroup "hmac" [ - cmp_hmac "hmv1" hmv1_key hmv1_put hmv1_pec - , cmp_hmac "hmv2" hmv2_key hmv2_put hmv2_pec - , 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) - assertEqual mempty hmv5_pec out - , testCase "hmv6" $ do - let out = B16.encode (SHA256.hmac hmv6_key hmv6_put) - assertEqual mempty hmv6_pec out - , testCase "hmv7" $ do - let out = B16.encode (SHA256.hmac hmv7_key hmv7_put) - assertEqual mempty hmv7_pec out - ] - , testGroup "hmac_lazy" [ - cmp_hmac_lazy "hmv1" hmv1_key hmv1_put hmv1_pec - , cmp_hmac_lazy "hmv2" hmv2_key hmv2_put hmv2_pec - , cmp_hmac_lazy "hmv3" hmv3_key hmv3_put hmv3_pec - , 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) - assertEqual mempty hmv5_pec out - , testCase "hmv6" $ do - let lut = BL.fromStrict hmv6_put - out = B16.encode (SHA256.hmac_lazy hmv6_key lut) - assertEqual mempty hmv6_pec out - , testCase "hmv7" $ do - let lut = BL.fromStrict hmv7_put - out = B16.encode (SHA256.hmac_lazy hmv7_key lut) - assertEqual mempty hmv7_pec out - ] - ] cmp_hash :: String -> BS.ByteString -> BS.ByteString -> TestTree cmp_hash msg put pec = testCase msg $ do diff --git a/test/Wycheproof.hs b/test/Wycheproof.hs new file mode 100644 --- /dev/null +++ b/test/Wycheproof.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Wycheproof ( + Wycheproof(..) + , MacTestGroup(..) + , MacTest(..) + ) where + +import Data.Aeson ((.:)) +import qualified Data.Aeson as A +import qualified Data.Text as T + +data Wycheproof = Wycheproof { + wp_numberOfTests :: !Int + , wp_testGroups :: ![MacTestGroup] + } deriving Show + +instance A.FromJSON Wycheproof where + parseJSON = A.withObject "Wycheproof" $ \m -> Wycheproof + <$> m .: "numberOfTests" + <*> m .: "testGroups" + +data MacTestGroup = MacTestGroup { + mtg_keySize :: !Int + , mtg_tagSize :: !Int + , mtg_type :: !T.Text + , mtg_tests :: ![MacTest] + } deriving Show + +instance A.FromJSON MacTestGroup where + parseJSON = A.withObject "MacTestGroup" $ \m -> MacTestGroup + <$> m .: "keySize" + <*> m .: "tagSize" + <*> m .: "type" + <*> m .: "tests" + +data MacTest = MacTest { + mt_tcId :: !Int + , mt_comment :: !T.Text + , mt_key :: !T.Text + , mt_msg :: !T.Text + , mt_tag :: !T.Text + , mt_result :: !T.Text + , mt_flags :: ![T.Text] + } deriving Show + +instance A.FromJSON MacTest where + parseJSON = A.withObject "MacTest" $ \m -> MacTest + <$> m .: "tcId" + <*> m .: "comment" + <*> m .: "key" + <*> m .: "msg" + <*> m .: "tag" + <*> m .: "result" + <*> m .: "flags" +