~edwargix/tallyard

d5aff2cf4a760f8135c050c66af16f34f696bea5 — David Florness 5 years ago 7fa106c
Allow votes to be negative
2 files changed, 27 insertions(+), 28 deletions(-)

M client.rkt
M poly.rkt
M client.rkt => client.rkt +20 -20
@@ 10,8 10,8 @@
(require typed/json)
(require/typed binaryio
  [bytes->integer (->* (Bytes Boolean) (Boolean Natural Natural) Integer)]
  [integer->bytes (->* (Integer Natural Boolean) (Boolean Bytes Natural) Bytes)]
  [integer-bytes-length (Integer Boolean -> Natural)])
  [integer->bytes (->* (Integer Positive-Integer Boolean) (Boolean Bytes Natural) Bytes)]
  [integer-bytes-length (-> Integer Boolean Natural)])
(require/typed readline/readline
  [readline (-> String String)])
(require/typed simple-http


@@ 35,12 35,12 @@
  [crypto-random-bytes (Natural -> Bytes)])
(require "poly.rkt")

(define (natural->hex-string [n : Natural])
(define (integer->hex-string [n : Integer])
  (bytes->hex-string
   (integer->bytes n (integer-bytes-length n #f) #f)))
   (integer->bytes n (assert (integer-bytes-length n #t) positive?) #t)))

(define (hex-string->natural [hs : String])
  (cast (bytes->integer (hex-string->bytes hs) #f #t) Natural))
(define (hex-string->integer [hs : String])
  (bytes->integer (hex-string->bytes hs) #t))

(module+ main
  (define username (readline "Your name: "))


@@ 54,13 54,13 @@
  (void
   (post bulletin "/register"
         #:data
         (jsexpr->string (hasheq 'input (natural->hex-string point)
         (jsexpr->string (hasheq 'input (integer->hex-string point)
                                 'name username))))

  (display "retrieving peers...")
  (define peer-inputs
    (map
     hex-string->natural
     hex-string->integer
     (cast
      (json-response-body
       (let loop ([wait 0])


@@ 79,13 79,13 @@
  (define candidates (json-response-body (get bulletin "/candidates")))

  (define vote
    (let loop : Natural ()
    (let loop : Integer ()
      (let [(n (string->number (readline "Vote: ")))]
        (if (eq? n #f)
            (begin
              (displayln "Please enter a valid number")
              (loop))
            (assert n natural?)))))
            (assert n exact-integer?)))))

  (define poly (random-poly
                (cast (sub1 (length peer-inputs)) Natural)


@@ 97,9 97,9 @@
         #:data
         (jsexpr->string
          (for/hasheq : (Immutable-HashTable Symbol String)
              ([p : Natural (cast peer-inputs (Listof Natural))])
            (values (string->symbol (natural->hex-string p))
                    (natural->hex-string (poly p)))))))
              ([p : Integer (cast peer-inputs (Listof Integer))])
            (values (string->symbol (integer->hex-string p))
                    (integer->hex-string (poly p)))))))

  (display "summing...")
  (void


@@ 108,12 108,12 @@
         (jsexpr->string
          (hasheq
           'input
           (natural->hex-string point)
           (integer->hex-string point)
           'sum
           (natural->hex-string
           (integer->hex-string
            (foldl + 0
                   (map
                    hex-string->natural
                    hex-string->integer
                    (cast
                     (json-response-body
                      (let loop ([wait 0])


@@ 128,14 128,14 @@
                                #:data
                                (jsexpr->string
                                 (hasheq 'input
                                         (natural->hex-string point)))))))
                                         (integer->hex-string point)))))))
                     (Listof String)))))))))
  (newline)

  (display "finding constant...")
  (define constant
    (let ([k (length peer-inputs)]
          [sums (for/hash : (Immutable-HashTable Natural Natural)
          [sums (for/hash : (Immutable-HashTable Integer Integer)
                    ([(k v)
                      (in-hash
                       (cast


@@ 150,8 150,8 @@
                                              (loop 3))])
                             (get bulletin "/sums"))))
                        (Immutable-HashTable Symbol String)))])
                  (values (hex-string->natural (symbol->string k))
                          (hex-string->natural v)))])
                  (values (hex-string->integer (symbol->string k))
                          (hex-string->integer v)))])
      (matrix-ref
       (matrix-solve
        ; M

M poly.rkt => poly.rkt +7 -8
@@ 6,20 6,19 @@
(require/typed crypto
  [crypto-random-bytes (Natural -> Bytes)])

(define-type Poly (Natural -> Natural))

(define num-bytes (assert (/ 1024 8) natural?))
(define-type Poly (Integer -> Integer))

(define (gen)
  (let* ([bstr (crypto-random-bytes num-bytes)])
    (cast (bytes->integer bstr #f #t 0 num-bytes) Natural)))
  (let* ([num-bytes (assert (/ 1024 8) natural?)]
         [bstr (crypto-random-bytes num-bytes)])
    (bytes->integer bstr #t #t 0 num-bytes)))

(define (random-poly [degree : Natural] [constant : Natural]) : Poly
(define (random-poly [degree : Natural] [constant : Integer]) : Poly
  (let ([coefficients (build-vector degree (λ (_) (gen)))])
    (λ ([x : Natural]) : Natural
    (λ ([x : Integer]) : Integer
       (cast (+ constant
                (for/sum : Integer ([i degree])
                  (* (expt x (add1 i)) (vector-ref coefficients i))))
             Natural))))
             Integer))))

(provide (all-defined-out))