Haskell while循环,递归根本不会做？

我有点像Haskell和声明性语言的初学者,但作为一个思想实验,我认为一个有趣的编码练习是实现类似Hashcash算法的东西.如果你不熟悉它,基本上它是比特币工作证明计划的祖父.它指定了一个电子邮件标题的创建,当将其转换为SHA-1摘要时,应将第一个n位置为零,其中n是工作证明的难度.这旨在为收件人验证是微不足道的,同时为发件人节省适当的CPU周期费用,目的是阻止大规模垃圾邮件操作.这对我来说是一个有趣的练习,因为它让我学习如何使用ByteStrings和Haskell中的位,同时尝试以功能和声明的方式处理一个非常具体但可能是大量必要的一系列步骤.本质上,发送方必须递增计数器并重建潜在的标头,对其进行测试,如果该特定测试有效,则我们有一个有效的标头.随着难度的增加,它被设计成指数级更难.

我在这一点上的问题是1和2位为零的难度似乎工作正常,但是一旦我达到3或更多的难度,我似乎陷入了无限循环,直到堆栈爆炸.我没有使用while循环,而是尝试以递归方式执行此操作,因此我指定了计数器的严格性,因此必须先计算先前的thunks,然后才能进入下一步,并且我不再收到溢出,但我仍然看起来陷入无休止的循环(或者表现如此糟糕,以至于我从未走到尽头？)

{-# 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 ()

很明显这不起作用,我现在还不太清楚为什么,但我试图想出更好的方法来解决这个问题.例如,是否有可能创建一个sequencemonadic动作,testCounter然后可能takeWhile在每个动作结果的条件下执行,以查看是否需要再进行操作？

如果没有,那么Proof of Work算法是否属于对声明性函数式编程没有意义的那类应用程序？

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

firstBitsZero 检查"一"位,而不是"零"位.

您正在应用firstBitsZero散列的Base64编码版本,而不是散列的实际位.

毫无疑问,您生成的哈希值为Base64(即ASCII!)表示"以"开头"(但见下文),而不是少量的一位和/或零位.

如果你解决了这两个问题,你会发现你的程序在使用-O2优化编译时,会在一分钟内生成一个20位的HashCash.仍然太慢,但显然有很大改善.

您仍然有许多错误使您的程序与实际的hashcash不兼容:

SPOILERS



SPOILERS



SPOILERS

您正在检查前32位字的最低有效位是否为零,而不是最高有效位(并且您假设位索引testBit以1开始,但它实际上从零开始).

您正在散列整个标头,包括X-HashCash:前缀,该前缀不是应该散列的字符串的一部分.

修复这些后,看起来您的程序运行正常.例如,这是一个由你的程序在难度为20时生成的hashcash,我们可以使用你的来验证20个零位mahDecoder.

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

再次注意,要检查的字符串会排除X-HashCash标题.

顺便说一句,项目选择不错.