From a445c52d0d785af97b68510ed70c9386e2dfb7f7 Mon Sep 17 00:00:00 2001
From: David Florness <david@florness.com>
Date: Mon, 20 Jan 2020 13:52:34 -0700
Subject: [PATCH] Bulletin and client for secret-sharing voting thus far

---
 secret-sharing/bulletin.rkt |  73 ++++++++++++++++++
 secret-sharing/client.rkt   | 143 ++++++++++++++++++++++++++++++++++++
 2 files changed, 216 insertions(+)
 create mode 100644 secret-sharing/bulletin.rkt
 create mode 100644 secret-sharing/client.rkt

diff --git a/secret-sharing/bulletin.rkt b/secret-sharing/bulletin.rkt
new file mode 100644
index 0000000..75dac1f
--- /dev/null
+++ b/secret-sharing/bulletin.rkt
@@ -0,0 +1,73 @@
+#lang racket/base
+(require racket/contract
+         racket/list)
+(require web-server/servlet
+         web-server/servlet-env
+         json)
+
+(define voters (list))
+(define _status 'registering)
+(define _outputs (make-hasheqv))
+
+(define (candidates request)
+  (define candidates '("Emacs" "Vim" "VSCode"))
+  (if (eq? _status 'voting)
+      (response/jsexpr candidates)
+      (response/jsexpr
+       empty
+       #:code 403
+       #:message #"Voting has not begun")))
+
+(define (register request)
+  (define params (bytes->jsexpr (request-post-data/raw request)))
+  (displayln params)
+  (set! voters (cons (hasheq 'name (hash-ref params 'name)
+                             'input (hash-ref params 'input))
+                     voters))
+  (response/jsexpr empty))
+
+(define (done request)
+  (set! _status 'voting)
+  (response/jsexpr (symbol->string _status)))
+
+(define (peers request)
+  (if (eq? _status 'voting)
+      (response/jsexpr (for/list ([v (in-list voters)])
+                         (hash-ref v 'input)))
+      (response/jsexpr
+       empty
+       #:code 403
+       #:message #"Voting has not begun")))
+
+(define (outputs request)
+  (if (eq? _status 'voting)
+      (begin
+        (let ([params (bytes->jsexpr (request-post-data/raw request))])
+          (for ([p (in-hash-keys params)])
+            (hash-update! _outputs p (λ (l) (cons (hash-ref params p) l)) empty)))
+        (response/jsexpr empty))
+      (response/jsexpr
+       empty
+       #:code 403
+       #:message #"Voting has not begun")
+      ))
+
+(define-values (dispatcher url-generator)
+  (dispatch-rules
+   [("candidates") candidates]
+   [("register") #:method "post" register]
+   [("done") #:method "put" done]
+   [("peers") peers]
+   [("outputs") #:method "post" outputs]))
+
+(define/contract (internal-server-error url ex)
+  (url? any/c . -> . can-be-response?)
+  (response/full 400 #"Bad Request" (current-seconds) #f empty empty))
+
+(serve/servlet
+ dispatcher
+ #:port 1984
+ #:servlet-regexp #rx""
+ #:command-line? #t
+ ;; #:servlet-responder internal-server-error
+ )
diff --git a/secret-sharing/client.rkt b/secret-sharing/client.rkt
new file mode 100644
index 0000000..ee186f4
--- /dev/null
+++ b/secret-sharing/client.rkt
@@ -0,0 +1,143 @@
+#lang racket/base
+(require racket/port)
+
+(require readline/readline)
+(require crypto)
+(require net/http-client)
+(require net/uri-codec)
+(require json)
+(require binaryio)
+(require simple-http)
+(require (only-in openssl/sha1 hex-string->bytes))
+
+(define num-bytes (/ 1024 8))
+
+(define (gen)
+  (let* ([bstr (crypto-random-bytes num-bytes)])
+    ;; (displayln (format "bstr: ~a" (bytes->hex-string bstr)))
+    ;; (displayln (format "binaryio: ~a" (bytes->integer bstr #f #t)))
+    ;; (for/sum ([i (in-range 0 num-bytes 8)])
+    ;;   (arithmetic-shift
+    ;;    (integer-bytes->integer bstr #f #t i (+ i 8))
+    ;;    (- 1024 64 (* i 8))))
+    (bytes->integer bstr #f #t 0 num-bytes)))
+
+(define (random-poly degree constant)
+  (let ([coefficients (for/vector #:length degree ([_ (in-range degree)])
+                        (gen))])
+    (lambda (x)
+      (+ constant
+         (for/sum ([i (in-range degree)])
+           (* (expt x (add1 i)) (vector-ref coefficients i)))))))
+
+(define username (readline "Your name: "))
+
+(define point (gen))
+(displayln (format "point: ~a" point))
+
+(define bulletin
+  (update-port (update-host json-requester "localhost") 1984))
+
+(with-handlers ([exn:fail:network? (λ (exn)
+                                     (begin
+                                       (displayln "Err: cannot connect to bulletin")
+                                       (exit)))])
+  (displayln "attempting to register...")
+  (post bulletin "/register"
+        #:data
+        (jsexpr->string (hasheq 'input (bytes->hex-string
+                                        (integer->bytes point num-bytes #f #t))
+                                'name username))))
+
+;; (define-values (status headers port))
+;; (http-sendrecv
+;;  "localhost"
+;;  "/register"
+;;  #:port 1984
+;;  #:method "POST"
+;;  #:data
+;;  (jsexpr->bytes (hasheq 'input (bytes->hex-string
+;;                                 (integer->bytes point num-bytes #f #t))
+;;                         'name username))
+;;  ;; #:headers (list "Content-Type: application/x-www-form-urlencoded")
+;;  )
+
+;; (let-values)
+;; (define-values (status headers port)
+;;   (with-handlers ([exn:fail:network? (lambda (exn)
+;;                                        (begin
+;;                                          (displayln "Err: lost connection to bulletin")
+;;                                          (exit)))])
+;;     (let loop ([wait 0])
+;;       (displayln "attempting to retrieve peers")
+;;       (sleep wait)
+;;       (let-values ([(status headers port)
+;;                     (http-sendrecv
+;;                      "localhost"
+;;                      "/peers"
+;;                      #:port 1984)])
+;;         (if (eq? status 200)
+;;             (values status headers port)
+;;             (loop 3))))))
+
+(define peers
+  (json-response-body
+   (let loop ([wait 0])
+     (sleep wait)
+     (displayln "attempting to retrieve peers...")
+     (with-handlers ([exn:fail:network:http:error? (λ (exn)
+                                                     ;; (displayln exn)
+                                                     (loop 3))])
+       (get bulletin "/peers")))))
+
+(displayln (format "peers: ~a" peers))
+(displayln (string? (car peers)))
+
+(define candidates
+  (json-response-body
+   (with-handlers ([exn:fail:network:errno? (λ ()
+                                              (displayln "Lost connection to bulletin!")
+                                              (exit))])
+     (get bulletin "/candidates"))))
+
+(define vote
+  (let loop ()
+    (let [(n (string->number (readline "Vote: ")))]
+      (if (eq? n #f)
+          (begin
+            (displayln "Please enter a valid number")
+            (loop))
+          n))))
+
+(define poly (random-poly (length peers) vote))
+
+(post bulletin "/outputs"
+      (make-hasheqv
+       (for/list ([p (in-list peers)])
+         (let ([output (poly (bytes->integer (hex-string->bytes p) #f #t))])
+           (cons p (bytes->hex-string
+                    (integer->bytes
+                     output
+                     (add1 (integer-bytes-length output #f))
+                     #t)))))))
+
+;; (define peers
+;;   (let loop ([wait 0])
+;;     (sleep wait)
+;;     (let ([resp (get bulletin "/peers")])
+;;       (displayln "attempting to retrieve peers...")
+;;       (displayln (get-status-code resp))
+;;       ;; (if (eq? (get-status-code resp) 200)
+;;       ;;     (json-response-body resp)
+;;       ;;     (loop 3))
+;;       )))
+
+;; (displayln (format "peers: ~a" peers))
+
+;; (displayln status)
+;; (displayln headers)
+;; (displayln (port->string port #:close? #t))
+
+;; (http-sendrecv
+;;  "localhost"
+;;  "/peers")
-- 
2.38.4