3 files changed, 42 insertions(+), 13 deletions(-)

M bulletin.rkt
M client.rkt
M info.rkt

@@ 5,6 5,7 @@
 (require web-server/servlet
          web-server/servlet-env
          json)
+(require simple-http)
 
 (module+ main
   (define _status 'registering)


@@ 16,13 17,34 @@
   (define (candidates request)
     (response/jsexpr '("Emacs" "Vim" "VSCode")))
 
+  (define (auth username password)
+    (equal? (hash-ref
+             (json-response-body
+              (post (update-ssl (update-host json-requester
+                                             "AUTH-HOST-HERE")
+                                #t)
+                    "/auth/route/here"
+                    #:data
+                    (jsexpr->string (hasheq 'username username
+                                            'password password))))
+             'result)
+            "success"))
+
   (define (register request)
     (if (eq? _status 'registering)
-        (let ([params (bytes->jsexpr (request-post-data/raw request))])
-          (displayln params)
-          (set-add! _peers (hasheq 'name  (hash-ref params 'name)
-                                   'input (hash-ref params 'input)))
-          (response/jsexpr empty))
+        (let* ([params (bytes->jsexpr (request-post-data/raw request))]
+               [username (hash-ref params 'username)]
+               [password (hash-ref params 'password)]
+               [input (hash-ref params 'input)])
+          (if (auth username password)
+              (begin
+                (displayln (format "~a is voting! (~a)" username input))
+                (set-add! _peers (hasheq 'input input))
+                (response/jsexpr empty))
+              (response/jsexpr
+               empty
+               #:code 400
+               #:message #"Bad Login")))
         (response/jsexpr
          empty
          #:code 403

@@ 6,6 6,8 @@
 (require racket/port)
 
 (require (only-in typed/openssl/sha1 bytes->hex-string hex-string->bytes))
+(require/typed get-pass
+  [get-pass (->* () (String #:in Input-Port #:out Output-Port) String)])
 (require net/http-client)
 (require net/uri-codec)
 (require typed/json)


@@ 59,19 61,24 @@
       f)))
 
 (module+ main
-  (define username (readline "Your name: "))
-
   (define point (gen))
 
   (define bulletin
     (update-port (update-host json-requester "localhost") 1984))
 
-  (displayln "registering...")
   (void
-   (post bulletin "/register"
-         #:data
-         (jsexpr->string (hasheq 'input (integer->hex-string point)
-                                 'name username))))
+   (let ([username (readline "Username: ")]
+         [password (get-pass "Password: ")])
+     (with-handlers ([exn:fail:network:http:error?
+                      (λ (exn)
+                        (newline)
+                        (displayln "Login refused. Wrong credentials, perhaps?")
+                        (exit))])
+       (post bulletin "/register"
+             #:data
+             (jsexpr->string (hasheq 'input (integer->hex-string point)
+                                     'username username
+                                     'password password))))))
 
   (displayln "retrieving candidates...")
   (define candidates (cast (json-response-body

@@ 1,6 1,6 @@
 #lang info
 (define collection "tallyard")
-(define deps '("base" "crypto" "sha" "simple-http" "sugar"))
+(define deps '("base" "crypto" "sha" "simple-http" "sugar" "get-pass"))
 (define build-deps '("scribble-lib" "racket-doc" "rackunit-lib"))
 (define scribblings '(("scribblings/tallyard.scrbl" ())))
 (define pkg-desc "Description Here")