M secret-sharing/bulletin.rkt => secret-sharing/bulletin.rkt +31 -4
@@ 10,6 10,7 @@
(define voters (mutable-set))
(define _status 'registering)
(define _outputs (make-hash))
+ (define _sums (make-hash))
(define (candidates request)
(define candidates '("Emacs" "Vim" "VSCode"))
@@ 50,8 51,9 @@
(symbol->string p)
(λ (l) (cons v l)) empty)))
; has everyone submitted their outputs?
- (when (eq? (length (hash-keys _outputs))
- (set-count voters))
+ (when (for/and ([(p v) (in-hash _outputs)])
+ (eq? (length v)
+ (set-count voters)))
(set! _status 'summing))
(response/jsexpr empty))
(response/jsexpr
@@ 59,7 61,7 @@
#:code 403
#:message #"This election is not in the voting phase")))
- (define (values request)
+ (define (_values request)
(if (eq? _status 'summing)
(let ([input (hash-ref (bytes->jsexpr (request-post-data/raw request)) 'input)])
(response/jsexpr
@@ 69,6 71,29 @@
#:code 403
#:message #"This election is not in the summing phase")))
+ (define (sum request)
+ (if (eq? _status 'summing)
+ (let* ([params (bytes->jsexpr (request-post-data/raw request))]
+ [input (string->symbol (hash-ref params 'input))]
+ [sum (hash-ref params 'sum)])
+ (hash-set! _sums input sum)
+ (response/jsexpr
+ empty))
+ (response/jsexpr
+ empty
+ #:code 403
+ #:message #"This election is not in the summing phase")))
+
+ (define (sums request)
+ (if (eq? (length (hash-keys _sums))
+ (set-count voters))
+ (response/jsexpr
+ _sums)
+ (response/jsexpr
+ empty
+ #:code 403
+ #:message #"The sums are not yet available")))
+
(define-values (dispatcher url-generator)
(dispatch-rules
[("candidates") #:method "get" candidates]
@@ 76,7 101,9 @@
[("done") #:method "put" done ]
[("peers") #:method "get" peers ]
[("outputs") #:method "post" outputs ]
- [("values") #:method "post" values ]))
+ [("values") #:method "post" _values ]
+ [("sum") #:method "post" sum ]
+ [("sums") #:method "get" sums ]))
(define/contract (internal-server-error url ex)
(url? any/c . -> . can-be-response?)
M secret-sharing/client.rkt => secret-sharing/client.rkt +80 -50
@@ 1,5 1,7 @@
#lang racket/base
(require racket/port)
+(require racket/contract)
+(require racket/math)
(require readline/readline)
(require crypto)
@@ 23,45 25,48 @@
(for/sum ([i (in-range degree)])
(* (expt x (add1 i)) (vector-ref coefficients i)))))))
+(define/contract (natural->hex-string n)
+ (-> natural? string?)
+ (bytes->hex-string
+ (integer->bytes n (integer-bytes-length n #f) #f)))
+
+(define/contract (hex-string->natural hs)
+ (-> string? natural?)
+ (bytes->integer (hex-string->bytes hs) #f #t))
+
(module+ main
(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 peers
- (json-response-body
- (let loop ([wait 0])
- (sleep wait)
- (displayln "attempting to retrieve peers...")
- (with-handlers ([exn:fail:network:http:error? (λ (exn)
- (break-enabled #t)
- (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"))))
+ (displayln "registering...")
+ (post bulletin "/register"
+ #:data
+ (jsexpr->string (hasheq 'input (bytes->hex-string
+ (integer->bytes point num-bytes #f #t))
+ 'name username)))
+
+ (display "retrieving peers...")
+ (define peer-inputs
+ (map
+ hex-string->natural
+ (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"))))))
+ (newline)
+
+ (displayln "retrieving candidates...")
+ (define candidates (json-response-body (get bulletin "/candidates")))
(define vote
(let loop ()
@@ 72,34 77,59 @@
(loop))
n))))
- (define poly (random-poly (sub1 (length peers)) vote))
+ (define poly (random-poly (sub1 (length peer-inputs)) vote))
+ (displayln "submitting poly outputs...")
(post bulletin "/outputs"
#: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))))))))
+ (for/hasheq ([p (in-list peer-inputs)])
+ (values (string->symbol (natural->hex-string p))
+ (natural->hex-string (poly p))))))
+ (display "summing...")
(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
+ 'input
+ (natural->hex-string point)
+ 'sum
+ (natural->hex-string
+ (foldl + 0
+ (map
+ hex-string->natural
+ (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
- (hasheqv 'input
- (bytes->hex-string
- (integer->bytes point num-bytes #f #t))))))))))))
+ (hasheq 'input
+ (natural->hex-string point)))))))))))))
+ (newline)
+
+ (display "summing sums...")
+ (define sum
+ (foldl + 0
+ (map
+ hex-string->natural
+ (hash-values
+ (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"))))))))
+ (newline)
+ (displayln (format "sum: ~a" sum)))