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