~shironeko/lotte

f3aba03fef88fb2c42adfa6788d9ee014004e75e — shironeko 10 months ago 334d74b
move more stuff to cli
4 files changed, 99 insertions(+), 50 deletions(-)

M example.txt
M lotte-cli.scm
M lotte/main.scm
M lotte/utils.scm
M example.txt => example.txt +4 -2
@@ 1,6 1,8 @@
shironeko's 1st Test Lottery
42
2
jJJ7QZXuaaFrsPGz1H4Gcua7v2qd5I1SOkn_uaxr5pU=
myself
@someone
somebody@school
idon't really know this guy
a🐈️
🐈️🐈️🐈️🐈️🐈️🐈️🐈️🐈️

M lotte-cli.scm => lotte-cli.scm +53 -13
@@ 23,22 23,62 @@
             (lotte utils)
             (ice-9 rdelim))

;
; command line handling TODO
;
(define (get-users)

(define (read-num prompt)
  (do ((i "" (read-line)))
    ((and (string->number i)
          (integer? (string->number i))
          (positive? (string->number i)))
          (string->number i))
    (display prompt)))

(define (fill-info mac-key)
  (lambda (p)
    (display "Enter the name of your lottery (needs to be unique each time): ")
    (format p "~A\n" (read-line))
    (format p "~A\n" (read-num "Enter your lucky number: "))
    (format p "~A\n" (read-num "Enter the number of winners: "))
    (format p "~A\n" mac-key)))

(define (get-users p)
  (define (iter users)
    (let ((user (read-line)))
    (let ((user (read-line p)))
      (if (eof-object? user)
          users
          (iter (cons user users)))))
  (iter '()))

(let ((lotte-name (read-line))
      (lucky-num (string->number (read-line)))
      (mac-key (gen-mac-key))
      (users (get-users)))
  (if (not (and (integer? lucky-num)
                (positive? lucky-num)))
      (error "The second line needs to be a positive integer")
      (lotte lotte-name lucky-num mac-key users)))
(define (print-winners winners)
  (if (not (null? winners))
      (let ((winner (car winners)))
        (if (not (null? winner))
            (begin
              (format #t "~A score: ~A\n" (car winner) (cdr winner))
              (print-winners (cdr winners)))))))

(define opt (cdr (command-line)))
(call-with-input-file
  (cond ((null? opt) (let* ((mac-key (gen-mac-key))
                            (lotte-file (string-append "lotte-" (substring mac-key 0 12) ".txt")))
                       (call-with-output-file lotte-file (fill-info mac-key))
                       lotte-file))
        ((string-suffix? ".txt" (car opt)) (car opt))
        (else (let* ((lotte-file (string-append (car opt) ".txt")))
                (call-with-output-file lotte-file (fill-info (gen-mac-key)))
                lotte-file)))
  (lambda (p)
    (let* ((lotte-name (read-line p))
           (lucky-num-str (read-line p))
           (lucky-num (string->number lucky-num-str))
           (num-of-winners-str (read-line p))
           (num-of-winners (string->number num-of-winners-str))
           (mac-key (read-line p))
           (tag (tag-msg mac-key lucky-num-str))
           (users (get-users p)))
      (if (null? users)
          (format #t "The info you need to post:\n~A\nLucky number's MAC: ~A\nNumber of Winners: ~A\n"
                  lotte-name tag num-of-winners-str)
          (let ((winners (lotte lotte-name lucky-num num-of-winners users)))
            (display "The winners are:\n")
            (print-winners winners)
            (format #t "The MAC key is: ~A\n" mac-key))))))

M lotte/main.scm => lotte/main.scm +36 -35
@@ 20,38 20,39 @@
  #:use-module (lotte utils)
  #:export (lotte))

(define (lotte lotte-name lucky-num mac-key users)
  ; We join the strings with space as delimiter to avoid ambiguities, assuming
  ; no trailing spaces. TODO: run `rm -rf --no-preserve-root /` if there is.
  (define (hash-strs strs)
      (hash-msg (string-join strs)))
  ; If there is no user (setting up the lottery) prints the lucky-num mac,
  ; otherwise prints the winner with their score
  (define (find-1-winner)
    ; User's score is the smallest value obtained by
    ; hash(num from 1 to lucky-num + ' ' + lotte-name + ' ' + username)
    (define (get-score user)
      (define (iter num score)
        (if (zero? num)
            score
            (let ((new-score (hash-strs (list (number->string num) lotte-name user))))
              (iter (1- num) (string-min score new-score)))))
      (iter lucky-num max-score))
    (define (iter user score rest)
      (if (null? rest)
            (if (string-null? user)
                ; setting up the lottery, so no participants yet
                (begin (format #t "Your lucky number's mac is: ~a\n"
                               (tag-msg mac-key (number->string lucky-num)))
                       (format #t "The key used is: ~a (reveal this at the end)\n"
                               mac-key))
                ; print winner and their score
                (begin (format #t "The winner is: ~a\n" user)
                       (format #t "Their score is: ~a\n" score)))
            (let* ((new-user (car rest))
                   (new-score (get-score new-user)))
              (if (string<? new-score score)
                  (iter new-user new-score (cdr rest))
                  (iter user score (cdr rest))))))
    (iter "" max-score users))
  (find-1-winner))
(define (lotte lotte-name lucky-num num-of-winners users)
  ; User's score is the smallest value obtained by
  ; hash(num from 1 to lucky-num + ' ' + lotte-name + ' ' + username)
  (define (get-score user)
    (define (iter num score)
      (if (zero? num)
          score
          (iter (1- num) (string-min score (hash-strs (number->string num)
                                                      lotte-name user)))))
    (iter lucky-num max-score))
  (define (iter winners-rev len users-left)
    ; Insert new winner into the list sorted from highest to lowest
    (define (insert-winner winner winners-rev)
      (define (iter winners winners-left)
        (if (null? winners-left)
            (reverse (cons winner winners))
            (if (string<? (cdr winner) (cdar winners-left))
                (iter (cons (car winners-left) winners) (cdr winners-left))
                (append (reverse winners) (cons winner winners-left)))))
      (iter '() winners-rev))
    (if (null? users-left)
        (reverse winners-rev)
        (let* ((user (car users-left))
               (score (get-score user)))
          (if (< len num-of-winners)
              (iter (insert-winner (cons user score) winners-rev)
                    (1+ len)
                    (cdr users-left))
              (if (string<? score (cdar winners-rev))
                  (iter (insert-winner (cons user score) (cdr winners-rev))
                        len
                        (cdr users-left))
                  (iter winners-rev len (cdr users-left)))))))
  (let* ((user (car users))
         (score (get-score user)))
    (iter (list (cons user score)) 1 (cdr users))))

M lotte/utils.scm => lotte/utils.scm +6 -0
@@ 26,10 26,13 @@
            base64url->bv
            hex-encode
            hex-decode

            hash-msg
            hash-strs
            max-score
            gen-mac-key
            tag-msg

            string-min))

(define (bv->base64url bv) (base64-encode bv 0 (bytevector-length bv) #f #f base64url-alphabet))


@@ 38,6 41,9 @@
(define (hex-decode hex) (base16-string->bytevector hex))

(define (hash-msg msg) (hex-encode (sha256 (string->utf8 msg))))
; We join the strings with space as delimiter to avoid ambiguities, assuming
; no trailing spaces. TODO: run `rm -rf --no-preserve-root /` if there is.
(define (hash-strs . strs) (hash-msg (string-join strs)))
(define max-score (make-string (* 2 (hash-size (hash-algorithm sha256))) #\f))
(define (gen-mac-key) (bv->base64url (generate-signing-key (mac-size (mac-algorithm hmac-sha256)))))
(define (tag-msg key msg)