自从阅读了 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进制字符串

1. 先进行两次sha256编码
2. 再按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)

建立数据库

1. 以类和向量的方式构造数据库
   • 不需要更改数据库：一旦添加了数据，就不再需要更改
   • 不需要删除数据库：只要不用了数据库，弃用数据库、格式化数据库就行，不需要逐个地删除数据

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

2. 示例：使用数据库
   1. 创建数据库
   2. 添加数据
   3. 查看数据库里所添加的数据

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

计算数据块是否符合要求

1. 哈希值验证

   (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进制的内容里含有你给的英文字母？")))
   

   比如，看一个字符串是否以4个0开头：

   (hash-value-verification "^0{4}"
                            "d250ed4624d2282b5eaac8a501ea08560ca370b4cdac4897ab4a61b51e437b3d")
   

   NIL
   

2. 前一个数据块

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

3. 前一个数据块的哈希值
   • 从现有的数据块里取出前一个数据块的哈希值

   (defun previous-hash (data-blocks index)
     (data-block-hash
      (aref data-blocks
            (1- index))))
   

   (previous-hash *data-blocks* 1)
   

   "4aa489da52043ff43ea353934d4d09a0e4f39247d5361114aee098bb5bc47060"
   

4. 将符合要求的数据添加到数据库里

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

示例：一个完整的初始化、计算过程

1. 加载库

   (progn
     (ql:quickload :sundawning.block-chain)
     (in-package :sundawning.block-chain))
   

2. 开始计算

   (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}>)
   

3. 查看数据库当前的数据

   (all-blocks *data-blocks*)
   

   加上初始块，一个11个数据：

   ((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