From 330064a8c0663c9d3acdb38bd123525f5d71e68b Mon Sep 17 00:00:00 2001
From: David Florness <david@florness.com>
Date: Mon, 3 Feb 2020 16:03:16 -0700
Subject: [PATCH] Route to get poly outputs from peers

---
 secret-sharing/bulletin.rkt | 49 +++++++++++++++++++++++++------------
 secret-sharing/client.rkt   | 38 +++++++++++++++++++++-------
 2 files changed, 62 insertions(+), 25 deletions(-)

diff --git a/secret-sharing/bulletin.rkt b/secret-sharing/bulletin.rkt
index 7dcb34a..b1260fd 100644
--- a/secret-sharing/bulletin.rkt
+++ b/secret-sharing/bulletin.rkt
@@ -1,14 +1,15 @@
 #lang racket/base
 (require racket/contract
-         racket/list)
+         racket/list
+         racket/set)
 (require web-server/servlet
          web-server/servlet-env
          json)
 
 (module+ main
-  (define voters (list))
+  (define voters (mutable-set))
   (define _status 'registering)
-  (define _outputs (make-hasheqv))
+  (define _outputs (make-hash))
 
   (define (candidates request)
     (define candidates '("Emacs" "Vim" "VSCode"))
@@ -22,9 +23,8 @@
   (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))
+    (set-add! voters (hasheq 'name  (hash-ref params 'name)
+                             'input (hash-ref params 'input)))
     (response/jsexpr empty))
 
   (define (done request)
@@ -33,7 +33,7 @@
 
   (define (peers request)
     (if (eq? _status 'voting)
-        (response/jsexpr (for/list ([v (in-list voters)])
+        (response/jsexpr (for/list ([v (in-set voters)])
                            (hash-ref v 'input)))
         (response/jsexpr
          empty
@@ -43,23 +43,40 @@
   (define (outputs request)
     (if (eq? _status 'voting)
         (begin
+          ; TODO: check validity of inputs
           (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)))
+            (for ([(p v) (in-hash params)])
+              (hash-update! _outputs
+                            (symbol->string p)
+                            (λ (l) (cons v l)) empty)))
+          ; has everyone submitted their outputs?
+          (when (eq? (length (hash-keys _outputs))
+                     (set-count voters))
+            (set! _status 'summing))
           (response/jsexpr empty))
         (response/jsexpr
          empty
          #:code 403
-         #:message #"Voting has not begun")
-        ))
+         #:message #"This election is not in the voting phase")))
+
+  (define (values request)
+    (if (eq? _status 'summing)
+        (let ([input (hash-ref (bytes->jsexpr (request-post-data/raw request)) 'input)])
+          (response/jsexpr
+           (hash-ref _outputs input)))
+        (response/jsexpr
+         empty
+         #:code 403
+         #:message #"This election is not in the summing phase")))
 
   (define-values (dispatcher url-generator)
     (dispatch-rules
-     [("candidates") candidates]
-     [("register") #:method "post" register]
-     [("done") #:method "put" done]
-     [("peers") peers]
-     [("outputs") #:method "post" outputs]))
+     [("candidates") #:method "get"  candidates]
+     [("register")   #:method "post" register  ]
+     [("done")       #:method "put"  done      ]
+     [("peers")      #:method "get"  peers     ]
+     [("outputs")    #:method "post" outputs   ]
+     [("values")     #:method "post" values    ]))
 
   (define/contract (internal-server-error url ex)
     (url? any/c . -> . can-be-response?)
diff --git a/secret-sharing/client.rkt b/secret-sharing/client.rkt
index 957c05c..0b2f38d 100644
--- a/secret-sharing/client.rkt
+++ b/secret-sharing/client.rkt
@@ -72,14 +72,34 @@
               (loop))
             n))))
 
-  (define poly (random-poly (length peers) vote))
+  (define poly (random-poly (sub1 (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))))))))
+        #:data
+        (jsexpr->string
+         (make-immutable-hasheq
+          (for/list ([p (in-list peers)])
+            (let ([output (poly (bytes->integer (hex-string->bytes p) #f #t))])
+              (cons (string->symbol p)
+                    (bytes->hex-string
+                     (integer->bytes
+                      output
+                      (add1 (integer-bytes-length output #f))
+                      #t))))))))
+
+  (post bulletin "/sum"
+        #:data
+        (jsexpr->string
+         (hasheq
+          'input point
+          'sum (foldl + 0
+                      (map
+                       (λ (v)
+                         (bytes->integer (hex-string->bytes v) #f #t))
+                       (json-response-body
+                        (post bulletin "/values"
+                              #:data
+                              (jsexpr->string
+                               (hasheqv 'input
+                                        (bytes->hex-string
+                                         (integer->bytes point num-bytes #f #t))))))))))))
-- 
2.38.4