使用 Haskell 编写自己的区块链

Posted 2021-04-25 21CTO

Bitcoin和Ethereum提供一个处理资金、合同和所有权令牌的分散式手段。从技术层面来看，他们具有很多移动部件，并提供了一种演示编程语言的好方法。

本协议将开发一个简单的块状数据结构，以便在Haskell中演示：

• 编写二进制串行器和解串器

• 使用加密原语来计算哈希值

• 根据预算时间自动调整矿工难度

我们将其命名为Haskoin。请注意，在未来条款出来之前，它不会有任何关于网络和钱包安全的问题。

什么是区块链？

在编写任何应用软件之前的第一步总是需要找出你的数据结构。不管是 Haskell、Perl、C 或者 SQL 都是如此。我们需要在其各自的模块中放置主要的类型以及类型类的实例：

{-# LANGUAGE GeneralizedNewtypeDeriving, NoImplicitPrelude, DeriveTraversable, DeriveDataTypeable, StandaloneDeriving, TypeSynonymInstances, FlexibleInstances #-}module Haskoin.Types whereimport Protoludeimport Crypto.Hashimport Control.Comonad.Cofreeimport Data.Dataimport qualified Data.Vector as V

newtype Account = Account Integer deriving (Eq, Show, Num)

data Transaction = Transaction {
  _from   :: Account,
  _to     :: Account,
  _amount :: Integer
  } deriving (Eq, Show)

newtype BlockF a = Block (V.Vector a) deriving (Eq, Show, Foldable, Traversable, Functor, Monoid)type Block = BlockF Transactiontype HaskoinHash = Digest SHA1

data BlockHeader = BlockHeader {
  _miner       :: Account,
  _parentHash  :: HaskoinHash
  } deriving (Eq, Show)

data MerkleF a = Genesis
               | Node BlockHeader a
               deriving (Eq, Show, Functor, Traversable, Foldable)type Blockchain = Cofree MerkleF Block

MerkleF 是一个在其他类型上添加了一层的高级 Merkle 类型。 Cofree MerkleF Block 完成两件事：它递归应用  MerkleF 为 Merkle 树的所有深度生成一个类型，并且为树中的每一个节点关联一个 Block 类型的注释。

当使用 Cofree 时，anno :< xf 将会构建一个这样的注释值。

了解一下“反转树”会更为有用，其中每个节点知道其父节点，而不是每个节点知道其子节点。如果每个节点知道其子节点，向结尾添加一个新块需要修改树中的每个节点。所以 MerkleF 生成一个链，而不是一个树。

Protolude 是一个我最近在中型工程所用的对 Prelude 的替换。 Prelude 有许多向后兼容的问题，所以许多人使用 NoImplicitPrelude 语言扩展将其关闭并引入自定义的替换。

我们为什么选择这个奇怪的 MerkleF 类型而不是下面这个简单类型呢？

newtype Block = Block (V.Vector Transaction)
data Blockchain = Genesis Block
                | Node Block BlockHeader Blockchain

主要原因是获取这些 Functor, Traversable, 与 Foldable 实例，因为我们可以用其处理我们的 Markle 树，而无需编写任何代码。例如，给定一个区块链

import qualified Data.Vector as Vlet genesis_block = Block (V.fromList [])let block1 = Block (V.fromList [Transaction 0 1 1000])let genesis_chain = genesis_block :< Genesislet chain1 = block1 :< Node (BlockHeader { _miner = 0, _parentHash = undefined }) genesis_chainlet chain2 = block1 :< Node (BlockHeader { _miner = 0, _parentHash = undefined }) chain1

下面是获取所有交易信息：

let txns = toList $ mconcat $ toList chain2
-- [Transaction {_from = Account 0, _to = Account 1, _amount = 1000},Transaction {_from = Account 0, _to = Account 1, _amount = 1000}]
let totalVolume = sum $ map _amount txns
-- 2000

我使用 stack ghci测试了上述内容，进入交互式提示。

真正区块链头中有很多有用的东西，如时间戳或随机数值。我们可以根据需要将它们添加到BlockHeader。

构建链

一堆难以使用的抽象类型本身并不十分有用。我们需要一种方法来挖掘新的块来做任何有趣的事情。换句话说，我们要定义mineOn和makeGenesis:

module Haskoin.Mining wheretype TransactionPool = IO [Transaction]

mineOn :: TransactionPool -> Account -> Blockchain -> IO Blockchain
mineOn pendingTransactions minerAccount root = undefined

makeGenesis :: IO Blockchain
makeGenesis = undefined

最原始的块是相当简单的，它甚至连个头部都没有：

makeGenesis = return $ Block (V.fromList []) :< Genesis

我们没有任何难度、事务限制就可以编写 mineOn 方法，而且安全方面也相当简单，前提是我们知道如何计算一个父节点的哈希值：

mineOn :: TransactionPool -> Account -> Blockchain -> IO Blockchain
mineOn pendingTransactions minerAccount parent = do
  ts <- pendingTransactions
  let block = Block (V.fromList ts)
  let header = BlockHeader {
        _miner = minerAccount,
        _parentHash = hash parent
        }  return $ block :< Node header parent

hash :: Blockchain -> HaskoinHash
hash = undefined

Crypto.Hash 有多种计算散列值的方法，而我们前面选择了 type HaskoinHash = Digest SHA1 。但是为了使用该方法，我们需要一些实际的字节进行散列。这意味着我们需要一种序列化与反序列化 Blockchain 的方法。一个常用的库就是 binary，该库提供了我们将为我们的类型实现的 Binary 类类型。

手动编写实例并不困难，但是使用递归类型的一个好处就是编译器可以为我们生成 Binary 实例。下面是序列化与反序列化我们所需类型的完整代码：

我仅包含了 deserialize 与 serialize 从而使得模块的最终结果更为清晰。让我们将其交给  Data.Binary 中的decode 与 encode 。

Generic 是一种将值转换为可为序列化器（JSON，XML，Binary，等）所用以及许多其他类型类用来提供有用的默认定义的轻量级“语法树”的一种方法。 Haskell wiki 有一份关于 binary 使用这些 Generic 实例来定义可用于任何内容的序列化器的概述。

我们必须为 HaskoinHash 手动编译一个Binary 实例，因为 Crypto.Hash 库中的Digest SHA1 并没有提供  Generic 实例。这没什么 -- 数字也只是字节字符串，所以这也仅需要几行代码。

下面展示的是如何使用它们来实现 mineOn:

import Crypto.Hash(hashlazy)

mineOn :: TransactionPool -> Account -> Blockchain -> IO Blockchain
mineOn pendingTransactions minerAccount parent = do
  ts <- pendingTransactions
  let block = Block (V.fromList ts)
  let header = BlockHeader {
        _miner = minerAccount,
        _parentHash = hashlazy $ encode parent
        }  return $ block :< Node header parent

以及如何测试其实际的工作：

testMining :: IO Blockchain
testMining = do
  let txnPool = return []  chain <- makeGenesis  chain <- mineOn txnPool 0 chain
  chain <- mineOn txnPool 0 chain
  chain <- mineOn txnPool 0 chain
  chain <- mineOn txnPool 0 chain
  chain <- mineOn txnPool 0 chain
  return chain-- GHCI> chain <- testMiningBlock [] :< Node (BlockHeader {_miner = Account 0, _parentHash = efb3febc87c41fffb673a81ed14a6fb4f736df79}) (  Block [] :< Node (BlockHeader {_miner = Account 0, _parentHash = 2accb557297850656de70bfc3e13ea92a4ddac29}) (    Block [] :< Node (BlockHeader {_miner = Account 0, _parentHash = f51e30233feb41a228706d1357892d16af69c03b}) (      Block [] :< Node (BlockHeader {_miner = Account 0, _parentHash = 0072e83ae8e9e22d5711fd832d350f5a279c1c12}) (        Block [] :< Node (BlockHeader {_miner = Account 0, _parentHash = c259e771b237769cb6bce9a5ab734c576a6da3e1}) (          Block [] :< Genesis)))))
> encode chain"\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\DC4\239\179\254\188\135\196\US\255\182s\168\RS\209Jo\180\247\&6\223y\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\DC4*\204\181W)xPem\231\v\252>\DC3\234\146\164\221\172)\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\DC4\245\RS0#?\235A\162(pm\DC3W\137-\SYN\175i\192;\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\DC4\NULr\232:\232\233\226-W\DC1\253\131-5\SIZ'\156\FS\DC2\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\DC4\194Y\231q\178\&7v\156\182\188\233\165\171sLWjm\163\225\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL"> (decode $ encode chain) :: BlockchainBlock [] :< Node (BlockHeader {_miner = Account 0, _parentHash = efb3febc87c41fffb673a81ed14a6fb4f736df79}) (  Block [] :< Node (BlockHeader {_miner = Account 0, _parentHash = 2accb557297850656de70bfc3e13ea92a4ddac29}) (    Block [] :< Node (BlockHeader {_miner = Account 0, _parentHash = f51e30233feb41a228706d1357892d16af69c03b}) (      Block [] :< Node (BlockHeader {_miner = Account 0, _parentHash = 0072e83ae8e9e22d5711fd832d350f5a279c1c12}) (        Block [] :< Node (BlockHeader {_miner = Account 0, _parentHash = c259e771b237769cb6bce9a5ab734c576a6da3e1}) (          Block [] :< Genesis)))))

如果你在家测试序列化代码，你可能会更喜欢使用 base16-bytestring 库来将 ByteStrings 转换成十六进制 ASCII 码:

> import qualified Data.ByteString.Base16.Lazy as BSL> chain <- testMining> BSL.encode $ encode chain00000000000000000100000000000000000000000014efb3febc87c41fffb673a81ed14a6fb4f736df79000000000000000001000000000000000000000000142accb557297850656de70bfc3e13ea92a4ddac2900000000000000000100000000000000000000000014f51e30233feb41a228706d1357892d16af69c03b000000000000000001000000000000000000000000140072e83ae8e9e22d5711fd832d350f5a279c1c1200000000000000000100000000000000000000000014c259e771b237769cb6bce9a5ab734c576a6da3e1000000000000000000

注意，对于 C 程序员试着跟随我们的序列化/反序列化代码也许会是一个 PITA，因为字节问题隐藏在大量的范型代码之中。如果你希望为人们生成一个规范（好主意），你也许需要手动处理你的序列化代码，因为它是自描述的。

挖矿

有一些挖矿相关的问题，即所谓的区块链：

1. 人们可以有负余额，所以人们不可以创建一个与其交易无限金钱的“替罪羊”帐户。

2. 没有交易限制，所以会有创建一个巨大的块从而使得我们的矿工耗费所有内存。

3. 我们总是挖空块，所以没有人可以交换金钱。

4. 没有困难，所以矿工无法证明他们已完成任何工作。

我认为这些都是挖矿问题，因为矿工运行的代码需要处理这些问题。

对于#3 我们将等到 Networking 来解决. 其余的问题可以现在解决。

要解决 #1, 我们需要与我们正在挖的块有交易关系的每一个人的帐户余额。让我们继续计算所有可能的帐户余额：

blockReward = 1000balances :: Blockchain -> M.Map Account Integer
balances bc =
  let txns = toList $ mconcat $ toList bc
      debits = map (\Transaction{ _from = acc, _amount = amount} -> (acc, -amount)) txns
      credits = map (\Transaction{ _to = acc, _amount = amount} -> (acc, amount)) txns
      minings = map (\h -> (_minerAccount h, blockReward)) $ headers bc  in M.fromListWith (+) $ debits ++ credits ++ minings

一旦我们有一个父区块链,我们知道如何过滤掉无效的事务:

validTransactions :: Blockchain -> [Transaction] -> [Transaction]
validTransactions bc txns =  let accounts = balances bc
      validTxn txn = case M.lookup (_from txn) accounts of
        Nothing -> False
        Just balance -> balance >= _amount txn  in filter validTxn txns

为了解决# 2, 我会让现在的矿工选择很多交易, 放在他自己的快中。这意味着我将在我们在采矿时使用的顶部放置一个常量globalTransactionLimit = 1000，但是我们不会使用它来验证过去的块。

要解决 #4, 我们需要向 BlockHeader 添加一个现时标志域，从而矿工可以增加该标志直到他找到一个有效散列值。我们将为其指定一个任意大的整数从而避免没有现时标志值产生一个足够困难的散列的情况。而且因为我们需要调整我们的困难度，所以每个块大致需要花费相同的时间进行挖掘，我们将在头部存储一个时间戳。

import Data.Time.Clock.POSIX

-- Add new fields
data BlockHeader = BlockHeader {
  _miner       :: Account,
  _parentHash  :: HaskoinHash,
  _nonce       :: Integer,
  _minedAt     :: POSIXTime
  } deriving (Eq, Show)

-- Add serializers for POSIXTime
instance Binary POSIXTime where
  get = fromInteger <$> (get :: Get Integer)
  put x = put $ (round x :: Integer)

globalTransactionLimit = 1000mineOn :: TransactionPool -> Account -> Blockchain -> IO Blockchain
mineOn pendingTransactions minerAccount parent = do
  ts <- pendingTransactions
  ts <- return $ validTransactions parent ts
  ts <- return $ take globalTransactionLimit ts
  loop ts 0
  where
    validChain bc = difficulty bc < desiredDifficulty parent
    loop ts nonce = do
      now <- getPOSIXTime      let header = BlockHeader {
            _miner = minerAccount,
            _parentHash = hashlazy $ encode parent,
            _nonce = nonce,
            _minedAt = now
            }
          block = Block (V.fromList ts)
          candidate = block :< Node header parent      if validChain candidate
        then return candidate        else loop ts (nonce+1)

difficulty :: Blockchain -> Integerdifficulty = undefined

desiredDifficulty :: BlockChain -> IntegerdesiredDifficulty = undefined

我们进入循环，继续增加计数器并获取时间直到我们找到一个具有正确困难度的候选者。区域链的真正困难度仅是其散列值转换为整数：

import Crypto.Number.Serialize(os2ip)

difficulty :: Blockchain -> Integerdifficulty bc = os2ip $ (hashlazy $ encode bc :: HaskoinHash)

我们如何知道正确的困难是多少？我们将会由计算过去100个块的块间时间的平均值来开始：

numBlocksToCalculateDifficulty = 100blockTimeAverage :: BlockChain -> NominalDiffTime
blockTimeAverage bc = average $ zipWith (-) times (tail times)
  where
    times = take numBlocksToCalculateDifficulty $ map _minedAt $ headers bc

headers :: BlockChain -> [BlockHeader]
headers Genesis = []
headers (_ :< Node x next) = x : headers nextaverage :: (Foldable f, Num a, Fractional a, Eq a) => f a -> a
average xs = sum xs / (if d == 0 then 1 else d) where d = fromIntegral $ length xs

让我们将目标时间设定为10秒。假定 blockTimeAverage bc 为2秒，所以我们希望块花费5倍的时间：adjustmentFactor = targetTime / blockTimeAverage bc = 5. 这意味着我们仅需要原始可接受块的 1/5被接受。

因为散列值是均匀分布的，原始散列值的 1/5 小于 originalDifficulty / 5，这将是我们的新困难。 这正是 Bitcoin 所做的: difficulty = oldDifficulty * (2 weeks) / (time for past 2015 blocks).

genesisBlockDifficulty = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFtargetTime = 10-- BEWARE: O(n * k), where k = numBlocksToCalculateDifficulty
desiredDifficulty :: Blockchain -> IntegerdesiredDifficulty x = round $ loop x  where
    loop (_ :< Genesis) = genesisBlockDifficulty    loop x@(_ :< Node _ xs) = oldDifficulty / adjustmentFactor      where
        oldDifficulty = loop xs
        adjustmentFactor = min 4.0 $ targetTime `safeDiv` blockTimeAverage x

下面是使用这些计算的最近的挖掘时间：

> exampleChain <- testMining
> exampleChain <- mineOn (return []) 0 exampleChain -- Repeat a bunch of times
> mapM_ print $ map blockTimeAverage $ chains exampleChain6.61261425s6.73220925s7.97893375s12.96145975s10.923974s9.59857375s7.1819445s2.2767425s3.2307515s7.215131s15.98277575s

他们在 10s 左右浮动是因为 targetTime = 10.

持久化

我们将区块链保存到磁盘，并且提供3个工具：

• 挖掘块与创建新链的工具

• 列出帐户余额的工具

第一个工具是矿工：

{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}

module Haskoin.Cli.Mine whereimport Haskoin.Miningimport Haskoin.Serializationimport Haskoin.Typesimport Protoludeimport System.Environmentimport Data.Binaryimport qualified Data.ByteString.Lazy as BSLimport System.Directoryimport Prelude(read)

defaultChainFile = "main.chain"defaultAccount = "10"main :: IO ()
main = do
  args <- getArgs  let (filename, accountS) = case args of
        [] -> (defaultChainFile, defaultAccount)
        [filename] -> (filename, defaultAccount)
        [filename, account] -> (filename, account)        _ -> panic "Usage: mine [filename] [account]"
      swapFile = filename ++ ".tmp"
      txnPool = return []
      account = Account $ read accountS
  forever $ do
    chain <- loadOrCreate filename makeGenesis :: IO Blockchain
    newChain <- mineOn txnPool account chain
    encodeFile swapFile newChain
    copyFile swapFile filename    print "Block mined and saved!"loadOrCreate :: Binary a => FilePath -> (IO a) -> IO a
loadOrCreate filename init = do
  exists <- doesFileExist filename  if exists
    then decodeFile filename    else do
      x <- init
      encodeFile filename x      return x

第二段是打印所有账号的余额：

{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}

module Haskoin.Cli.ListBalances whereimport Haskoin.Miningimport Haskoin.Serializationimport Haskoin.Typesimport Protoludeimport System.Environmentimport Data.Binaryimport qualified Data.Map as Mimport qualified Data.ByteString.Lazy as BSL

defaultChainFile = "main.chain"main :: IO ()
main = do
  args <- getArgs  let (filename) = case args of
        [] -> (defaultChainFile)
        [filename] -> (filename)        _ -> panic "Usage: list-balances [filename]"
  chain <- decodeFile filename :: IO Blockchain
  forM_ (M.toAscList $ balances chain) $ \(account, balance) -> do
    print (account, balance)

输出结果如下：

$ stack exec list-balances
(Account 10,23000)

所以很明显的，我通过刚刚测试的 stack exec mine 挖掘了 23 个块。

结论

我们开发了一个简单的区块链数据结构。你可以 在Github浏览我们的仓库.

未来的haskoin相关文章可能会涵盖：

• 使用网络和并发原语来建立一个点对点网络。

• 保护钱包中的帐户，以便其他人无法从您的帐户中转账

• 建设一个“blockchain Explorer网站

• GPU-加速我们的散列法

• FPGA-加速我们的散列法

未来的与cryptocurrency相关的文章可能涵盖：

• 你可能听说过的工作证明及股权证明。关于证据是什么-那里的矿工竞争用适当的逻辑来证明新的定理？

• 添加图灵完整的脚本语言

• 更好的方法来解析命令行选项

• 建立一个比特币交易

译者：mylxiaoyi,cy2,Render,Pamela

原文：http://www.michaelburge.us/2017/08/17/rolling-your-own-blockchain.html

来源：https://coyee.com/article/12396-rolling-your-own-blockchain-in-haskell