Main.hs (8520B)
1 {-# LANGUAGE OverloadedStrings #-} 2 {-# LANGUAGE RecordWildCards #-} 3 {-# LANGUAGE ViewPatterns #-} 4 5 module Main where 6 7 import qualified Crypto.Hash.SHA256 as SHA256 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_sha256.json" 22 case A.decodeStrictText wycheproof :: Maybe W.Wycheproof of 23 Nothing -> error "couldn't parse wycheproof vectors" 24 Just w -> defaultMain $ testGroup "ppad-sha256" [ 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 decodeLenient :: BS.ByteString -> BS.ByteString 40 decodeLenient bs = case B16.decode bs of 41 Nothing -> error "bang" 42 Just b -> b 43 44 execute :: Int -> W.MacTest -> TestTree 45 execute tag_size W.MacTest {..} = testCase t_msg $ do 46 let key = decodeLenient (TE.encodeUtf8 mt_key) 47 msg = decodeLenient (TE.encodeUtf8 mt_msg) 48 pec = decodeLenient (TE.encodeUtf8 mt_tag) 49 out = BS.take bytes (SHA256.hmac key msg) 50 if mt_result == "invalid" 51 then assertBool "invalid" (pec /= out) 52 else assertEqual mempty pec out 53 where 54 t_msg = "test " <> show mt_tcId -- XX embellish 55 bytes = tag_size `div` 8 56 57 unit_tests :: TestTree 58 unit_tests = testGroup "unit tests" [ 59 testGroup "hash" [ 60 cmp_hash "hv0" hv0_put hv0_pec 61 , cmp_hash "hv1" hv1_put hv1_pec 62 , cmp_hash "hv2" hv2_put hv2_pec 63 , cmp_hash "hv3" hv3_put hv3_pec 64 , cmp_hash "hv4" hv4_put hv4_pec 65 ] 66 , testGroup "hash_lazy" [ 67 cmp_hash_lazy "hv0" hv0_put hv0_pec 68 , cmp_hash_lazy "hv1" hv1_put hv1_pec 69 , cmp_hash_lazy "hv2" hv2_put hv2_pec 70 , cmp_hash_lazy "hv3" hv3_put hv3_pec 71 , cmp_hash_lazy "hv4" hv4_put hv4_pec 72 ] 73 -- uncomment me to run (slow, ~30s) 74 -- 75 -- , testGroup "hash_lazy (1GB input)" [ 76 -- testCase "hv5" $ do 77 -- let out = B16.encode (SHA256.hash_lazy hv5_put) 78 -- assertEqual mempty hv5_pec out 79 -- ] 80 , testGroup "hmac" [ 81 cmp_hmac "hmv1" hmv1_key hmv1_put hmv1_pec 82 , cmp_hmac "hmv2" hmv2_key hmv2_put hmv2_pec 83 , cmp_hmac "hmv3" hmv3_key hmv3_put hmv3_pec 84 , cmp_hmac "hmv4" hmv4_key hmv4_put hmv4_pec 85 , testCase "hmv5" $ do 86 let out = BS.take 32 $ B16.encode (SHA256.hmac hmv5_key hmv5_put) 87 assertEqual mempty hmv5_pec out 88 , testCase "hmv6" $ do 89 let out = B16.encode (SHA256.hmac hmv6_key hmv6_put) 90 assertEqual mempty hmv6_pec out 91 , testCase "hmv7" $ do 92 let out = B16.encode (SHA256.hmac hmv7_key hmv7_put) 93 assertEqual mempty hmv7_pec out 94 ] 95 , testGroup "hmac_lazy" [ 96 cmp_hmac_lazy "hmv1" hmv1_key hmv1_put hmv1_pec 97 , cmp_hmac_lazy "hmv2" hmv2_key hmv2_put hmv2_pec 98 , cmp_hmac_lazy "hmv3" hmv3_key hmv3_put hmv3_pec 99 , cmp_hmac_lazy "hmv4" hmv4_key hmv4_put hmv4_pec 100 , testCase "hmv5" $ do 101 let lut = BL.fromStrict hmv5_put 102 out = BS.take 32 $ B16.encode (SHA256.hmac_lazy hmv5_key lut) 103 assertEqual mempty hmv5_pec out 104 , testCase "hmv6" $ do 105 let lut = BL.fromStrict hmv6_put 106 out = B16.encode (SHA256.hmac_lazy hmv6_key lut) 107 assertEqual mempty hmv6_pec out 108 , testCase "hmv7" $ do 109 let lut = BL.fromStrict hmv7_put 110 out = B16.encode (SHA256.hmac_lazy hmv7_key lut) 111 assertEqual mempty hmv7_pec out 112 ] 113 ] 114 115 -- vectors from 116 -- https://www.di-mgt.com.au/sha_testvectors.html 117 118 hv0_put, hv0_pec :: BS.ByteString 119 hv0_put = "abc" 120 hv0_pec = "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" 121 122 hv1_put, hv1_pec :: BS.ByteString 123 hv1_put = mempty 124 hv1_pec = "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" 125 126 hv2_put, hv2_pec :: BS.ByteString 127 hv2_put = "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" 128 hv2_pec = "248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1" 129 130 hv3_put, hv3_pec :: BS.ByteString 131 hv3_put = "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" 132 hv3_pec = "cf5b16a778af8380036ce59e7b0492370b249b11e8f07a51afac45037afee9d1" 133 134 hv4_put, hv4_pec :: BS.ByteString 135 hv4_put = BS.replicate 1000000 0x61 136 hv4_pec = "cdc76e5c9914fb9281a1c7e284d73e67f1809a48a497200e046d39ccc7112cd0" 137 138 big_input :: BL.ByteString 139 big_input = go (16777216 :: Int) mempty where 140 go j acc 141 | j == 0 = BSB.toLazyByteString acc 142 | otherwise = 143 let nacc = acc <> BSB.lazyByteString 144 "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmno" 145 in go (pred j) nacc 146 147 hv5_put :: BL.ByteString 148 hv5_put = big_input 149 150 hv5_pec :: BS.ByteString 151 hv5_pec = "50e72a0e26442fe2552dc3938ac58658228c0cbfb1d2ca872ae435266fcd055e" 152 153 -- vectors from 154 -- https://datatracker.ietf.org/doc/html/rfc4231#section-4.1 155 156 hmv1_key :: BS.ByteString 157 hmv1_key = decodeLenient "0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b" 158 159 hmv1_put :: BS.ByteString 160 hmv1_put = "Hi There" 161 162 hmv1_pec :: BS.ByteString 163 hmv1_pec = "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" 164 165 hmv2_key :: BS.ByteString 166 hmv2_key = "Jefe" 167 168 hmv2_put :: BS.ByteString 169 hmv2_put = "what do ya want for nothing?" 170 171 hmv2_pec :: BS.ByteString 172 hmv2_pec = "5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843" 173 174 hmv3_key :: BS.ByteString 175 hmv3_key = decodeLenient "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" 176 177 hmv3_put :: BS.ByteString 178 hmv3_put = decodeLenient "dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd" 179 180 hmv3_pec :: BS.ByteString 181 hmv3_pec = "773ea91e36800e46854db8ebd09181a72959098b3ef8c122d9635514ced565fe" 182 183 hmv4_key :: BS.ByteString 184 hmv4_key = decodeLenient "0102030405060708090a0b0c0d0e0f10111213141516171819" 185 186 hmv4_put :: BS.ByteString 187 hmv4_put = decodeLenient "cdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcd" 188 189 hmv4_pec :: BS.ByteString 190 hmv4_pec = "82558a389a443c0ea4cc819899f2083a85f0faa3e578f8077a2e3ff46729665b" 191 192 hmv5_key :: BS.ByteString 193 hmv5_key = decodeLenient "0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c" 194 195 hmv5_put :: BS.ByteString 196 hmv5_put = "Test With Truncation" 197 198 hmv5_pec :: BS.ByteString 199 hmv5_pec = "a3b6167473100ee06e0c796c2955552b" 200 201 hmv6_key :: BS.ByteString 202 hmv6_key = decodeLenient "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" 203 204 hmv6_put :: BS.ByteString 205 hmv6_put = "Test Using Larger Than Block-Size Key - Hash Key First" 206 207 hmv6_pec :: BS.ByteString 208 hmv6_pec = "60e431591ee0b67f0d8a26aacbf5b77f8e0bc6213728c5140546040f0ee37f54" 209 210 hmv7_key :: BS.ByteString 211 hmv7_key = hmv6_key 212 213 hmv7_put :: BS.ByteString 214 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." 215 216 hmv7_pec :: BS.ByteString 217 hmv7_pec = "9b09ffa71b942fcb27635fbcd5b0e944bfdc63644f0713938a7f51535c3a35e2" 218 219 cmp_hash :: String -> BS.ByteString -> BS.ByteString -> TestTree 220 cmp_hash msg put pec = testCase msg $ do 221 let out = B16.encode (SHA256.hash put) 222 assertEqual mempty pec out 223 224 cmp_hash_lazy :: String -> BS.ByteString -> BS.ByteString -> TestTree 225 cmp_hash_lazy msg (BL.fromStrict -> put) pec = testCase msg $ do 226 let out = B16.encode (SHA256.hash_lazy put) 227 assertEqual mempty pec out 228 229 cmp_hmac 230 :: String -> BS.ByteString -> BS.ByteString -> BS.ByteString -> TestTree 231 cmp_hmac msg key put pec = testCase msg $ do 232 let out = B16.encode (SHA256.hmac key put) 233 assertEqual mempty pec out 234 235 cmp_hmac_lazy 236 :: String -> BS.ByteString -> BS.ByteString -> BS.ByteString -> TestTree 237 cmp_hmac_lazy msg key (BL.fromStrict -> put) pec = testCase msg $ do 238 let out = B16.encode (SHA256.hmac_lazy key put) 239 assertEqual mempty pec out 240