~shironeko/lotte

334d74beb7d7f6e0c3c2b575b4d8a66a7faadcb9 — shironeko 1 year, 24 days ago 6290edb
make code more modular
4 files changed, 149 insertions(+), 91 deletions(-)

A lotte-cli.scm
D lotte.scm
A lotte/main.scm
A lotte/utils.scm
A lotte-cli.scm => lotte-cli.scm +44 -0
@@ 0,0 1,44 @@
#! /usr/bin/env -S guile -L . -s
!#

; lotte: The Fair Lottery Program
; Copyright 2020 shironeko
;
; This file is part of lotte.
;
; lotte is free software: you can redistribute it and/or modify
; it under the terms of the GNU Affero General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; lotte is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU Affero General Public License for more details.
;
; You should have received a copy of the GNU Affero General Public License
; along with this program.  If not, see <https://www.gnu.org/licenses/>.

(use-modules (lotte main)
             (lotte utils)
             (ice-9 rdelim))

;
; command line handling TODO
;
(define (get-users)
  (define (iter users)
    (let ((user (read-line)))
      (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)))

D lotte.scm => lotte.scm +0 -91
@@ 1,91 0,0 @@
#! /usr/bin/env -S guile -s
!#

; lotte: The Fair Lottery Program
; Copyright 2020 shironeko
;
; This file is part of lotte.
;
; lotte is free software: you can redistribute it and/or modify
; it under the terms of the GNU Affero General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; lotte is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU Affero General Public License for more details.
;
; You should have received a copy of the GNU Affero General Public License
; along with this program.  If not, see <https://www.gnu.org/licenses/>.

(use-modules (gcrypt base16)
             (gcrypt hash)
             (gcrypt mac)
             (rnrs bytevectors)
             (ice-9 rdelim))

;
; handy definitions
;
(define max-score (make-string 64 #\f))
(define (string-min a b) (if (string<? a b) a b))

;
; lotte implementation
;
(define (lotte)
  (define lotte-name (read-line))
  (define lucky-num-str (read-line))
  (define lucky-num (string->number lucky-num-str))

  (define hmac-key (generate-signing-key 32))
  (define hmac-key-str (bytevector->base16-string hmac-key))

  ; 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)
    (bytevector->base16-string
      (sha256 (string->utf8 (string-join strs)))))
  (define (hmac msg)
    (bytevector->base16-string
      (sign-data hmac-key (string->utf8 msg)
                 #:algorithm (mac-algorithm hmac-sha256))))

  ; if there is no user (setting up the lottery) prints the sealed lucky-num
  ; otherwise prints the winner with their score
  (define (find-1-winner)
    ; a user's score is the smallest hash string obtained by
    ; 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)
      (let ((new-user (read-line)))
        (if (eof-object? new-user)
            (if (eq? score max-score)
                ; setting up the lottery, so no participants yet
                (begin (format #t "Your sealed lucky number is: ~a\n" (hmac lucky-num-str))
                       (format #t "The key is: ~a (reveal this at the end)\n" hmac-key-str))
                ; print winner and their score
                (begin (format #t "The winner is: ~a\n" user)
                       (format #t "Their score is: ~a\n" score)))
            (let ((new-score (get-score new-user)))
              (if (string<? new-score score)
                  (iter new-user new-score)
                  (iter user score))))))
    (iter "" max-score))
    (if (not (and (integer? lucky-num)
                  (positive? lucky-num)))
        (error "The second line needs to be a positive integer")
        (find-1-winner lotte-name lucky-num-str lucky-num)))

;
; command line handling TODO
;
(lotte)

A lotte/main.scm => lotte/main.scm +57 -0
@@ 0,0 1,57 @@
; lotte: The Fair Lottery Program
; Copyright 2020 shironeko
;
; This file is part of lotte.
;
; lotte is free software: you can redistribute it and/or modify
; it under the terms of the GNU Affero General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; lotte is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU Affero General Public License for more details.
;
; You should have received a copy of the GNU Affero General Public License
; along with this program.  If not, see <https://www.gnu.org/licenses/>.

(define-module (lotte main)
  #: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))

A lotte/utils.scm => lotte/utils.scm +48 -0
@@ 0,0 1,48 @@
; lotte: The Fair Lottery Program
; Copyright 2020 shironeko
;
; This file is part of lotte.
;
; lotte is free software: you can redistribute it and/or modify
; it under the terms of the GNU Affero General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; lotte is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU Affero General Public License for more details.
;
; You should have received a copy of the GNU Affero General Public License
; along with this program.  If not, see <https://www.gnu.org/licenses/>.

(define-module (lotte utils)
  #:use-module (gcrypt base16)
  #:use-module (gcrypt base64)
  #:use-module (gcrypt hash)
  #:use-module (gcrypt mac)
  #:use-module (rnrs bytevectors)
  #:export (bv->base64url
            base64url->bv
            hex-encode
            hex-decode
            hash-msg
            max-score
            gen-mac-key
            tag-msg
            string-min))

(define (bv->base64url bv) (base64-encode bv 0 (bytevector-length bv) #f #f base64url-alphabet))
(define (base64url->bv base64url) (base64-decode base64url base64url-alphabet))
(define (hex-encode bv) (bytevector->base16-string bv))
(define (hex-decode hex) (base16-string->bytevector hex))

(define (hash-msg msg) (hex-encode (sha256 (string->utf8 msg))))
(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)
    (bv->base64url (sign-data (base64url->bv key)
                              (string->utf8 msg)
                              #:algorithm (mac-algorithm hmac-sha256))))

(define (string-min a b) (if (string<? a b) a b))