From 24c1e4c6b9b6e6ef9fddf55b65437d31aece24e6 Mon Sep 17 00:00:00 2001
From: David Florness <david@florness.com>
Date: Sat, 7 Mar 2020 17:13:56 -0700
Subject: [PATCH] Elections can be closed to cancel it in the middle of the
 protocol

---
 bulletin.rkt | 33 ++++++++++++++++++++++++---------
 client.rkt   | 43 ++++++++++++++++++++++++++++++++++---------
 2 files changed, 58 insertions(+), 18 deletions(-)

diff --git a/bulletin.rkt b/bulletin.rkt
index 3249694..7d1dd0e 100644
--- a/bulletin.rkt
+++ b/bulletin.rkt
@@ -38,7 +38,7 @@
 (define transitions
   (hasheq 'committing 'voting
           'voting 'summing
-          'summing 'closed))
+          'summing 'done))
 
 (define (transition [trans #f])
   (set! state (if trans trans (hash-ref transitions state))))
@@ -170,15 +170,22 @@
          #:code 403)))
 
   (define (sums request)
-    (if (eq? (length (hash-keys _sums))
-             (hash-count _peers))
-        (response/jsexpr
-         _sums)
-        (response/jsexpr
-         "The sums are not yet available"
-         #:code 403)))
+    (if (eq? state 'summing)
+        (if (eq? (length (hash-keys _sums))
+                 (hash-count _peers))
+            (begin
+              (transition)
+              (response/jsexpr _sums))
+            (response/jsexpr
+             "The sums are not yet available"
+             #:code 403))
+        (if (eq? state 'done)
+            (response/jsexpr _sums)
+            (response/jsexpr
+             "Too early to request sums"
+             #:code 403))))
 
-  (define-values (dispatcher url-generator)
+  (define-values (dispatch-route url-generator)
     (dispatch-rules
      [("candidates") #:method "get"  candidates]
      [("register")   #:method "post" register  ]
@@ -194,6 +201,14 @@
     (url? any/c . -> . can-be-response?)
     (response/full 400 #"Bad Request" (current-seconds) #f empty empty))
 
+  (define/contract (dispatcher req)
+    (request? . -> . any)
+    (if (eq? state 'closed)
+        (response/jsexpr
+         "Election closed / cancelled"
+         #:code 410)
+        (dispatch-route req)))
+
   (serve/servlet
    dispatcher
    #:port 1984
diff --git a/client.rkt b/client.rkt
index 3798108..6e6d188 100644
--- a/client.rkt
+++ b/client.rkt
@@ -53,7 +53,12 @@
   (let loop ([wait 0])
     (sleep wait)
     (with-handlers ([exn:fail:network:http:error?
-                     (λ (ex)
+                     (λ ([ex : exn:fail:network:http:error])
+                       ; 410 indicates the election is closed/cancalled
+                       (when (eqv? (exn:fail:network:http:error-code ex)
+                                   410)
+                         (newline)
+                         (raise ex))
                        (break-enabled #t)
                        (display ".")
                        (flush-output)
@@ -64,11 +69,14 @@
          [point    : Integer]
          [bulletin : requester]
          [token    : JSExpr])
-  (displayln "retrieving candidates...")
+  (newline)
+
+  (display "retrieving candidates...")
   (define candidates (cast (json-response-body
                             (retry-request (get bulletin "/candidates")))
                            (Listof String)))
   (define cand-count (cast (length candidates) Positive-Integer))
+  (newline)
 
   (display "waiting for voting to commence...")
   (define peer-count (cast
@@ -291,12 +299,26 @@
     (for ([r rank])
       (displayln (format "~a) ~a" i (list-ref candidates r))))))
 
+(define (wait-for-open-election [bulletin : requester])
+  (let retry : Any ([wait 0])
+       (sleep wait)
+       (with-handlers
+         ([exn:fail:network:http:error?
+           (λ ([ex : exn:fail:network:http:error])
+             (break-enabled #t)
+             (when (eqv? 410 (exn:fail:network:http:error-code ex))
+               (retry 3)))])
+         (get bulletin "/candidates"))))
+
 (module+ main
   (define point (gen))
 
   (define bulletin
     (update-port (update-host json-requester "localhost") 1984))
 
+  (displayln "waiting for the election to open...")
+  (wait-for-open-election bulletin)
+
   (define token
     (let ([username (readline "Username: ")]
           [password (get-pass "Password: ")])
@@ -315,12 +337,15 @@
 
   ; the bulletin can have multiple elections
   (let loop ()
-    (with-handlers ([exn:fail?
-                     (λ ([ex : exn:fail])
-                       (displayln (exn-message ex))
-                       (displayln
-                        "Assuming election was cancelled; starting over")
-                       (break-enabled #t)
-                       (loop))])
+    (with-handlers
+      ([exn:fail:network:http:error?
+        (λ ([ex : exn:fail:network:http:error])
+          (break-enabled #t)
+          (if (eqv? 410 (exn:fail:network:http:error-code ex))
+              (begin
+                (displayln
+                 "Election was closed; awaiting for it to reopen...")
+                (wait-for-open-election bulletin))
+              (raise ex)))])
       (vote-in-election point bulletin token))
     (loop)))
-- 
2.38.4