pbkdf

Pure Haskell password-based KDF (docs.ppad.tech/pbkdf).
git clone git://git.ppad.tech/pbkdf.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.PBKDF 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_hmacsha256 <- TIO.readFile "etc/pbkdf2_hmacsha256_test.json"
     18   wycheproof_hmacsha512 <- TIO.readFile "etc/pbkdf2_hmacsha512_test.json"
     19   let wycheproofs = do
     20         a <- A.decodeStrictText wycheproof_hmacsha256 :: Maybe W.Wycheproof
     21         b <- A.decodeStrictText wycheproof_hmacsha512 :: 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-pbkdf" [
     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 (pbkdf, " <> show h <> ")") $
     36     fmap (execute_group h) wp_testGroups
     37 
     38 execute_group :: Hash -> W.PbkdfTestGroup -> TestTree
     39 execute_group h W.PbkdfTestGroup {..} =
     40   testGroup mempty (fmap (execute h) ptg_tests)
     41 
     42 execute :: Hash -> W.PbkdfTest -> TestTree
     43 execute h W.PbkdfTest {..} = testCase t_msg $ do
     44     let pas = pt_password
     45         sal = pt_salt
     46         cow = pt_iterationCount
     47         siz = pt_dkLen
     48         pec = pt_dk
     49     case KDF.derive hmac pas sal cow siz of
     50       Nothing
     51         | pt_result == "invalid" -> assertBool "invalid" True
     52         | otherwise -> assertFailure mempty
     53       Just out
     54         | pt_result == "invalid" -> assertBool "invalid" (pec /= out)
     55         | otherwise -> assertEqual mempty pec out
     56   where
     57     hmac = case h of
     58       SHA256 -> SHA256.hmac
     59       SHA512 -> SHA512.hmac
     60     t_msg = "test " <> show pt_tcId -- XX embellish
     61