;;; blockchain.scm

(import :std/crypto
        :std/text/hex)

(define-syntax for
  (syntax-rules ()
    ((for var to body)
     (let loop ((var 0))
       (if (< var to)
           (begin body (loop (+ var 1))))))))

(define (char-is-zero? string index)
  (if (eq? #\0 (string-ref string index)) #t #f))

;; start counting from the n'th position should fail faster most of the time
(define (n-chars-are-zero? string n)
  (let loop ((i (- n 1)))
    (if (>= i 0)
        (if (equal? (string-ref string i) #\0)
            (loop (- i 1))
            #f)
        #t)))

;; our blocks are just vectors of length 3
(define-structure block
  number
  data
  nonce
  prevhash)

;; required for block hashes to be identical between restarts
(define (block-to-string block)
  (let ((o (open-output-string)))
    (write (block-number block) o)
    (write (block-data block) o)
    (write (block-nonce block) o)
    (write (block-prevhash block) o)
    (get-output-string o)))

(define (hash-block block)
  (hex-encode (md5 (block-to-string block))))

;; zeroth (genesis) block is pre-defined
(define zeroth-block (make-block
                      0
                      ":)"
                      70924
                      "00000000000000000000000000000000"))

;; Block found!
;; #<block #2 number: 0 data: ":)" nonce: 70924 prevhash: "00000000000000000000000000000000">
;; 00002983b797351053bd7a2fd1f9da8f

(define leading-zeros 4) ; 4 leading zeros of md5 hash

(define blockchain (list zeroth-block))

(define blockchain-height ; there is only 1 blockchain
  (block-number (car blockchain)))

(define (new-block data)
  (make-block
   (+ 1 blockchain-height)
   data
   0
   (hash-block (car blockchain))))

(define (add-block-to-chain block)
  (if (and (equal? (hash-block (car blockchain)) (= (block-number block) (+ 1 (block-number (car blockchain))))))
      (block-prevhash block)
      (set! blockchain (cons block blockchain))))

(define (u8vector->string v)
  (list->string (map integer->char (u8vector->list v))))

(define (mine-block block)
  (let loop ((i 0) (block-hash (hash-block block)))
    (if (n-chars-are-zero? block-hash leading-zeros)
        (begin
          (print "\nBlock found!\n")
          (print block "\n")
          (print (hash-block block) "\n")
          (add-block-to-chain block))
        (begin
          (block-nonce-set! block (+ (block-nonce block) 1))
          (loop (+ i 1) (hash-block block))))))

;; > (mine-block (new-block "test"))
;; Block found!
;; #<block #7 number: 1 data: "test" nonce: 11650 prevhash: "00002983b797351053bd7a2fd1f9da8f">
;; 0000728a8b7f72ce14279cddca5972d1