2 files changed, 90 insertions(+), 23 deletions(-)

M bulletin.rkt
M client.rkt

@@ 1,21 1,55 @@
 #lang racket/base
 (require racket/contract
          racket/list
-         racket/set)
+         racket/match
+         racket/set
+         racket/string)
 (require web-server/servlet
          web-server/servlet-env
          json)
 (require simple-http)
+(require readline/readline)
 
-(module+ main
-  (define _status 'registering)
-  (define _peers (mutable-set))
-  (define _commits (make-hash))
-  (define _outputs (make-hash))
-  (define _sums (make-hash))
+(define state  'registering)
+(define _peers   (mutable-set))
+(define _commits (make-hash))
+(define _outputs (make-hash))
+(define _sums    (make-hash))
+
+(define (reset)
+  (set-clear! _peers)
+  (hash-clear! _commits)
+  (hash-clear! _outputs)
+  (hash-clear! _sums))
+
+(define election 'default)
+(define election->candidates
+  (make-hash '((default . ("Emacs" "Vim" "VSCode")))))
+
+(define/contract (election-set! sym)
+  (-> symbol? void?)
+  (set! election sym)
+  (when (not (hash-has-key? election->candidates
+                            election))
+    (hash-set! election->candidates election
+               (list))))
 
+(define transitions
+  (hasheq 'committing 'voting
+          'voting 'summing
+          'summing 'closed))
+
+(define (transition [trans #f])
+  (set! state (if trans trans (hash-ref transitions state))))
+
+(define (server)
   (define (candidates request)
-    (response/jsexpr '("Emacs" "Vim" "VSCode")))
+    (if (eq? state 'committing)
+        (response/jsexpr (hash-ref election->candidates election))
+        (response/jsexpr
+         empty
+         #:code 403
+         #:message #"The election is currently closed")))
 
   (define (auth username password)
     (equal? (hash-ref


@@ 31,7 65,7 @@
             "success"))
 
   (define (register request)
-    (if (eq? _status 'registering)
+    (if (eq? state 'registering)
         (let* ([params (bytes->jsexpr (request-post-data/raw request))]
                [username (hash-ref params 'username)]
                [password (hash-ref params 'password)]


@@ 50,12 84,8 @@
          #:code 403
          #:message #"You may not register")))
 
-  (define (done request)
-    (set! _status 'committing)
-    (response/jsexpr (symbol->string _status)))
-
   (define (peer-count request)
-    (if (eq? _status 'committing)
+    (if (eq? state 'committing)
         (response/jsexpr (set-count _peers))
         (response/jsexpr
          empty


@@ 63,7 93,7 @@
          #:message #"Committing has not begun")))
 
   (define (commit request)
-    (if (eq? _status 'committing)
+    (if (eq? state 'committing)
         (let ([params (bytes->jsexpr (request-post-data/raw request))])
           (displayln params)
           (hash-set! _commits (hash-ref params 'input)


@@ 74,14 104,14 @@
           ; has everyone committed?
           (when (eqv? (hash-count _commits)
                       (set-count _peers))
-            (set! _status 'voting))
+            (transition))
           (response/jsexpr empty))
         (response/jsexpr empty
                          #:code 403
                          #:message #"Not in the committing phase")))
 
   (define (peers request)
-    (if (eq? _status 'voting)
+    (if (eq? state 'voting)
         (response/jsexpr (for/list ([v _peers])
                            (hash-ref v 'input)))
         (response/jsexpr


@@ 90,7 120,7 @@
          #:message #"Voting has not begun")))
 
   (define (outputs request)
-    (if (eq? _status 'voting)
+    (if (eq? state 'voting)
         (begin
           ; TODO: check validity of inputs
           (let ([params (bytes->jsexpr (request-post-data/raw request))])


@@ 102,7 132,7 @@
           (when (for/and ([(p v) _outputs])
                   (eqv? (length v)
                         (set-count _peers)))
-            (set! _status 'summing))
+            (transition))
           (response/jsexpr empty))
         (response/jsexpr
          empty


@@ 110,7 140,7 @@
          #:message #"This election is not in the voting phase")))
 
   (define (_values request)
-    (if (eq? _status 'summing)
+    (if (eq? state 'summing)
         (let ([input (hash-ref (bytes->jsexpr (request-post-data/raw request)) 'input)])
           (response/jsexpr
            (hash-ref _outputs input)))


@@ 120,7 150,7 @@
          #:message #"This election is not in the summing phase")))
 
   (define (sum request)
-    (if (eq? _status 'summing)
+    (if (eq? state 'summing)
         (let* ([params (bytes->jsexpr (request-post-data/raw request))]
                [input (string->symbol (hash-ref params 'input))]
                [sum (hash-ref params 'sum)])


@@ 146,7 176,6 @@
     (dispatch-rules
      [("candidates") #:method "get"  candidates]
      [("register")   #:method "post" register  ]
-     [("done")       #:method "put"  done      ]
      [("peer-count") #:method "get"  peer-count]
      [("commit")     #:method "post" commit    ]
      [("peers")      #:method "get"  peers     ]


@@ 166,3 195,40 @@
    #:command-line? #t
    ;; #:servlet-responder internal-server-error
    ))
+
+(module+ main
+  (void (thread server))
+
+  (let loop ()
+    (let ([line (readline "> ")])
+      (when (not (eq? line eof))
+        (let ([sp (open-input-string line)])
+          (match (read sp)
+            ['add (match (read sp)
+                    ['cand
+                     (let* ([cand (read sp)]
+                            [cand (if (symbol? cand)
+                                      (symbol->string cand)
+                                      cand)])
+                       (hash-update! election->candidates
+                                     election
+                                     (λ (l)
+                                       (cons cand l))))]
+                    [else (displayln "cannot add that")])]
+            ['list
+             (displayln (hash-ref election->candidates election))]
+            ['set (match (read sp)
+                    ['election (let ([election (read sp)])
+                                 (election-set! election))]
+                    [else (displayln "cannot set that")])]
+            ['open
+             (if (memq state '(closed registering))
+                 (transition 'committing)
+                 (displayln "election is not closed"))]
+            ['close
+             (transition 'closed)
+             (reset)]
+            [else (displayln "unknown command")])
+          (when (not (equal? line ""))
+            (add-history line))
+          (loop))))))

@@ 82,7 82,8 @@
 
   (displayln "retrieving candidates...")
   (define candidates (cast (json-response-body
-                            (get bulletin "/candidates")) (Listof String)))
+                            (retry-request (get bulletin "/candidates")))
+                           (Listof String)))
   (define cand-count (cast (length candidates) Positive-Integer))
 
   (display "waiting for voting to commence...")