M bulletin.rkt => bulletin.rkt +47 -19
@@ 7,34 7,60 @@
json)
(module+ main
- (define voters (mutable-set))
(define _status 'registering)
+ (define _peers (mutable-set))
+ (define _commits (make-hash))
(define _outputs (make-hash))
(define _sums (make-hash))
(define (candidates request)
- (define candidates '("Emacs" "Vim" "VSCode"))
- (if (eq? _status 'voting)
- (response/jsexpr candidates)
+ (response/jsexpr '("Emacs" "Vim" "VSCode")))
+
+ (define (register request)
+ (if (eq? _status 'registering)
+ (let ([params (bytes->jsexpr (request-post-data/raw request))])
+ (displayln params)
+ (set-add! _peers (hasheq 'name (hash-ref params 'name)
+ 'input (hash-ref params 'input)))
+ (response/jsexpr empty))
(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-add! voters (hasheq 'name (hash-ref params 'name)
- 'input (hash-ref params 'input)))
- (response/jsexpr empty))
+ #:message #"You may not register")))
(define (done request)
- (set! _status 'voting)
+ (set! _status 'committing)
(response/jsexpr (symbol->string _status)))
+ (define (peer-count request)
+ (if (eq? _status 'committing)
+ (response/jsexpr (set-count _peers))
+ (response/jsexpr
+ empty
+ #:code 403
+ #:message #"Committing has not begun")))
+
+ (define (commit request)
+ (if (eq? _status 'committing)
+ (let ([params (bytes->jsexpr (request-post-data/raw request))])
+ (displayln params)
+ (hash-set! _commits (hash-ref params 'input)
+ (hasheq 'p (hash-ref params 'p))
+ ; TODO: D polynomial
+ ;; (hasheq 'd (hash-ref params 'd))
+ )
+ ; has everyone committed?
+ (when (eqv? (hash-count _commits)
+ (set-count _peers))
+ (set! _status 'voting))
+ (response/jsexpr empty))
+ (response/jsexpr empty
+ #:code 403
+ #:message #"Not in the committing phase")))
+
(define (peers request)
(if (eq? _status 'voting)
- (response/jsexpr (for/list ([v (in-set voters)])
+ (response/jsexpr (for/list ([v _peers])
(hash-ref v 'input)))
(response/jsexpr
empty
@@ 46,14 72,14 @@
(begin
; TODO: check validity of inputs
(let ([params (bytes->jsexpr (request-post-data/raw request))])
- (for ([(p v) (in-hash params)])
+ (for ([(p v) params])
(hash-update! _outputs
(symbol->string p)
(λ (l) (cons v l)) empty)))
; has everyone submitted their outputs?
- (when (for/and ([(p v) (in-hash _outputs)])
- (eq? (length v)
- (set-count voters)))
+ (when (for/and ([(p v) _outputs])
+ (eqv? (length v)
+ (set-count _peers)))
(set! _status 'summing))
(response/jsexpr empty))
(response/jsexpr
@@ 86,7 112,7 @@
(define (sums request)
(if (eq? (length (hash-keys _sums))
- (set-count voters))
+ (set-count _peers))
(response/jsexpr
_sums)
(response/jsexpr
@@ 99,6 125,8 @@
[("candidates") #:method "get" candidates]
[("register") #:method "post" register ]
[("done") #:method "put" done ]
+ [("peer-count") #:method "get" peer-count]
+ [("commit") #:method "post" commit ]
[("peers") #:method "get" peers ]
[("outputs") #:method "post" outputs ]
[("values") #:method "post" _values ]
M client.rkt => client.rkt +53 -46
@@ 34,10 34,12 @@
[#:struct (exn:fail:network:http:error exn:fail:network) ([code : Any] [type : Any])])
(require/typed crypto
[crypto-random-bytes (Natural -> Bytes)])
-(require "poly.rkt")
(require/typed sugar
[members-unique? (-> (Listof Any) Boolean)])
+(require "merkle.rkt")
+(require "poly.rkt")
+
(define (integer->hex-string [n : Integer])
(bytes->hex-string
(integer->bytes n (assert (integer-bytes-length n #t) positive?) #t)))
@@ 45,6 47,17 @@
(define (hex-string->integer [hs : String])
(bytes->integer (hex-string->bytes hs) #t))
+(define-syntax-rule (retry-request f)
+ (let loop ([wait 0])
+ (sleep wait)
+ (with-handlers ([exn:fail:network:http:error?
+ (λ (exn)
+ (break-enabled #t)
+ (display ".")
+ (flush-output)
+ (loop 3))])
+ f)))
+
(module+ main
(define username (readline "Your name: "))
@@ 60,30 73,17 @@
(jsexpr->string (hasheq 'input (integer->hex-string point)
'name username))))
- (display "retrieving peers...")
- (define peer-inputs
- (map
- hex-string->integer
- (cast
- (json-response-body
- (let loop ([wait 0])
- (sleep wait)
- (with-handlers ([exn:fail:network:http:error?
- (λ (exn)
- (break-enabled #t)
- (display ".")
- (flush-output)
- (loop 3))])
- (get bulletin "/peers"))))
- (Listof String))))
- (define peer-count (cast (length peer-inputs) Positive-Integer))
- (newline)
-
(displayln "retrieving candidates...")
(define candidates (cast (json-response-body
(get bulletin "/candidates")) (Listof String)))
(define cand-count (cast (length candidates) Positive-Integer))
+ (display "waiting for voting to commence...")
+ (define peer-count (cast
+ (json-response-body
+ (retry-request (get bulletin "/peer-count")))
+ Positive-Integer))
+
(displayln "Candidates:")
(for ([i (in-naturals)]
[c candidates])
@@ 135,9 135,32 @@
#t)))
#t))))))
+ (display "committing poly...")
(define poly (random-poly
- (cast (sub1 (length peer-inputs)) Natural)
+ (cast (sub1 peer-count) Natural)
vote))
+ (void
+ (post bulletin "/commit"
+ #:data
+ (jsexpr->string
+ (hasheq
+ 'input
+ (integer->hex-string point)
+ 'p
+ (bytes->hex-string
+ (merkle-node-hsh
+ (merkle-tree-root (poly-merkle poly))))))))
+ (newline)
+
+ (display "retrieving peers...")
+ (define peer-inputs
+ (assert (map hex-string->integer
+ (cast (json-response-body
+ (retry-request (get bulletin "/peers")))
+ (Listof String)))
+ (λ ([lst : (Listof Integer)])
+ (= (length lst) peer-count))))
+ (newline)
(displayln "submitting poly outputs...")
(void
@@ 162,22 185,14 @@
(foldl + 0
(map
hex-string->integer
- (cast
- (json-response-body
- (let loop ([wait 0])
- (sleep wait)
- (with-handlers ([exn:fail:network:http:error?
- (λ (exn)
- (break-enabled #t)
- (display ".")
- (flush-output)
- (loop 3))])
- (post bulletin "/values"
- #:data
- (jsexpr->string
- (hasheq 'input
- (integer->hex-string point)))))))
- (Listof String)))))))))
+ (cast (json-response-body
+ (retry-request
+ (post bulletin "/values"
+ #:data
+ (jsexpr->string
+ (hasheq 'input
+ (integer->hex-string point))))))
+ (Listof String)))))))))
(newline)
(display "finding constant...")
@@ 188,15 203,7 @@
(in-hash
(cast
(json-response-body
- (let loop ([wait 0])
- (sleep wait)
- (with-handlers ([exn:fail:network:http:error?
- (λ (exn)
- (break-enabled #t)
- (display ".")
- (flush-output)
- (loop 3))])
- (get bulletin "/sums"))))
+ (retry-request (get bulletin "/sums")))
(Immutable-HashTable Symbol String)))])
(values (hex-string->integer (symbol->string k))
(hex-string->integer v)))])