algorithm - Haskell while循环哪里递归根本行不通？

Question

总的来说，我是 Haskell 和声明式语言的初学者，但作为一个思想实验，我决定一个有趣的编码练习是实现类似 Hashcash algorithm 的东西。 .如果您不熟悉它，基本上它就是比特币工作量证明方案的鼻祖。它指定创建电子邮件 header ，当将其散列为 SHA-1 摘要时，前 n 位应为零，其中 n 是工作量证明的难度.这旨在为收件人验证微不足道，同时为了阻止大规模垃圾邮件操作而为发件人花费适度的 CPU 周期。这对我来说是一个有趣的练习，因为它让我学习了如何在 Haskell 中使用 ByteStrings 和位，同时尝试以功能和声明的方式处理非常具体但可能大量必要的一系列步骤。本质上，发送方必须增加一个计数器并重建潜在的 header ，对其进行测试，如果该特定测试有效，那么我们就有了一个有效的 header 。它被设计成随着难度的增加呈指数级增加。

此时我的问题是，1 位和 2 位的难度为零似乎工作正常，但一旦我达到 3 或更多难度，我似乎陷入了无限循环，直到堆栈爆炸。我没有使用 while 循环，而是尝试以递归方式执行此操作，因此我指定了计数器的严格性，在进入下一步之前必须计算此类先前的 thunk，并且我不再收到溢出，但我仍然出现陷入无限循环(或者性能太差以至于我永远无法结束？)

{-# LANGUAGE BangPatterns #-}

module HashCash where

import Data.Int
import Data.List
import Data.List.Split (splitOn)
import Data.Char
import Data.Function
import System.Random
import Data.Bits
import Data.Either
import Data.Binary.Strict.Get
import System.IO as SIO
import Data.Word (Word32)
import Data.ByteString as B
import Data.ByteString.Char8 as BC
import Data.ByteString.UTF8 as BU
import Data.ByteString.Base64 as B64
import Data.ByteString.Conversion as BCON
import Data.ByteArray as BA
import Crypto.Random
import Crypto.Hash


startingCounter :: Int32
startingCounter = 1
difficulty :: Int
difficulty = 4
template = "X-Hashcash: 1:{:{:{::{:{"
dateTemplate = "YYMMDDhhmmss"
address = "a@a"

-- example date because I dont want to mess with date formatting just now
exampleDate = "150320112233"

convertToString :: ByteString -> String
convertToString b = BU.toString b

convertFromString :: String -> ByteString
convertFromString s = BU.fromString s

convertIntToString :: Int -> String
convertIntToString a = convertToString . BCON.toByteString' $ a

encodeInt32 :: Int32 -> ByteString
encodeInt32 a = B64.encode . BCON.toByteString' $ a

mahDecoder :: Get Word32
mahDecoder = do
  first32Bits <- getWord32be
  return first32Bits

firstBitsZero :: (Bits a) => a -> Int -> Bool
firstBitsZero val num = Data.List.foldl' (\acc x -> (testBit val x) && acc) True [1..num]

formatTemplate :: String -> [String] -> String
formatTemplate base [] = base
formatTemplate base (x:xs) = 
   let splix = (Data.List.Split.splitOn "{" base) :: [String]
       splixHead = Data.List.head splix ++ x
       splixTail = Data.List.tail splix
       concatSplitTail = Data.List.init $ Data.List.concatMap (++ "{") splixTail
   in formatTemplate (splixHead ++ concatSplitTail) xs

get16RandomBytes :: (DRG g) => g -> IO (ByteString, g)
get16RandomBytes gen = do
  let a = randomBytesGenerate 16 gen
  return $ a

getBaseString :: ByteString -> Int32 -> String
getBaseString bs counter = 
  let encodedVal = B64.encode bs
      encodedCounter = encodeInt32 counter
      baseParams = [(convertIntToString difficulty), exampleDate, address, (convertToString encodedVal), (convertToString encodedCounter)]
  in formatTemplate template baseParams

hashSHA1Encoded :: ByteString -> ByteString
hashSHA1Encoded bs =
  let hashDigest = hash bs :: Digest SHA1
      byteString = B.pack . BA.unpack $ hashDigest
  in B64.encode byteString

-- Pass a counter and if the first 20 bits are zero then return the same counter value else increment it
-- signifying it is time to test the next number (NOTE: recursive style, may overflow stack)
testCounter :: ByteString -> Int32 -> Int32
testCounter rb !counter = 
  let baseString = getBaseString rb counter
      hashedString = hashSHA1Encoded $ convertFromString baseString
      !eitherFirst32 = runGet mahDecoder hashedString
      incCounter = counter + 1
  in case eitherFirst32 of
    (Left first32, _) -> testCounter rb incCounter
    (Right first32, _) -> if (firstBitsZero first32 difficulty)
                           then counter
                           else testCounter rb incCounter

generateHeader :: IO String
generateHeader = do
  g <- getSystemDRG
  (ran, _) <- get16RandomBytes g
  let counter = testCounter ran startingCounter
  return $ getBaseString ran counter

main :: IO ()
main = do 
  header <- generateHeader
  SIO.putStrLn header
  return ()

很明显这是行不通的，我还不是很确定为什么，但我正在尝试思考可以解决此问题的更好方法。例如，是否可以为 testCounter 创建一个 sequence 的 monadic Action ，然后可能在每个 Action 结果的条件下执行 takeWhile 以查看是否我还需要服用吗？

如果不是，那么工作量证明算法是否属于对声明式函数式编程没有意义的应用程序类别？

Answer 1

问题不在于代码的效率。你真的进入了一个无限循环，因为你有两个错误:

1. firstBitsZero 正在检查“1”位，而不是“0”位。
2. 您正在将 firstBitsZero 应用于散列的 Base64 编码版本，而不是散列的实际位。

毫不奇怪，您在生成其 Base64(即 ASCII!)表示“以”(但见下文)多于少量 1 位和/或 0 位的哈希值时遇到问题。

如果您解决了这两个问题，您会发现您的程序在使用 -O2 优化进行编译时，会在一分钟内生成一个 20 位的 HashCash。还是太慢了，不过明显进步了很多。

你仍然有一些错误使你的程序与实际的 hashcash 不兼容:

SPOILERS



SPOILERS



SPOILERS

• 您正在检查第一个 32 位字的最低 有效位是否为零，而不是最高有效位(并且您假设 testBit 的位索引从 1 开始，但实际上是从零开始)。
• 您正在散列整个 header ，包括 X-HashCash: 前缀，它不是应该散列的字符串的一部分。

修复这些问题后，您的程序看起来运行良好。例如，这是您的程序在难度为 20 时生成的 hashcash，我们可以使用您的 mahDecoder 验证它以 20 个零位开始。

> runGet mahDecoder (hashSHA1 "1:20:150320112233:a@a::2go+qPr1OxIigymGiuEDxw==:NTE3MDM0")
(Right 753,"[\191\GS\237iw\NAKIp\193\140)BZI_")
>

再次注意，要检查的字符串不包括 X-HashCash header 。

顺便说一句，项目的选择不错。