自从阅读了 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 <[email protected]> All rights reserved.")
            :timestamp timestamp
            :nonce nonce)))

(activate-initial-block (make-array 1 :fill-pointer 0)
                        nil)

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

计算数据块是否符合要求

哈希值验证

(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

前一个数据块

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

查看数据库当前的数据

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

他证：

(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

用Common Lisp实现＂Blockshell＂ | Ecency