sha256

Pure Haskell SHA-256, HMAC-SHA256 (docs.ppad.tech/sha256).
git clone git://git.ppad.tech/sha256.git
Log | Files | Refs | README | LICENSE

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