A secret-sharing/bulletin.rkt => secret-sharing/bulletin.rkt +73 -0
@@ 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
+ )
A secret-sharing/client.rkt => secret-sharing/client.rkt +143 -0
@@ 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")