ppad-sha512 0.1.0 → 0.1.1
raw patch · 5 files changed
+180/−67 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/−0
- lib/Crypto/Hash/SHA512.hs +19/−6
- ppad-sha512.cabal +6/−2
- test/Main.hs +94/−59
- test/Wycheproof.hs +56/−0
CHANGELOG view
@@ -1,5 +1,10 @@ # Changelog +- 0.1.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.1.0 (2024-10-07) * Initial release.
lib/Crypto/Hash/SHA512.hs view
@@ -24,7 +24,6 @@ , hmac_lazy ) where - import qualified Data.Bits as B import Data.Bits ((.|.), (.&.)) import qualified Data.ByteString as BS@@ -421,6 +420,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 --@@ -495,6 +495,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-512. --@@ -509,11 +513,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 (128 - 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 > 128+ then KeyAndLen (hash mk) 64+ else KeyAndLen mk l -- | Produce a message authentication code for a lazy bytestring, based -- on the provided (strict, bytestring) key, via SHA-512.
ppad-sha512.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-sha512-version: 0.1.0+version: 0.1.1 synopsis: The SHA-512 and HMAC-SHA512 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-sha512 , tasty , tasty-hunit+ , text benchmark sha512-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.SHA512 as SHA512+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_sha512.json"+ case A.decodeStrictText wycheproof :: Maybe W.Wycheproof of+ Nothing -> error "couldn't parse wycheproof vectors"+ Just w -> defaultMain $ testGroup "ppad-sha512" [+ 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 (SHA512.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)++ -- , testGroup "hash_lazy (1GB input)" [+ -- testCase "hv5" $ do+ -- let out = B16.encode (SHA512.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 (SHA512.hmac hmv5_key hmv5_put)+ assertEqual mempty hmv5_pec out+ , testCase "hmv6" $ do+ let out = B16.encode (SHA512.hmac hmv6_key hmv6_put)+ assertEqual mempty hmv6_pec out+ , testCase "hmv7" $ do+ let out = B16.encode (SHA512.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 (SHA512.hmac_lazy hmv5_key lut)+ assertEqual mempty hmv5_pec out+ , testCase "hmv6" $ do+ let lut = BL.fromStrict hmv6_put+ out = B16.encode (SHA512.hmac_lazy hmv6_key lut)+ assertEqual mempty hmv6_pec out+ , testCase "hmv7" $ do+ let lut = BL.fromStrict hmv7_put+ out = B16.encode (SHA512.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 = "e37b6a775dc87dbaa4dfa9f96e5e3ffddebd71f8867289865df5a32d20cdc944b6022cac3c4982b10d5eeb55c3e4de15134676fb6de0446065c97440fa8c6a58"--unit_tests :: TestTree-unit_tests = testGroup "ppad-sha512" [- 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)-- -- , testGroup "hash_lazy (1GB input)" [- -- testCase "hv5" $ do- -- let out = B16.encode (SHA512.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 (SHA512.hmac hmv5_key hmv5_put)- assertEqual mempty hmv5_pec out- , testCase "hmv6" $ do- let out = B16.encode (SHA512.hmac hmv6_key hmv6_put)- assertEqual mempty hmv6_pec out- , testCase "hmv7" $ do- let out = B16.encode (SHA512.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 (SHA512.hmac_lazy hmv5_key lut)- assertEqual mempty hmv5_pec out- , testCase "hmv6" $ do- let lut = BL.fromStrict hmv6_put- out = B16.encode (SHA512.hmac_lazy hmv6_key lut)- assertEqual mempty hmv6_pec out- , testCase "hmv7" $ do- let lut = BL.fromStrict hmv7_put- out = B16.encode (SHA512.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"+