Published: 08 May 2018 › Updated: 08 May 2018
用Common Lisp实现＂Blockshell＂
自从阅读了 Blockshell[1] —— 一个最小的学习区块链的命令行界面:
https://zhuanlan.zhihu.com/p/33520216
后，便开始了区块链程序的开发路程。
以下正文内容用一句句源码一步一步地实现Common Lisp版的＂Blockshell＂，可以查看原文
https://github.com/sundawning/literate-programming/blob/master/blockshell.org
来直接构建，省去复制粘贴的过程。
程序使用org-mode编写，相应的示例与程序的定义部分成对存在，代码即示例，代码即文档。
本篇博客抽取出原文里的程序部分，并结合Steemit网站的特点，重新整理以便能正常发布、阅读。因此，如果你对Common Lisp一无所知，以下内容恐招来睡意，请止步于此；如果你想学习编程，但不知从哪种语言入手，推荐Common Lisp，因为Common Lisp的语法已经是至简，只有括号是必须的。
系统定义：sundawning.block-chain.asd
(in-package :common-lisp)
(asdf:defsystem #:sundawning.block-chain
:depends-on (#:babel
#:ironclad
#:cl-store)
:serial t
:components ((:file "package")
(:file "utility")
(:file "block-chain")))
包定义：package.lisp
(in-package :common-lisp)
(defpackage #:sundawning.block-chain
(:use :common-lisp)
(:export #:*data-blocks*
#:data-block
#:index
#:previous-hash
#:data
#:timestamp
#:nonce
#:hash
#:data-block-index
#:data-block-previous-hash
#:data-block-data
#:data-block-timestamp
#:data-block-nonce
#:data-block-hash
#:insert
#:activate-initial-block
#:all-blocks
#:store
#:restore
#:objects-to-string
#:string-to-hex-string
#:class-slots-names
#:reduce-list
#:hash-table-keys
))
实用函数：utility.lisp
(in-package #:sundawning.block-chain)
拼接多个对象
- 空值转换成空字符串
(defun objects-to-string (&rest rest)
(format nil "~{~A~}"
(mapcar (lambda (i)
(if (null i)
""
i))
rest)))
(objects-to-string 0 nil nil 3726796533 0 "dd9a97e5501949252f92370742c9102244ae1ca2462a332196ae57d037d90029")
"037267965330dd9a97e5501949252f92370742c9102244ae1ca2462a332196ae57d037d90029"
字符串转换成16进制字符串
- 先进行两次sha256编码
- 再按16进制编码
(defun string-to-hex-string (string)
(when string
(ironclad:byte-array-to-hex-string
(ironclad:digest-sequence :sha256
(ironclad:digest-sequence :sha256
(babel:string-to-octets string))))))
(string-to-hex-string "037267965330dd9a97e5501949252f92370742c9102244ae1ca2462a332196ae57d037d90029")
"373c03001be1be19e52e64ceeffd6c270a28f265ed614f597c2b11eacd34d186"
哈希表的所有键
(defun hash-table-keys (hash-table)
(let ((keys ()))
(maphash (lambda (key value)
(push key keys))
hash-table)
keys))
类的所有插槽的名称
(defun class-slots-names (object)
(mapcar #'sb-mop:slot-definition-name
(sb-mop:class-slots (class-of object))))
类里某个对象所有插槽对应的值
(defun class-object-values (object)
(mapcar (lambda (slot-name)
(slot-value object slot-name))
(class-slots-names object)))
(0 NIL NIL 3726810699 0
"22b28bad900cef94e5029c5dc20d4c847d3a2b0db48b9e60be2f6eb8f699bb5f")
拼接列表
(defun reduce-list (list)
(reduce (lambda (i j)
(concatenate 'list i j))
list
:initial-value nil))
(reduce-list '((INDEX 0) (PREVIOUS-HASH NIL) (DATA NIL) (TIMESTAMP 3726798867) (NONCE 0)
(HASH "5b6639084735a5d5daef7754bb76e0f883e470bc74c62ed6fdf3f5e51e415244")))
(INDEX 0 PREVIOUS-HASH NIL DATA NIL TIMESTAMP 3726798867 NONCE 0 HASH
"5b6639084735a5d5daef7754bb76e0f883e470bc74c62ed6fdf3f5e51e415244")
向量转换成列表
(defun vector-to-list (vector)
(loop
:for i from 0 to (1- (array-total-size vector))
:collect (aref vector i)))
(vector-to-list
(vector 1 2 3))
(1 2 3)
区块链：block-chain.lisp
(in-package #:sundawning.block-chain)
建立数据库
- 以类和向量的方式构造数据库
- 不需要更改数据库：一旦添加了数据，就不再需要更改
- 不需要删除数据库：只要不用了数据库，弃用数据库、格式化数据库就行，不需要逐个地删除数据
(defclass data-block () ((index :initarg :index :accessor data-block-index) (previous-hash :initarg :previous-hash :accessor data-block-previous-hash) (data :initarg :data :accessor data-block-data) (timestamp :initarg :timestamp :accessor data-block-timestamp) (nonce :initarg :nonce :accessor data-block-nonce) (hash :initarg :hash :accessor data-block-hash))) (defmethod insert ((data-blocks vector) &key index previous-hash data timestamp nonce) (let ((hash (string-to-hex-string (objects-to-string index previous-hash data timestamp nonce)))) (vector-push-extend (make-instance 'data-block :hash hash :nonce nonce :timestamp timestamp :data data :previous-hash previous-hash :index index) data-blocks))) - 示例：使用数据库
- 创建数据库
- 添加数据
- 查看数据库里所添加的数据
(let ((data-blocks (make-array 1 :fill-pointer 0)) (index 0) (previous-hash nil) (data nil) (timestamp (get-universal-time)) (nonce 0)) (insert data-blocks :index index :previous-hash previous-hash :data data :timestamp timestamp :nonce nonce) (let ((object (gethash (sundawning.block-chain::data-block-hash)) (aref data-blocks 0))) (reduce-list (mapcar (lambda (slot-name) (list slot-name (slot-value object slot-name))) (class-slots-names object)))))(INDEX 0 PREVIOUS-HASH NIL DATA NIL TIMESTAMP 3726801811 NONCE 0 HASH "ca21eb1dd1f786c93395394c7ab31371b4300505d3f1367d17c79a3d2e10d1f5")
激活初始块
- 将数据库清空
- 向数据库里添加第一个数据
(defparameter *data-blocks* nil)
(defmethod activate-initial-block ((data-blocks vector) data)
(let ((index 0)
(previous-hash nil)
(data data)
(timestamp (get-universal-time))
(nonce 0))
(setf *data-blocks* data-blocks)
(insert *data-blocks*
:index index
:previous-hash previous-hash
:data (or data
"Copyright (c) 2018 SunDawning <dpmeichen@gmail.com> All rights reserved.")
:timestamp timestamp
:nonce nonce)))
(activate-initial-block (make-array 1 :fill-pointer 0)
nil)
0
*data-blocks*
#(#<DATA-BLOCK {10031EC173}>)
查看所有数据块
(defmethod all-blocks ((data-blocks vector))
(mapcar (lambda (object)
(reduce-list
(mapcar (lambda (slot-name)
(list slot-name (slot-value object slot-name)))
(class-slots-names object))))
(subseq (vector-to-list data-blocks)
0
(length data-blocks))))
(all-blocks *data-blocks*)
((INDEX 1 PREVIOUS-HASH
#1="d250ed4624d2282b5eaac8a501ea08560ca370b4cdac4897ab4a61b51e437b3d" DATA
"第一个" TIMESTAMP 3726802462 NONCE 24 HASH
"04b38373e95c31da583a59afac114efd244fd08f62c3f87668e5459cb5ad481a")
(INDEX 0 PREVIOUS-HASH NIL DATA NIL TIMESTAMP 3726802341 NONCE 0 HASH #1#))
计算数据块是否符合要求
- 哈希值验证
比如，看一个字符串是否以4个0开头：(defun hex-string-p (string) (cl-ppcre:scan-to-strings "^[0-9a-f]*$" string)) (defun valid-difficulty-p (difficulty) (hex-string-p (remove-if-not #'alpha-char-p difficulty))) (defun hash-value-verification (difficulty hex-string) (if (valid-difficulty-p difficulty) (cl-ppcre:scan-to-strings difficulty hex-string) (error "难度值不对头呀，伙计，你见过16进制的内容里含有你给的英文字母？")))(hash-value-verification "^0{4}" "d250ed4624d2282b5eaac8a501ea08560ca370b4cdac4897ab4a61b51e437b3d")NIL - 前一个数据块
(defmethod previous-data-block ((data-blocks hash-table)) (unless (< (hash-table-count data-blocks) 1) (gethash (nth (1- (hash-table-count data-blocks)) (hash-table-keys data-blocks)) data-blocks))) - 前一个数据块的哈希值
- 从现有的数据块里取出前一个数据块的哈希值
(defun previous-hash (data-blocks index) (data-block-hash (aref data-blocks (1- index))))(previous-hash *data-blocks* 1)"4aa489da52043ff43ea353934d4d09a0e4f39247d5361114aee098bb5bc47060" - 将符合要求的数据添加到数据库里
(defun proof-of-work (difficulty data-blocks data) (let ((previous-hash (previous-hash data-blocks (length data-blocks))) (index (length data-blocks)) (nonce 0)) (loop (let ((time (get-universal-time))) (if (hash-value-verification difficulty (string-to-hex-string (objects-to-string index previous-hash data time nonce))) (return (insert data-blocks :index index :previous-hash previous-hash :data data :timestamp time :nonce nonce)) (incf nonce))))))
开始计算
(defparameter *difficulty* "^0{4}")
(defun mine-block (&optional data)
(unless *data-blocks*
(activate-initial-block (make-array 1 :fill-pointer 0)
nil))
(proof-of-work *difficulty* *data-blocks* data))
(defmethod insert ((data string) &rest rest)
(declare (ignore rest))
(typecase *data-blocks*
(vector
(proof-of-work *difficulty* *data-blocks* data))
(hash-table
(let ((previous-data-block (previous-data-block *data-blocks*)))
(insert *data-blocks*
:timestamp (get-universal-time)
:data data
:previous-hash (data-block-hash previous-data-block)
:index (1+ (data-block-index previous-data-block)))))))
示例：一个完整的初始化、计算过程
- 加载库
(progn (ql:quickload :sundawning.block-chain) (in-package :sundawning.block-chain)) - 开始计算
(let ((*difficulty* "^0{2}}")) (dotimes (i 10) (mine-block)) *data-blocks*)#(#<DATA-BLOCK {10022AC123}> #<DATA-BLOCK {10025345A3}> #<DATA-BLOCK {1002578E53}> #<DATA-BLOCK {10025D39D3}> #<DATA-BLOCK {10025EE533}> #<DATA-BLOCK {10025FF2E3}> #<DATA-BLOCK {10026CD953}> #<DATA-BLOCK {1002833F93}> #<DATA-BLOCK {1002C488A3}> #<DATA-BLOCK {1002CF03C3}> #<DATA-BLOCK {1002CFD613}>) - 查看数据库当前的数据
加上初始块，一个11个数据：(all-blocks *data-blocks*)((INDEX 0 PREVIOUS-HASH NIL DATA NIL TIMESTAMP 3726808946 NONCE 0 HASH #1="ce215d7a6553a3239a95f37f5f3c2c5c091dc5f6de47538fea1a75ef6e40be44") (INDEX 1 PREVIOUS-HASH #1# DATA NIL TIMESTAMP 3726808971 NONCE 73893 HASH #2="0000590e0c8775d75d68eb001eea7c56f2c2d0b4bd95e1673f885c6d4919f49b") (INDEX 2 PREVIOUS-HASH #2# DATA NIL TIMESTAMP 3726808974 NONCE 114263 HASH #3="0000eb59241be0f79c403510b2a9c4b5950fb08b5c87d53839279d3be43bd06d") (INDEX 3 PREVIOUS-HASH #3# DATA NIL TIMESTAMP 3726808975 NONCE 57796 HASH #4="0000563cd56bcd96cad959ca71898207109ac20f6bac6d6382467a3af27ed601") (INDEX 4 PREVIOUS-HASH #4# DATA NIL TIMESTAMP 3726808977 NONCE 61293 HASH #5="0000660a90a9db8b696872721d86350448d83e4f9de37e6f4f785869078a7304") (INDEX 5 PREVIOUS-HASH #5# DATA NIL TIMESTAMP 3726808978 NONCE 29095 HASH #6="000022b033ba3b4a0eec38325402aa62839e68900b9bf711ebc2f4b3bf0d5fde") (INDEX 6 PREVIOUS-HASH #6# DATA NIL TIMESTAMP 3726808981 NONCE 144460 HASH #7="0000a0d8ca99940f51be182998bc6361bd06a1d12b05bcafa536209d44b2a38e") (INDEX 7 PREVIOUS-HASH #7# DATA NIL TIMESTAMP 3726808983 NONCE 78953 HASH #8="00004e4e3a8dcca8ac30a172e7a0992fe8670fd5d6a7f9f6f492ad6d5dd6ab6f") (INDEX 8 PREVIOUS-HASH #8# DATA NIL TIMESTAMP 3726808986 NONCE 114814 HASH #9="000006758ce31904d75a86afd8e30b202d981e3864d2d3927c04a4d3eecaa96e") (INDEX 9 PREVIOUS-HASH #9# DATA NIL TIMESTAMP 3726808988 NONCE 77439 HASH #10="000093396d15a35b32e64d84b614636b228c2b79f3cb07d0661a8fcd4d82142a") (INDEX 10 PREVIOUS-HASH #10# DATA NIL TIMESTAMP 3726808988 NONCE 33390 HASH "000002321f992fd65a8eb91446442088e750359ccee86fe620c8bb1a9567dee3"))
验证某个数据块是否是数据库里的数据块
(defun valid-data-block-p (data-blocks data-block difficulty)
(let ((index (data-block-index data-block))
(length (length data-blocks))
(hash (string-to-hex-string
(apply #'objects-to-string
(subseq (class-object-values data-block)
0
(1- (length (class-object-values data-block)))))))
(data-block-hash (data-block-hash data-block))
(data-block-previous-hash (data-block-previous-hash data-block)))
(labels ((equal-previous-data-block-hash-p (data-blocks index)
(equal data-block-previous-hash
(data-block-hash
(aref data-blocks
(1- index)))))
(equal-next-data-block-hash-p (data-blocks index)
(equal data-block-hash
(data-block-previous-hash
(aref data-blocks
(1+ index))))))
(and (hash-value-verification difficulty hash)
(equal data-block-hash hash)
(cond ((or (= length 1)
(= index 0))
(equal data-block-hash
(data-block-hash
(aref data-blocks 0))))
((< (1+ index)
length)
(and (equal-previous-data-block-hash-p data-blocks index)
(equal-next-data-block-hash-p data-blocks index)))
((= (1+ index)
length)
(equal-previous-data-block-hash-p data-blocks index)))))))
自证：
(valid-data-block-p *data-blocks*
(aref *data-blocks* 1)
1)
T
他证：
(let ((data-blocks (make-array 1 :fill-pointer 0))
(index 0)
(previous-hash nil)
(data nil)
(timestamp (get-universal-time))
(nonce 0))
(insert data-blocks :index index
:previous-hash previous-hash
:data data
:timestamp timestamp
:nonce nonce)
(valid-data-block-p *data-blocks*
(aref data-blocks 0)
0))
NIL
数据库保存与恢复
(defun store (data-blocks filespec)
(cl-store:store data-blocks filespec))
(defun restore (filespec)
(setf *data-blocks*
(cl-store:restore filespec)))
问题
(progn
(ql:quickload :sundawning.block-chain)
(in-package :sundawning.block-chain))
(let ((*difficulty* 4))
(loop
:repeat 10
:collect (mine-block)))
The value
NIL
is not of type
VECTOR
[Condition of type TYPE-ERROR]
Restarts:
0: [RETRY] Retry SLIME REPL evaluation request.
1: [*ABORT] Return to SLIME's top level.
2: [ABORT] abort thread (#<THREAD repl-thread RUNNING 1004B58403>)
Backtrace:
0: (PREVIOUS-HASH NIL 0)
Locals:
DATA-BLOCKS = NIL
INDEX = 0
1: (PROOF-OF-WORK 4 NIL NIL)
Locals:
DATA = NIL
DATA-BLOCKS = NIL
DIFFICULTY = 4
问题显示＂data-blocks＂是空值，说明数据库没有数据。解决办法是当发现数据库为空时，创建初始化数据块：
(defun mine-block (&optional data)
(unless *data-blocks*
(activate-initial-block data))
(proof-of-work *difficulty* *data-blocks* data))
Footnotes
[1]: GitHub - daxeel/blockshell: Minimal Blockchain Learning CLI:
https://github.com/daxeel/blockshell
Leave 用Common Lisp实现＂Blockshell＂ to:
Best Posts From SunDawning
We have not curated any of sundawning's posts yet. But you can encourage our curation team to review posts by visiting them regularly and by referring other readers. Because we give priority to frequently read content.
More Posts From SunDawning
- javascript - Draw a circle (not shaded) with Three.js - Stack Overflow
- GitHub 上这几个沙雕项目，够我玩几天 - 推酷
- 我们真的需要 144Hz 甚至 240Hz 屏幕的手机吗？ - 推酷
- 安卓单机游戏_游戏狗
- GitHub Actions 教程：定时发送天气邮件 - 推酷
- 视频网站VIP超前点播服务被批，角度不同，差异很大 - 推酷
- 腾讯硬核干货！如何在页面极速渲染3D模型？ - 推酷
- 代写服务5元起步 毕业生包装简历后面跟着多少坑？ - 推酷
- 南昌近期屡现网络兼职陷阱 -网络,兼职-大江网
- 离精简版Win7远点 - Windows7之家，Win7之家