加速 Haskell PBKDF2 算法

Question

我在 Haskell 中编写了新版本的 PBKDF2 算法。它几乎通过了RFC 6070 中列出的所有 HMAC-SHA-1 测试向量，但效率不高。如何改进代码？

当我在测试向量上运行它时，第三种情况（见下文）永远不会完成（我让它在 2010 Macbook Pro 上运行超过 1/2 小时）。

我相信foldl' 是我的问题。 foldr 性能会更好，还是我需要使用可变数组？

{-# LANGUAGE BangPatterns #-}
{- Copyright 2013, G. Ralph Kuntz, MD. All rights reserved. LGPL License. -}

module Crypto where

import Codec.Utils (Octet)
import qualified Data.Binary as B (encode)
import Data.Bits (xor)
import qualified Data.ByteString.Lazy.Char8 as C (pack)
import qualified Data.ByteString.Lazy as L (unpack)
import Data.List (foldl')
import Data.HMAC (hmac_sha1)
import Text.Bytedump (dumpRaw)

-- Calculate the PBKDF2 as a hexadecimal string
pbkdf2
  :: ([Octet] -> [Octet] -> [Octet])  -- pseudo random function (HMAC)
  -> Int  -- hash length in bytes
  -> String  -- password
  -> String  -- salt
  -> Int  -- iterations
  -> Int  -- derived key length in bytes
  -> String
pbkdf2 prf hashLength password salt iterations keyLength =
  let
    passwordOctets = stringToOctets password
    saltOctets = stringToOctets salt
    totalBlocks =
      ceiling $ (fromIntegral keyLength :: Double) / fromIntegral hashLength
    blockIterator message acc =
      foldl' (\(a, m) _ ->
        let !m' = prf passwordOctets m
        in (zipWith xor a m', m')) (acc, message) [1..iterations]
  in
    dumpRaw $ take keyLength $ foldl' (\acc block ->
      acc ++ fst (blockIterator (saltOctets ++ intToOctets block)
                      (replicate hashLength 0))) [] [1..totalBlocks]
  where
    intToOctets :: Int -> [Octet]
    intToOctets i =
      let a = L.unpack . B.encode $ i
      in drop (length a - 4) a

    stringToOctets :: String -> [Octet]
    stringToOctets = L.unpack . C.pack

-- Calculate the PBKDF2 as a hexadecimal string using HMAC and SHA-1
pbkdf2HmacSha1
  :: String  -- password
  -> String  -- salt
  -> Int  -- iterations
  -> Int  -- derived key length in bytes
  -> String
pbkdf2HmacSha1 =
  pbkdf2 hmac_sha1 20

第三个测试向量

 Input:
   P = "password" (8 octets)
   S = "salt" (4 octets)
   c = 16777216
   dkLen = 20

 Output:
   DK = ee fe 3d 61 cd 4d a4 e4
        e9 94 5b 3d 6b a2 15 8c
        26 34 e9 84             (20 octets)

Answer 1

我能够在我的 MacBookPro 上在大约 16 分钟内完成它：

% time Crypto-Main
eefe3d61cd4da4e4e9945b3d6ba2158c2634e984                          
./Crypto-Main  1027.30s user 15.34s system 100% cpu 17:22.61 total

通过改变折叠的严格性：

let
  -- ...
  blockIterator message acc = foldl' (zipWith' xor) acc ms
    where ms = take iterations . tail $ iterate (prf passwordOctets) message
          zipWith' f as bs = let cs = zipWith f as bs in sum cs `seq` cs
in
  dumpRaw $ take keyLength $ foldl' (\acc block ->
    acc ++ blockIterator (saltOctets ++ intToOctets block)
                    (replicate hashLength 0)) [] [1..totalBlocks]

请注意我如何强制对每个 zipWith xor 进行全面评估。为了计算 sum cs进入WHNF，我们必须知道cs中每个元素的准确值。

这可以防止建立一个 thunk 链，我认为您现有的代码正在尝试这样做，但失败了，因为 foldl' 只会强制累加器进入 WHNF。由于您的累加器是一对，WHNF 只是 (_thunk, _another_thunk)，因此您的中间 thunk 不会被强制。