From 250fd650a39434a2de43f6afb376d895fdb703c7 Mon Sep 17 00:00:00 2001 From: David Florness Date: Fri, 6 Mar 2020 23:27:28 -0700 Subject: [PATCH] Basic repl for bulletin --- bulletin.rkt | 110 ++++++++++++++++++++++++++++++++++++++++----------- client.rkt | 3 +- 2 files changed, 90 insertions(+), 23 deletions(-) diff --git a/bulletin.rkt b/bulletin.rkt index 9b24464..91cdf69 100644 --- a/bulletin.rkt +++ b/bulletin.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)))))) diff --git a/client.rkt b/client.rkt index 49d637f..0c94775 100644 --- a/client.rkt +++ b/client.rkt @@ -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...") -- 2.38.4