Initial peer-to-peer implementation, with an example run script

README.md

@@ -12,13 +12,15 @@ Some readings related to the project:
 Project structure:
 - `main.rkt` contains an example code which uses the other files.
 - `main-helper.rkt` contains printing and other helper procedures for `main.rkt`.
+- `main-p2p.rkt` contains an example code which uses the other files, plus peer-to-peer support.
 - `src/` contains all the files for the actual implementation:
   - `blockchain.rkt` contains the implementation of the blockchain.
   - `block.rkt` contains the implementation of a block.
   - `wallet.rkt` contains the implementation of a wallet.
   - `transaction.rkt` contains the implementation of transactions.
   - `transaction-io.rkt` contains the implementation for input and output transactions.
   - `utils.rkt` contains some generally useful procedures.
+  - `peer-to-peer.rkt` contains procedures for syncing blockchains between peers, syncing valid peers, etc.
 
 Note that this is just an example cryptocurrency implementation in Scheme and is not intended to be run in production.
 
@@ -74,6 +76,43 @@ Data:	...58d498c68aefe93a... sends ...896a71a68be970f6... an amount of 100.
 Exported blockchain to 'blockchain.data'...
 ```
 
+Peer to peer example:
+1. Run the first peer by doing `racket main-p2p.rkt test.data 7000 127.0.0.1:7001,127.0.0.1:7002`, and wait a few seconds so that it can populate the DB.
+Now close the peer. You should get similar output to:
+```
+boro@bor0:~$ racket main-p2p.rkt test.data 7000 127.0.0.1:7001,127.0.0.1:7002
+Making genesis transaction...
+Mining genesis block...
+Mined a block!
+Mined a block!
+Exported blockchain to 'test.data'...
+Peer Test peer reports 2 valid peers.
+Mined a block!
+```
+2. Run the second peer by doing `racket main-p2p.rkt test-2.data 7001 127.0.0.1:7000`, and wait a few seconds so that it can populate the DB. Should get similar output to above.
+3. Now re-run the first peer, while keeping the second peer active. After a few mins, you should get:
+```
+Blockchain updated for peer Test peer
+Mined a block!
+Mined a block!
+Exported blockchain to 'test.data'...
+```
+Depending on which of the peers has a bigger effort on the blockchain, both files should match it.
+
+To double check, we compare the DB before:
+```
+boro@bor0:~/misc/sources/scheme-coin$ ls -al test*.data
+-rw-r--r--  1 boro  staff  5232 Jul 13 01:41 test-2.data
+-rw-r--r--  1 boro  staff  3849 Jul 13 01:41 test.data
+```
+
+And after the peers have synced:
+```
+boro@bor0:~/misc/sources/scheme-coin$ ls -al test*.data
+-rw-r--r--  1 boro  staff  5232 Jul 13 01:41 test-2.data
+-rw-r--r--  1 boro  staff  5232 Jul 13 01:41 test.data
+```
+
 Boro Sitnikovski
 
 Licensed under GPL.  Read LICENSE for more information.

main-helper.rkt

@@ -1,6 +1,7 @@
 #lang racket
 (require "./src/blockchain.rkt")
 (require "./src/utils.rkt")
+(require "./src/peer-to-peer.rkt")
 
 (require (only-in sha bytes->hex-string))
 
@@ -30,4 +31,5 @@
 
 (provide (all-from-out "./src/blockchain.rkt")
          (all-from-out "./src/utils.rkt")
+         (all-from-out "./src/peer-to-peer.rkt")
          format-transaction print-block print-blockchain print-wallets)

main-p2p.rkt

@@ -0,0 +1,72 @@
+#lang racket
+(require "./main-helper.rkt")
+
+; Convert a string of type ip:port to peer-info structure
+(define (string-to-peer-info s)
+  (let ([s (string-split s ":")])
+    (peer-info (car s) (string->number (cadr s)))))
+
+; Create a new wallet for us to use
+(define wallet-a (make-wallet))
+
+; Creation of new blockchain
+(define (initialize-new-blockchain)
+  (begin
+    ; Initialize wallets
+    (define scheme-coin-base (make-wallet))
+
+    ; Transactions
+    (printf "Making genesis transaction...\n")
+    (define genesis-t (make-transaction scheme-coin-base wallet-a 100 '()))
+
+    ; Unspent transactions (store our genesis transaction)
+    (define utxo (list
+                  (make-transaction-io 100 wallet-a)))
+
+    ; Blockchain initiation
+    (printf "Mining genesis block...\n")
+    (define b (init-blockchain genesis-t "1337cafe" utxo))
+    b))
+
+(define args (vector->list (current-command-line-arguments)))
+
+(when (not (= 3 (length args)))
+  (begin
+    (printf "Usage: racket main-p2p.rkt dbfile.data port ip1:port1,ip2:port2,...\n")
+    (exit)))
+
+; Get args data
+(define db-filename (car args))
+(define port (string->number (cadr args)))
+(define valid-peers (map string-to-peer-info (string-split (caddr args) ",")))
+
+; Try to read the blockchain from a file (DB), otherwise create a new one
+(define b
+  (if (file-exists? db-filename)
+      (file->struct db-filename)
+      (initialize-new-blockchain)))
+
+(define peer-context (peer-context-data "Test peer" port (list->set valid-peers) '() b))
+(define (get-blockchain) (peer-context-data-blockchain peer-context))
+
+(run-peer peer-context)
+
+; Keep exporting the database to have up-to-date info whenever a user quits the app.
+(define (export-loop)
+  (begin
+    (sleep 10)
+    (struct->file (get-blockchain) db-filename)
+    (printf "Exported blockchain to '~a'...\n" db-filename)
+    (export-loop)))
+
+(thread export-loop)
+
+; Procedure to keep mining empty blocks, as the p2p runs in threaded mode.
+(define (mine-loop)
+  (let ([newer-blockchain (send-money-blockchain (get-blockchain) wallet-a wallet-a 1)]) ; This blockchain includes a new block
+    (set-peer-context-data-blockchain! peer-context newer-blockchain)
+    (displayln "Mined a block!")
+    (sleep 5)
+    (mine-loop)))
+
+(mine-loop)

src/peer-to-peer.rkt

@@ -0,0 +1,165 @@
+#lang racket
+(require "blockchain.rkt")
+(require "block.rkt")
+(require racket/serialize)
+
+; Peer info structure contains an ip and a port
+(struct peer-info (ip port) #:prefab)
+
+; Peer info IO structure additionally contains IO ports
+(struct peer-info-io (pi input-port output-port) #:prefab)
+
+; Peer context data contains all information needed for a single peer.
+(struct peer-context-data (name ; Name of this peer
+                           port ; Port number to use
+                           [valid-peers #:mutable] ; List of valid peers (will be updated depending on info retrieved from connected peers)
+                           [connected-peers #:mutable] ; List of connected peers (will be a (not necessarily strict) subset of valid-peers)
+                           [blockchain #:mutable]) ; Blockchain will be updated from data with other peers
+  #:prefab)
+
+; Method for getting the sum of nonces of a blockchain.
+; Highest one has most effort and will win to get updated throughout the peers.
+(define (get-blockchain-effort b)
+  (foldl + 0 (map block-nonce (blockchain-blocks b))))
+
+; Handler for updating latest blockchain
+(define (maybe-update-blockchain peer-context line)
+  (let ([current-blockchain (deserialize (read (open-input-string (string-replace line #rx"(latest-blockchain:|[\r\n]+)" ""))))]
+        [latest-blockchain (peer-context-data-blockchain peer-context)])
+    (when (and (valid-blockchain? current-blockchain)
+               (> (get-blockchain-effort current-blockchain) (get-blockchain-effort latest-blockchain)))
+      (printf "Blockchain updated for peer ~a\n" (peer-context-data-name peer-context))
+      (set-peer-context-data-blockchain! peer-context current-blockchain))))
+
+; Handler for updating valid peers
+(define (maybe-update-valid-peers peer-context line)
+  (let ([valid-peers (list->set
+                      (deserialize (read (open-input-string (string-replace line #rx"(valid-peers:|[\r\n]+)" "")))))]
+        [current-valid-peers (peer-context-data-valid-peers peer-context)])
+    (set-peer-context-data-valid-peers! peer-context (set-union current-valid-peers valid-peers))))
+
+#| Generic handlers for both client and server |#
+; Handler
+(define (handler peer-context in out)
+  (flush-output out)
+  (define line (read-line in))
+  (when (string? line) ; it can be eof
+    (cond [(string-prefix? line "get-valid-peers")
+           (begin (display "valid-peers:" out)
+                  (displayln (serialize (set->list (peer-context-data-valid-peers peer-context))) out)
+                  (handler peer-context in out))]
+          [(string-prefix? line "get-latest-blockchain")
+           (begin (display "latest-blockchain:" out) (write (serialize (peer-context-data-blockchain peer-context)) out)
+                  (handler peer-context in out))]
+          [(string-prefix? line "latest-blockchain:")
+           (begin (maybe-update-blockchain peer-context line) (handler peer-context in out))]
+          [(string-prefix? line "valid-peers:")
+           (begin (maybe-update-valid-peers peer-context line) (handler peer-context in out))]
+          [(string-prefix? line "exit")
+           (displayln "bye" out)]
+          [else (handler peer-context in out)])))
+
+; Helper to launch handler thread
+(define (launch-handler-thread handler peer-context in out cb)
+  (define-values (local-ip remote-ip) (tcp-addresses in))
+  (define current-peer (peer-info remote-ip (peer-context-data-port peer-context)))
+  (define current-peer-io (peer-info-io current-peer in out))
+  (thread
+   (lambda ()
+     (handler peer-context in out)
+     (cb)
+     (close-input-port in)
+     (close-output-port out))))
+
+; Ping all peers in attempt to sync blockchains and update list of valid peers
+(define (peers peer-context)
+  (define (loop)
+    (sleep 10)
+    (for [(p (peer-context-data-connected-peers peer-context))]
+      (let ([in (peer-info-io-input-port p)]
+            [out (peer-info-io-output-port p)])
+        (displayln "get-latest-blockchain" out)
+        (displayln "get-valid-peers" out)
+        (flush-output out)))
+    (printf "Peer ~a reports ~a valid peers.\n"
+            (peer-context-data-name peer-context)
+            (set-count (peer-context-data-valid-peers peer-context)))
+    (loop))
+  (define t (thread loop))
+  (lambda ()
+    (kill-thread t)))
+#| Generic handlers for both client and server |#
+
+#| Generic procedures for server |#
+; Accept of a new connection
+(define (accept-and-handle listener handler peer-context)
+  (define-values (in out) (tcp-accept listener))
+  (launch-handler-thread handler peer-context in out void))
+
+; Server listener
+(define (serve peer-context)
+  (define main-cust (make-custodian))
+  (parameterize ([current-custodian main-cust])
+    (define listener (tcp-listen (peer-context-data-port peer-context) 5 #t))
+    (define (loop)
+      (accept-and-handle listener handler peer-context)
+      (loop))
+    (thread loop))
+  (lambda ()
+    (custodian-shutdown-all main-cust)))
+#| Generic procedures for server |#
+
+#| Generic procedures for client |#
+; Make sure we're connected with all known peers
+(define (connections-loop peer-context)
+  (define conns-cust (make-custodian))
+  (parameterize ([current-custodian conns-cust])
+    (define (loop)
+      (letrec ([current-connected-peers (list->set (map peer-info-io-pi (peer-context-data-connected-peers peer-context)))]
+               [all-valid-peers (peer-context-data-valid-peers peer-context)]
+               [potential-peers (set-subtract all-valid-peers current-connected-peers)])
+        (for ([peer potential-peers])
+          (thread (lambda ()
+                    (with-handlers
+                        ([exn:fail?
+                          (lambda (x)
+                            ;(printf "Cannot connect to ~a:~a\n" (peer-info-ip peer) (peer-info-port peer))
+                            #t)])
+                      (begin
+                        ;(printf "Trying to connect to ~a:~a...\n" (peer-info-ip peer) (peer-info-port peer))
+                        (define-values (in out) (tcp-connect (peer-info-ip peer) (peer-info-port peer)))
+                        (printf "'~a' connected to ~a:~a!\n" (peer-context-data-name peer-context) (peer-info-ip peer) (peer-info-port peer))
+                        (define current-peer-io (peer-info-io peer in out))
+                        ; Add current peer to list of connected peers
+                        (set-peer-context-data-connected-peers! peer-context (cons current-peer-io (peer-context-data-connected-peers peer-context)))
+                        (launch-handler-thread handler
+                                               peer-context
+                                               in
+                                               out
+                                               (lambda ()
+                                                 ; Remove peer from list of connected peers
+                                                 (set-peer-context-data-connected-peers! peer-context
+                                                                                         (set-remove
+                                                                                          (peer-context-data-connected-peers peer-context)
+                                                                                          current-peer-io)))))))))
+        (sleep 10)
+        (loop)))
+    (thread loop))
+  (lambda ()
+    (custodian-shutdown-all conns-cust)))
+#| Generic procedures for client |#
+
+; Helper method for running a peer-to-peer connection.
+(define (run-peer peer-context)
+  (let ([stop-listener (serve peer-context)]
+        [stop-peers-loop (peers peer-context)]
+        [stop-connections-loop (connections-loop peer-context)])
+    (lambda ()
+      (begin
+        (stop-connections-loop)
+        (stop-peers-loop)
+        (stop-listener)))))
+
+(provide (struct-out peer-context-data)
+         (struct-out peer-info)
+         run-peer)