M secret-sharing/bulletin.rkt => secret-sharing/bulletin.rkt +33 -16
@@ 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?)
M secret-sharing/client.rkt => secret-sharing/client.rkt +29 -9
@@ 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))))))))))))