Main.hs (9188B)
1 {-# LANGUAGE OverloadedStrings #-} 2 {-# LANGUAGE RecordWildCards #-} 3 {-# LANGUAGE ViewPatterns #-} 4 5 module Main where 6 7 import qualified Crypto.Hash.SHA512 as SHA512 8 import qualified Data.Aeson as A 9 import qualified Data.ByteString as BS 10 import qualified Data.ByteString.Builder as BSB 11 import qualified Data.ByteString.Lazy as BL 12 import qualified Data.ByteString.Base16 as B16 13 import qualified Data.Text.Encoding as TE 14 import qualified Data.Text.IO as TIO 15 import Test.Tasty 16 import Test.Tasty.HUnit 17 import qualified Wycheproof as W 18 19 main :: IO () 20 main = do 21 wycheproof <- TIO.readFile "etc/wycheproof_hmac_sha512.json" 22 case A.decodeStrictText wycheproof :: Maybe W.Wycheproof of 23 Nothing -> error "couldn't parse wycheproof vectors" 24 Just w -> defaultMain $ testGroup "ppad-sha512" [ 25 unit_tests 26 , wycheproof_tests w 27 ] 28 29 wycheproof_tests :: W.Wycheproof -> TestTree 30 wycheproof_tests W.Wycheproof {..} = testGroup "wycheproof vectors (hmac)" $ 31 fmap execute_group wp_testGroups 32 33 execute_group :: W.MacTestGroup -> TestTree 34 execute_group W.MacTestGroup {..} = 35 testGroup msg (fmap (execute mtg_tagSize) mtg_tests) 36 where 37 msg = "keysize " <> show mtg_keySize <> ", tagsize " <> show mtg_tagSize 38 39 execute :: Int -> W.MacTest -> TestTree 40 execute tag_size W.MacTest {..} = testCase t_msg $ do 41 let key = B16.decodeLenient (TE.encodeUtf8 mt_key) 42 msg = B16.decodeLenient (TE.encodeUtf8 mt_msg) 43 pec = B16.decodeLenient (TE.encodeUtf8 mt_tag) 44 out = BS.take bytes (SHA512.hmac key msg) 45 if mt_result == "invalid" 46 then assertBool "invalid" (pec /= out) 47 else assertEqual mempty pec out 48 where 49 t_msg = "test " <> show mt_tcId -- XX embellish 50 bytes = tag_size `div` 8 51 52 unit_tests :: TestTree 53 unit_tests = testGroup "unit tests" [ 54 testGroup "hash" [ 55 cmp_hash "hv0" hv0_put hv0_pec 56 , cmp_hash "hv1" hv1_put hv1_pec 57 , cmp_hash "hv2" hv2_put hv2_pec 58 , cmp_hash "hv3" hv3_put hv3_pec 59 , cmp_hash "hv4" hv4_put hv4_pec 60 ] 61 , testGroup "hash_lazy" [ 62 cmp_hash_lazy "hv0" hv0_put hv0_pec 63 , cmp_hash_lazy "hv1" hv1_put hv1_pec 64 , cmp_hash_lazy "hv2" hv2_put hv2_pec 65 , cmp_hash_lazy "hv3" hv3_put hv3_pec 66 , cmp_hash_lazy "hv4" hv4_put hv4_pec 67 ] 68 -- uncomment me to run (slow) 69 70 -- , testGroup "hash_lazy (1GB input)" [ 71 -- testCase "hv5" $ do 72 -- let out = B16.encode (SHA512.hash_lazy hv5_put) 73 -- assertEqual mempty hv5_pec out 74 -- ] 75 , testGroup "hmac" [ 76 cmp_hmac "hmv1" hmv1_key hmv1_put hmv1_pec 77 , cmp_hmac "hmv2" hmv2_key hmv2_put hmv2_pec 78 , cmp_hmac "hmv3" hmv3_key hmv3_put hmv3_pec 79 , cmp_hmac "hmv4" hmv4_key hmv4_put hmv4_pec 80 , testCase "hmv5" $ do 81 let out = BS.take 32 $ B16.encode (SHA512.hmac hmv5_key hmv5_put) 82 assertEqual mempty hmv5_pec out 83 , testCase "hmv6" $ do 84 let out = B16.encode (SHA512.hmac hmv6_key hmv6_put) 85 assertEqual mempty hmv6_pec out 86 , testCase "hmv7" $ do 87 let out = B16.encode (SHA512.hmac hmv7_key hmv7_put) 88 assertEqual mempty hmv7_pec out 89 ] 90 , testGroup "hmac_lazy" [ 91 cmp_hmac_lazy "hmv1" hmv1_key hmv1_put hmv1_pec 92 , cmp_hmac_lazy "hmv2" hmv2_key hmv2_put hmv2_pec 93 , cmp_hmac_lazy "hmv3" hmv3_key hmv3_put hmv3_pec 94 , cmp_hmac_lazy "hmv4" hmv4_key hmv4_put hmv4_pec 95 , testCase "hmv5" $ do 96 let lut = BL.fromStrict hmv5_put 97 out = BS.take 32 $ B16.encode (SHA512.hmac_lazy hmv5_key lut) 98 assertEqual mempty hmv5_pec out 99 , testCase "hmv6" $ do 100 let lut = BL.fromStrict hmv6_put 101 out = B16.encode (SHA512.hmac_lazy hmv6_key lut) 102 assertEqual mempty hmv6_pec out 103 , testCase "hmv7" $ do 104 let lut = BL.fromStrict hmv7_put 105 out = B16.encode (SHA512.hmac_lazy hmv7_key lut) 106 assertEqual mempty hmv7_pec out 107 ] 108 ] 109 110 -- vectors from 111 -- https://www.di-mgt.com.au/sha_testvectors.html 112 113 hv0_put, hv0_pec :: BS.ByteString 114 hv0_put = "abc" 115 hv0_pec = "ddaf35a193617abacc417349ae20413112e6fa4e89a97ea20a9eeee64b55d39a2192992a274fc1a836ba3c23a3feebbd454d4423643ce80e2a9ac94fa54ca49f" 116 117 hv1_put, hv1_pec :: BS.ByteString 118 hv1_put = mempty 119 hv1_pec = "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e" 120 121 hv2_put, hv2_pec :: BS.ByteString 122 hv2_put = "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" 123 hv2_pec = "204a8fc6dda82f0a0ced7beb8e08a41657c16ef468b228a8279be331a703c33596fd15c13b1b07f9aa1d3bea57789ca031ad85c7a71dd70354ec631238ca3445" 124 125 hv3_put, hv3_pec :: BS.ByteString 126 hv3_put = "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" 127 hv3_pec = "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909" 128 129 hv4_put, hv4_pec :: BS.ByteString 130 hv4_put = BS.replicate 1000000 0x61 131 hv4_pec = "e718483d0ce769644e2e42c7bc15b4638e1f98b13b2044285632a803afa973ebde0ff244877ea60a4cb0432ce577c31beb009c5c2c49aa2e4eadb217ad8cc09b" 132 133 big_input :: BL.ByteString 134 big_input = go (16777216 :: Int) mempty where 135 go j acc 136 | j == 0 = BSB.toLazyByteString acc 137 | otherwise = 138 let nacc = acc <> BSB.lazyByteString 139 "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmno" 140 in go (pred j) nacc 141 142 hv5_put :: BL.ByteString 143 hv5_put = big_input 144 145 hv5_pec :: BS.ByteString 146 hv5_pec = "b47c933421ea2db149ad6e10fce6c7f93d0752380180ffd7f4629a712134831d77be6091b819ed352c2967a2e2d4fa5050723c9630691f1a05a7281dbe6c1086" 147 148 -- vectors from 149 -- https://datatracker.ietf.org/doc/html/rfc4231#section-4.1 150 151 hmv1_key :: BS.ByteString 152 hmv1_key = B16.decodeLenient "0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b" 153 154 hmv1_put :: BS.ByteString 155 hmv1_put = "Hi There" 156 157 hmv1_pec :: BS.ByteString 158 hmv1_pec = "87aa7cdea5ef619d4ff0b4241a1d6cb02379f4e2ce4ec2787ad0b30545e17cdedaa833b7d6b8a702038b274eaea3f4e4be9d914eeb61f1702e696c203a126854" 159 160 hmv2_key :: BS.ByteString 161 hmv2_key = "Jefe" 162 163 hmv2_put :: BS.ByteString 164 hmv2_put = "what do ya want for nothing?" 165 166 hmv2_pec :: BS.ByteString 167 hmv2_pec = "164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea2505549758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737" 168 169 hmv3_key :: BS.ByteString 170 hmv3_key = B16.decodeLenient "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" 171 172 hmv3_put :: BS.ByteString 173 hmv3_put = B16.decodeLenient "dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd" 174 175 hmv3_pec :: BS.ByteString 176 hmv3_pec = "fa73b0089d56a284efb0f0756c890be9b1b5dbdd8ee81a3655f83e33b2279d39bf3e848279a722c806b485a47e67c807b946a337bee8942674278859e13292fb" 177 178 hmv4_key :: BS.ByteString 179 hmv4_key = B16.decodeLenient "0102030405060708090a0b0c0d0e0f10111213141516171819" 180 181 hmv4_put :: BS.ByteString 182 hmv4_put = B16.decodeLenient "cdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcd" 183 184 hmv4_pec :: BS.ByteString 185 hmv4_pec = "b0ba465637458c6990e5a8c5f61d4af7e576d97ff94b872de76f8050361ee3dba91ca5c11aa25eb4d679275cc5788063a5f19741120c4f2de2adebeb10a298dd" 186 187 hmv5_key :: BS.ByteString 188 hmv5_key = B16.decodeLenient "0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c" 189 190 hmv5_put :: BS.ByteString 191 hmv5_put = "Test With Truncation" 192 193 hmv5_pec :: BS.ByteString 194 hmv5_pec = "415fad6271580a531d4179bc891d87a6" 195 196 hmv6_key :: BS.ByteString 197 hmv6_key = B16.decodeLenient "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" 198 199 hmv6_put :: BS.ByteString 200 hmv6_put = "Test Using Larger Than Block-Size Key - Hash Key First" 201 202 hmv6_pec :: BS.ByteString 203 hmv6_pec = "80b24263c7c1a3ebb71493c1dd7be8b49b46d1f41b4aeec1121b013783f8f3526b56d037e05f2598bd0fd2215d6a1e5295e64f73f63f0aec8b915a985d786598" 204 205 hmv7_key :: BS.ByteString 206 hmv7_key = hmv6_key 207 208 hmv7_put :: BS.ByteString 209 hmv7_put = "This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm." 210 211 hmv7_pec :: BS.ByteString 212 hmv7_pec = "e37b6a775dc87dbaa4dfa9f96e5e3ffddebd71f8867289865df5a32d20cdc944b6022cac3c4982b10d5eeb55c3e4de15134676fb6de0446065c97440fa8c6a58" 213 214 cmp_hash :: String -> BS.ByteString -> BS.ByteString -> TestTree 215 cmp_hash msg put pec = testCase msg $ do 216 let out = B16.encode (SHA512.hash put) 217 assertEqual mempty pec out 218 219 cmp_hash_lazy :: String -> BS.ByteString -> BS.ByteString -> TestTree 220 cmp_hash_lazy msg (BL.fromStrict -> put) pec = testCase msg $ do 221 let out = B16.encode (SHA512.hash_lazy put) 222 assertEqual mempty pec out 223 224 cmp_hmac 225 :: String -> BS.ByteString -> BS.ByteString -> BS.ByteString -> TestTree 226 cmp_hmac msg key put pec = testCase msg $ do 227 let out = B16.encode (SHA512.hmac key put) 228 assertEqual mempty pec out 229 230 cmp_hmac_lazy 231 :: String -> BS.ByteString -> BS.ByteString -> BS.ByteString -> TestTree 232 cmp_hmac_lazy msg key (BL.fromStrict -> put) pec = testCase msg $ do 233 let out = B16.encode (SHA512.hmac_lazy key put) 234 assertEqual mempty pec out 235