ppad-sha256 0.2.0 → 0.2.1
raw patch · 5 files changed
+180/−68 lines, 5 filesdep +aesondep +textPVP ok
version bump matches the API change (PVP)
Dependencies added: aeson, text
API changes (from Hackage documentation)
Files
- CHANGELOG +5/−2
- lib/Crypto/Hash/SHA256.hs +19/−5
- ppad-sha256.cabal +6/−2
- test/Main.hs +94/−59
- test/Wycheproof.hs +56/−0
CHANGELOG view
@@ -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.
lib/Crypto/Hash/SHA256.hs view
@@ -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.
ppad-sha256.cabal view
@@ -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
test/Main.hs view
@@ -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
+ test/Wycheproof.hs view
@@ -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"+