七夕送礼很发愁？自己编写一个区块链送女友吧~
作者 | Michael Burge 责编 | 贾维娣
Bitcoin和Ethereum提供一个处理资金、合同和所有权令牌的分散式手段。从技术层面来看，他们具有很多移动部件，并提供了一种演示编程语言的好方法。
本协议将开发一个简单的块状数据结构，以便在Haskell中演示：
- 编写二进制串行器和解串器
- 使用加密原语来计算哈希值
- 根据预算时间自动调整矿工难度
我们将其命名为Haskoin。请注意，在未来条款出来之前，它不会有任何关于网络和钱包安全的问题。
什么是区块链？
在编写任何应用软件之前的第一步总是需要找出你的数据结构。不管是 Haskell、Perl、C 或者 SQL 都是如此。我们需要在其各自的模块中放置主要的类型以及类型类的实例：
{-# LANGUAGE GeneralizedNewtypeDeriving, NoImplicitPrelude, DeriveTraversable, DeriveDataTypeable, StandaloneDeriving, TypeSynonymInstances, FlexibleInstances #-}
module Haskoin.Types where
import Protolude
import Crypto.Hash
import Control.Comonad.Cofree
import Data.Data
import 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 Transaction
type 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 BlockMerkleF 是一个在其他类型上添加了一层的高级 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 V
let genesis_block = Block (V.fromList [])
let block1 = Block (V.fromList [Transaction 0 1 1000])
let genesis_chain = genesis_block :< Genesis
let chain1 = block1 :< Node (BlockHeader { _miner = 0, _parentHash = undefined }) genesis_chain
let 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 where
type 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 = undefinedCrypto.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 <- testMining
Block [] :< 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) :: Blockchain
Block [] :< 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 chain
00000000000000000100000000000000000000000014efb3febc87c41fffb673a81ed14a6fb4f736df79000000000000000001000000000000000000000000142accb557297850656de70bfc3e13ea92a4ddac2900000000000000000100000000000000000000000014f51e30233feb41a228706d1357892d16af69c03b000000000000000001000000000000000000000000140072e83ae8e9e22d5711fd832d350f5a279c1c1200000000000000000100000000000000000000000014c259e771b237769cb6bce9a5ab734c576a6da3e1000000000000000000注意，对于 C 程序员试着跟随我们的序列化/反序列化代码也许会是一个 PITA，因为字节问题隐藏在大量的范型代码之中。如果你希望为人们生成一个规范（好主意），你也许需要手动处理你的序列化代码，因为它是自描述的。
挖矿
有一些挖矿相关的问题，即所谓的区块链：
- 人们可以有负余额，所以人们不可以创建一个与其交易无限金钱的“替罪羊”帐户。
- 没有交易限制，所以会有创建一个巨大的块从而使得我们的矿工耗费所有内存。
- 我们总是挖空块，所以没有人可以交换金钱。
- 没有困难，所以矿工无法证明他们已完成任何工作。
我认为这些都是挖矿问题，因为矿工运行的代码需要处理这些问题。
对于#3 我们将等到 Networking 来解决. 其余的问题可以现在解决。
要解决 #1, 我们需要与我们正在挖的块有交易关系的每一个人的帐户余额。让我们继续计算所有可能的帐户余额：
blockReward = 1000
balances :: 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 = 1000
mineOn :: 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 -> Integer
difficulty = undefined
desiredDifficulty :: BlockChain -> Integer
desiredDifficulty = undefined我们进入循环，继续增加计数器并获取时间直到我们找到一个具有正确困难度的候选者。区域链的真正困难度仅是其散列值转换为整数：
import Crypto.Number.Serialize(os2ip)
difficulty :: Blockchain -> Integer
difficulty bc = os2ip $ (hashlazy $ encode bc :: HaskoinHash)我们如何知道正确的困难是多少？我们将会由计算过去100个块的块间时间的平均值来开始：
numBlocksToCalculateDifficulty = 100
blockTimeAverage :: 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 next
average :: (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 = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
targetTime = 10
-- BEWARE: O(n * k), where k = numBlocksToCalculateDifficulty
desiredDifficulty :: Blockchain -> Integer
desiredDifficulty 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 exampleChain
6.61261425s
6.73220925s
7.97893375s
12.96145975s
10.923974s
9.59857375s
7.1819445s
2.2767425s
3.2307515s
7.215131s
15.98277575s他们在 10s 左右浮动是因为 targetTime = 10.
持久化
我们将区块链保存到磁盘，并且提供3个工具：
- 挖掘块与创建新链的工具
- 列出帐户余额的工具
第一个工具是矿工：
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
module Haskoin.Cli.Mine where
import Haskoin.Mining
import Haskoin.Serialization
import Haskoin.Types
import Protolude
import System.Environment
import Data.Binary
import qualified Data.ByteString.Lazy as BSL
import System.Directory
import 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 where
import Haskoin.Mining
import Haskoin.Serialization
import Haskoin.Types
import Protolude
import System.Environment
import Data.Binary
import qualified Data.Map as M
import 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 个块。
至此，我们开发了一个简单的区块链数据结构。
本文转载自可译网，原文链接：https://coyee.com/article/print/12396-rolling-your-own-blockchain-in-haskell
编译自：Rolling your Own Blockchain in Haskell / 使用 Haskell 编写自己的区块链
译者：mylxiaoyi 、CY2、Render、Pamela