Haskell while 循环，递归根本行不通？

Question

总的来说，我是 Haskell 和声明性语言的初学者，但作为一个思想实验，我决定一个有趣的编码练习是实现类似 Hashcash algorithm 的东西。如果您不熟悉它，基本上它就是比特币工作量证明方案的鼻祖。它指定创建电子邮件 header，当散列到 SHA-1 摘要中时，前 n 位应为零，其中 n 是工作量证明的难度。这旨在为收件人验证微不足道，同时为发件人支付适度的 CPU 周期费用，以阻止大规模垃圾邮件操作。这对我来说是一个有趣的练习，因为它让我学习了如何使用 Haskell 中的 ByteString 和位，同时尝试以功能性和声明性的方式处理非常具体但可能大量必要的一系列步骤。本质上，发送者必须增加一个计数器并重建潜在的 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 动作，然后可能在每个动作结果的条件下执行 takeWhile 以查看我是否需要再采取？

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

Answer 1

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

firstBitsZero 正在检查 "one" 位，而不是 "zero" 位。
您正在将 firstBitsZero 应用于散列的 Base64 编码版本，而不是散列的实际位。

您在生成其 Base64（即 ASCII！）表示 "starts with"（但见下文）多于少量一位 and/or 零位的哈希时遇到问题也就不足为奇了.

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

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

SPOILERS



SPOILERS



SPOILERS

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

修复这些后，您的程序看起来运行正常。例如，这是您的程序在难度为 20 时生成的 hashcash，我们可以使用您的 mahDecoder.

验证它以 20 个零位开始

> runGet mahDecoder (hashSHA1 "1:20:150320112233:a@a::2go+qPr1OxIigymGiuEDxw==:NTE3MDM0")
(Right 753,"[1\GS7iw\NAKIp30)BZI_")
>

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

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

Haskell while 循环，递归根本行不通？

Haskell while loop where recursion simply won't do?

algorithm

monads

recursion

haskell