Question

我在某种程度上是Haskell和声明性语言的初学者，但作为一个思想实验，我认为一个有趣的编码练习是实现Hashcash algorithm之类的东西。如果你不熟悉它，基本上它是比特币工作证明计划的祖父。它指定创建一个电子邮件标题，当进入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 ()

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

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

Answer 1

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

firstBitsZero正在检查＆＃34;一个＆＃34;比特，不是＆＃34;零＆＃34;位。
您正在将firstBitsZero应用于散列的Base64编码版本，而不是散列的实际位。

毫无疑问，您在生成其Base64（即ASCII！）表示＆＃34;以＆＃34;开头的哈希时遇到了麻烦。（但见下文）超过一个小位的一位和/或零位。

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

您仍然有许多错误导致您的程序与实际的hashcash不兼容：

SPOILERS



SPOILERS



SPOILERS

您正在检查前32位字的最少有效位是否为零，而不是最高有效位（并假设testBit的位索引以1开头，但它实际上从零开始。）
您正在对整个标头进行哈希处理，包括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标题。

顺便提一下项目的不错选择。

Haskell while循环，其中递归根本不起作用？

1 个答案: