algorithm - Haskell while循环在哪里递归根本不会做？

一般来说，我对haskell和声明性语言有点初级，但是作为一个思想实验，我决定一个有趣的编码练习是实现类似于Hashcash algorithm的东西。如果你不熟悉它，基本上它是比特币工作证明计划的祖父它指定创建一个电子邮件头，当散列到sha-1摘要中时，第一个n位应为零，其中n是工作证明的难点。这被设计成对接收者进行简单的验证，而对发送者的cpu周期的开销很小，目的是阻止大量的垃圾邮件操作。这对我来说是一个有趣的练习，因为它让我学会了如何使用haskell中的bytestrings和bits，同时尝试以函数式和声明式的方式处理一系列非常具体但潜在巨大的命令式步骤。实际上，发送方必须增加一个计数器并重新生成潜在的报头，并对其进行测试，如果该特定测试有效，则我们拥有一个有效的报头。它被设计成随着难度的增加而成倍增加。
在这一点上，我的问题是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 ()

很明显这是行不通的，我也不知道为什么，但我一直在想更好的办法来解决这个问题。例如，是否有可能为sequence创建一个testCounter的单次操作，然后在每个操作结果的条件下执行takeWhile以查看是否需要继续？
如果没有，那么工作证明算法是否属于那种对声明式函数编程毫无意义的应用程序？

最佳答案

问题不在于代码的效率。你真的进入了无限循环，因为你有两个错误：
firstBitsZero正在检查“一”位，而不是“零”位。
您正在将firstBitsZero应用于哈希的base64编码版本，而不是哈希的实际位。
毫不奇怪，生成base64（即ascii！）表示“以”（但见下文）多于少量的一位和/或零位开始。
如果你解决了这两个问题，你会发现你的程序在编译时使用了-O2优化，在一分钟内生成一个20位的hashcash。还是太慢了，但是明显有了很大的进步。
您仍然有许多错误使您的程序与实际的hashcash不兼容：

SPOILERS



SPOILERS



SPOILERS

您正在检查前32位字的最低有效位是否为零，而不是最高有效位（并且假设testBit的位索引以1开头，但实际上是以零开头）。
您正在散列整个头，包括X-HashCash:前缀，它不是应该散列的字符串的一部分。
修复这些之后，你的程序就可以工作了。例如，这里有一个hashcash，由您的程序在困难20时生成，我们可以使用mahDecoder从20个零位开始验证它。

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

再次注意，要检查的字符串不包括X-HashCash头。
顺便说一句，项目选择不错。