~edwargix/tallyard

385d8f9b09d8ea25bacd7e87fc07860c5cf9919f — David Florness 5 years ago fd9c617
Rewrite client in Typed Racket
1 files changed, 92 insertions(+), 63 deletions(-)

M client.rkt
M client.rkt => client.rkt +92 -63
@@ 1,40 1,59 @@
#lang racket/base
#lang typed/racket
(require math/matrix)
(require racket/contract)
(require racket/list)
(require racket/math)
(require racket/port)

(require (only-in openssl/sha1 hex-string->bytes))
(require binaryio)
(require crypto)
(require json)
(require (only-in typed/openssl/sha1 bytes->hex-string hex-string->bytes))
(require net/http-client)
(require net/uri-codec)
(require readline/readline)
(require simple-http)

(define num-bytes (/ 1024 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)])
(require/typed readline/readline
  [readline (-> String String)])
(require/typed simple-http
  [#:struct requester
   ([host : String]
    [headers : Any]
    [port : Integer]
    [ssl : Boolean]
    [type : Symbol])]
  [update-host (-> requester String requester)]
  [update-port (-> requester Integer requester)]
  [json-requester requester]
  [#:struct json-response
   ([status : String]
    [headers : Any]
    [body : JSExpr])]
  [get (->* (requester String) (#:params (Listof Pair)) json-response)]
  [post (->* (requester String) (#:data Any #:params (Listof Pair)) json-response)]
  [#:struct (exn:fail:network:http:error exn:fail:network) ([code : Any] [type : Any])])
(require/typed crypto
  [crypto-random-bytes (Natural -> Bytes)])

(define num-bytes (assert (/ 1024 8) natural?))

(define (gen)
  (let* ([bstr (crypto-random-bytes num-bytes)])
    (bytes->integer bstr #f #t 0 num-bytes)))
    (cast (bytes->integer bstr #f #t 0 num-bytes) Natural)))

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

(define/contract (natural->hex-string n)
  (-> natural? string?)
(define (natural->hex-string [n : Natural])
  (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))
(define (hex-string->natural [hs : String])
  (cast (bytes->integer (hex-string->bytes hs) #f #t) Natural))

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


@@ 56,38 75,43 @@
  (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"))))))
     (cast
      (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"))))
      (Listof String))))
  (newline)

  (displayln "retrieving candidates...")
  (define candidates (json-response-body (get bulletin "/candidates")))

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

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

  (displayln "submitting poly outputs...")
  (void
   (post bulletin "/outputs"
         #:data
         (jsexpr->string
          (for/hasheq ([p (in-list peer-inputs)])
          (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)))))))



@@ 104,47 128,52 @@
            (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
                                (hasheq 'input
                                        (natural->hex-string point))))))))))))))
                    (cast
                     (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
                                 (hasheq 'input
                                         (natural->hex-string point)))))))
                     (Listof String)))))))))
  (newline)

  (display "finding constant...")
  (define constant
    (let ([k (length peer-inputs)]
          [sums (for/hash ([(k v)
                            (in-hash
                             (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")))))])
          [sums (for/hash : (Immutable-HashTable Natural Natural)
                    ([(k v)
                      (in-hash
                       (cast
                        (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"))))
                        (Immutable-HashTable Symbol String)))])
                  (values (hex-string->natural (symbol->string k))
                          (hex-string->natural v)))])
      (matrix-ref
       (matrix-solve
        ; M
        (for*/matrix k k ([x peer-inputs]
                          [p (range k)])
                          [p (range k)]) : Number
                     (expt x p))
        ; B
        (for*/matrix k 1 ([x peer-inputs])
        (for*/matrix k 1 ([x peer-inputs]) : Number
                     (hash-ref sums x)))
       0 0)))
  (newline)