~edwargix/tallyard

330064a8c0663c9d3acdb38bd123525f5d71e68b — David Florness 5 years ago f52d3b8
Route to get poly outputs from peers
2 files changed, 62 insertions(+), 25 deletions(-)

M secret-sharing/bulletin.rkt
M secret-sharing/client.rkt
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))))))))))))