hkdf

Pure Haskell HMAC-based KDF (docs.ppad.tech/hkdf).
git clone git://git.ppad.tech/hkdf.git
Log | Files | Refs | README | LICENSE

Main.hs (1997B)


      1 {-# LANGUAGE OverloadedStrings #-}
      2 {-# LANGUAGE RecordWildCards #-}
      3 
      4 module Main where
      5 
      6 import qualified Crypto.Hash.SHA256 as SHA256
      7 import qualified Crypto.Hash.SHA512 as SHA512
      8 import qualified Crypto.KDF.HMAC as KDF
      9 import qualified Data.Aeson as A
     10 import qualified Data.Text.IO as TIO
     11 import Test.Tasty
     12 import Test.Tasty.HUnit
     13 import qualified Wycheproof as W
     14 
     15 main :: IO ()
     16 main = do
     17   wycheproof_sha256 <- TIO.readFile "etc/hkdf_sha256_test.json"
     18   wycheproof_sha512 <- TIO.readFile "etc/hkdf_sha512_test.json"
     19   let wycheproofs = do
     20         a <- A.decodeStrictText wycheproof_sha256 :: Maybe W.Wycheproof
     21         b <- A.decodeStrictText wycheproof_sha512 :: Maybe W.Wycheproof
     22         pure (a, b)
     23   case wycheproofs of
     24     Nothing -> error "couldn't parse wycheproof vectors"
     25     Just (w256, w512) -> defaultMain $ testGroup "ppad-hkdf" [
     26         wycheproof_tests SHA256 w256
     27       , wycheproof_tests SHA512 w512
     28       ]
     29 
     30 data Hash = SHA256 | SHA512
     31   deriving Show
     32 
     33 wycheproof_tests :: Hash -> W.Wycheproof -> TestTree
     34 wycheproof_tests h W.Wycheproof {..} =
     35   testGroup ("wycheproof vectors (hkdf, " <> show h <> ")") $
     36     fmap (execute_group h) wp_testGroups
     37 
     38 execute_group :: Hash -> W.HkdfTestGroup -> TestTree
     39 execute_group h W.HkdfTestGroup {..} =
     40     testGroup msg (fmap (execute h) htg_tests)
     41   where
     42     msg = "keysize " <> show htg_keySize
     43 
     44 execute :: Hash -> W.HkdfTest -> TestTree
     45 execute h W.HkdfTest {..} = testCase t_msg $ do
     46     let ikm = ht_ikm
     47         sal = ht_salt
     48         inf = ht_info
     49         siz = ht_size
     50         pec = ht_okm
     51     case KDF.derive hmac sal inf siz ikm of
     52       Nothing
     53         | ht_result == "invalid" -> assertBool "invalid" True
     54         | otherwise -> assertFailure "failed"
     55       Just out
     56         | ht_result == "invalid" -> assertBool "invalid" (pec /= out)
     57         | otherwise -> assertEqual mempty pec out
     58   where
     59     hmac = case h of
     60       SHA256 -> SHA256.hmac
     61       SHA512 -> SHA512.hmac
     62     t_msg = "test " <> show ht_tcId -- XX embellish
     63