# -*- mode:org;coding:utf-8 -*-

# M-x org-toggle-inline-images

#+AUTHOR: Pascal J. Bourguignon
#+EMAIL: pjb@informatimago.com
#+DATE: Wed Apr 14 01:28:01 CEST 2021
#+TITLE: Simple IRC bot to manage insecure votes
#+LANGUAGE: en

* Prologue                                                         :noexport:

#+LATEX_HEADER: \usepackage{fancyhdr}
#+LATEX_HEADER: \usepackage[english]{babel}
#+LATEX_HEADER: \pagestyle{fancyplain}
#+LATEX_HEADER: \lhead{\small{Confidentiel}}
#+LATEX_HEADER: \chead{}
#+LATEX_HEADER: \rhead{Simple IRC bot to manage insecure votes}
#+LATEX_HEADER: \lfoot{}
#+LATEX_HEADER: \cfoot{\tiny{Copyright 2021, Pascal J. Bourguignon}}
#+LATEX_HEADER: \rfoot{\thepage}
#+LATEX_HEADER: \setcounter{page}{1}
#+LATEX_HEADER: \pagenumbering{arabic}

* Simple IRC bot to manage insecure votes
** Specfications

*** Specification of a vote

Specification of a vote is performed via a private dialog with the bot.

| Command                                          | Output                 | Description                                                                               |
|--------------------------------------------------+------------------------+-------------------------------------------------------------------------------------------|
| new ballot $title $password                      | $ballot-id             | Creates a new ballot and issues a ballot ID for reference.                                |
| set [ballot] title         $ballot-id $title     |                        | Sets the title of a ballot.    Only in :editing state.                                    |
| set [ballot] dead[-]line   $ballot-id $dead-line |                        | Sets the deadline of a ballot. Only in :editing state.                                    |
| set [ballot] remind-period $ballot-id $period    |                        | Sets the remind period of a ballot.                                                       |
| list [ballot[s]]                                 | list of ballots        | Lists all known ballots with their status and deadline or results.                        |
| show [ballot] $ballot-id                         | display info of ballot | Displays all the public information about the ballot.                                     |
|                                                  |                        |                                                                                           |
| add choice $ballot-id $choice-id $choice-title   |                        | Adds a new choice to the ballot.  Only in :editing state.                                 |
| delete choice $ballot-id $choice-id              |                        | Remove a choice from a ballot.    Only in :editing state.                                 |
| list choice[s] $ballot-id                        | list of choices        | Lists all the choices of a ballot.                                                        |
| ballot [choice[s]] $ballot-id                    | list of choices        | Lists all the choices of a ballot. If the user has already voted, this will be indicated. |
|                                                  |                        |                                                                                           |
| add channel[s] $ballot-id #channel…              |                        | Add a channel to the ballot.      Only in :editing state.                                 |
| remove channel[s] $ballot-id #channel…           |                        | Remove a channel from the ballot. Only in :editing state.                                 |
| list [ballot] channel[s] $ballot-id              | list of channels       | List the channels of the ballot.                                                          |
|                                                  |                        |                                                                                           |
| open ballot $ballot-id $password                 |                        | Opens the ballot. From the :editing state.                                                |
| cancel ballot $ballot-id $password               |                        | Cancel a ballot.  We can cancel a ballot from the :editing or the :open state.            |
|                                                  |                        |                                                                                           |
| vote $ballot-id [choice] $choice-id              |                        | Cast or change a vote.  Only in :open state.                                              |
|                                                  |                        | If the same user votes several times, only the last vote is taken into account.           |
|                                                  |                        |                                                                                           |
| [ballot] results [of] [ballot] $ballot-id        | list of vote results   | in :editing state, we only display the ballot info (same as show ballot $ballot-id);      |
|                                                  |                        | in :open state, we only display the number of casted votes;                               |
|                                                  |                        | in :closed state, we display the vote results.                                            |


*** Objects

|-----------------------------------------------------|
| Ballot                                              |
|-----------------------------------------------------|
| ballot-id : string                                  |
| title : string                                      |
| dead-line : date-time                               |
| remind-period : time                                |
| owner : string                                      |
| password-hash : string                              |
| secret-seed : string                                |
| status : (member :editing :open :closed :cancelled) |
|-----------------------------------------------------|


|-----------------------|
| Channel               |
|-----------------------|
| ballot-id : string    |
| channel-name : string |
|-----------------------|


|--------------------|
| Choice             |
|--------------------|
| ballot-id : string |
| choice-id : string |
| title : string     |
|--------------------|


|-------------------------|
| Vote                    |
|-------------------------|
| ballot-id : string      |
| user-id-hash : string   |
| choice-id : string      |
| choice-id-hash : string |
|-------------------------|


- association publication ballot channel
- association choices ballot choice
- association casted ballot vote

Channels of a ballot are sent the ballot announce (when entering the
:open state),  periodic reminder messages, and result messages when
the dead-line occurs or the ballot is canceled.

When a ballot is created, a secret-seed is initialized, to be used to
hash strings, such as the user-id of the voters, and their choice (for
validation).


*** Publication of a vote

#+BEGIN_SRC
/msg botvot
new ballot "Slime Presentation GCing"  mybreathismypassword
set ballot deadline 12:00
add choice spg1 yes  "Yes, obj always reachable."
add choice spg1 no   "No, obj may be GCed."
add choice spg1 what "What are presentations?"
add channels spg1 #lisp #slime #emacs
info ballot spg1
open ballot spg1 mybreathismypassword
#+END_SRC

When the ballot is open, a publication message is sent to the owner
and to each ballot channel:

#+BEGIN_EXAMPLE
Ballot $ballot-id $ballot-title is open till $deadline. Cast your vote with:  /msg botvot ballot $ballot-id   and:  /msg botvot vote $ballot-id $choice-id
#+END_EXAMPLE


*** Casting a vote

#+BEGIN_SRC
/msg botvot ballot $ballot-id
/msg botvot vote   $ballot-id $choice-id
#+END_SRC

#+BEGIN_SRC
/msg botvot ballot choices $ballot-id
/msg botvot vote   $ballot-id choice $choice-id
#+END_SRC


*** Reporting Results

While the ballot is
When the ballot is canceled, a publication message is sent to the owner
and to each ballot channel:

#+BEGIN_EXAMPLE
Ballot $ballot-id $ballot-title is open. Cast your vote with /msg botvot ballot $ballot-id   and  /msg botvot vote $ballot-id $choice-id
#+END_EXAMPLE



❡

** Implementation
*** command-matches

| ("set" (opt "ballot") "title" ballot-id title)                   | exact | ¬exact |
|------------------------------------------------------------------+-------+--------+
| ("set")                                                          | nil   | t      |
| ("ballot")                                                       | nil   | t      |
| ("title")                                                        | nil   | t      |
| ("ballot" "title")                                               | nil   | t      |
| ("set" "ballot" "title" "pg1" "Presentation Garbage Collection") | t     | t      |
| ("set" "ballot" "title" "pg1")                                   | t     | t      |
| ("set" "title" "pg1" "Presentation Garbage Collection")          | t     | t      |
| ("set" "title" "pg1")                                            | t     | t      |

* Old stuff

Écriture du client `IRC`
------------------------------------------------------------

Se connecter au serveur `IRC` avec `cl-irc` et joindre un canal est
trés simple : ::

    (defvar *connection* nil)
    (defvar *server*   "irc.freenode.org")
    (defvar *nickname* "botihn")
    (defvar *channel*  "#hn")
    (defvar *period* 10 #|seconds|#)

    (setf *connection* (connect :nickname *nickname* :server *server*))
    (join *connection* *channel*)

Nous pouvons alors transmettre les nouvelles *Hacker news*
periodiquement : ::

    (monitor-initialize)
    (loop
       (monitor-hacker-news (lambda (message) (privmsg *connection* *channel* message)))
       (sleep *period*))

Cependant, ceci n'est pas satisfaisant, car nous ne recevons ni ne
traitons aucun message provenant du serveur `IRC`.  Pour celà, il faut
appeler la fonction `(read-message \*connection\*)`.  Cette fonction
contient un temps mort de 10 secondes: si aucun message n'est reçu au
bout de 10 secondes, elle retourne `NIL` au lieu de `T`.  Comme notre
période de travail n'est pas inférieur à 10 secondes, nous pouvons
nous accomoder de ce temps mort. ::

    (monitor-initialize)
    (loop
      :with next-time = (+ *period* (get-universal-time))
      :for time = (get-universal-time)
      :do (if (<= next-time time)
              (progn
                (monitor-hacker-news (lambda (message) (privmsg *connection* *channel* message)))
                (incf next-time *period*))
              (read-message *connection*) #|there's a 10 s timeout in here.|#))

Nous pouvons maintenant ajouter une fonction de traitement des
messages privés, afin de fournir sur demande, une information à propos
du robot `botihn` : ::

    (add-hook *connection* 'irc::irc-privmsg-message 'msg-hook)

Avec : ::

    (defvar *sources-url* "https://gitlab.com/com-informatimago/com-informatimago/tree/master/small-cl-pgms/botihn/")

    (defun msg-hook (message)
      (when (string= *nickname* (first (arguments message)))
        (privmsg *connection* (source message)
                 (format nil "I'm an IRC bot forwarding HackerNews news to ~A; ~
                              under AGPL3 license, my sources are available at <~A>."
                         *channel*
                         *sources-url*))))

Avec `IRC`, les messages sont envoyés à un canal ou à un utilisateur
donné en utilisant le même message de protocole, un `PRIVMSG`.  Le
client peut distinguer à qui le message était envoyé en observant le
premier argument du message, qui sera le nom du canal ou le nom de
l'utilisateur.  Notre robot ne réagit pas aux messages envoyés sur le
canal, mais répond seulement aux messages qui lui sont directement
adressés, avec `/msg` : ::

    /msg botihn heho!

    <botihn> I'm an IRC bot forwarding HackerNews news to #hn; under AGPL3 license, my sources
    are available at
    <https://gitlab.com/com-informatimago/com-informatimago/tree/master/small-cl-pgms/botihn/>.



Jusqu'à présent, nous ne nous sommes pas occupé des cas d'erreur.
Principalement, si une erreur survient, c'est pour cause de
déconnexion du serveur `IRC`.  Si une erreur survient avec le serveur
de nouvelles, nous obtenons des listes de nouvelles vides, et nous
n'envoyons simplement aucun message.

Ainsi, si nous détectons une sortie non-locale (avec
`UNWIND-PROTECT`), nous quittons simplement la connexion, et nous
essayons de nous reconnecter après un délai aléatoire. ::


    (defun call-with-retry (delay thunk)
      (loop
        (handler-case (funcall thunk)
          (error (err) (format *error-output* "~A~%" err)))
        (funcall delay)))

    (defmacro with-retry (delay-expression &body body)
      `(call-with-retry (lambda () ,delay-expression)
                        (lambda () ,@body)))

    (defun main ()
      (catch :gazongues
        (with-retry (sleep (+ 10 (random 30)))
          (unwind-protect
               (progn
                 (setf *connection* (connect :nickname *nickname* :server *server*))
                 (add-hook *connection* 'irc::irc-privmsg-message 'msg-hook)
                 (join *connection* *channel*)
                 (monitor-initialize)
                 (loop
                   :with next-time = (+ *period* (get-universal-time))
                   :for time = (get-universal-time)
                   :do (if (<= next-time time)
                           (progn
                             (monitor-hacker-news (lambda (message) (privmsg *connection* *channel* message)))
                             (incf next-time *period*))
                           (read-message *connection*) #|there's a 10 s timeout in here.|#)))
            (when *connection*
              (quit *connection*)
              (setf *connection* nil))))))


Génération d'un exécutable indépendant
------------------------------------------------------------

Afin de générer un exécutable indépendant, nous écrivons un petit
script `generate-application.lisp` qui sera exécuté dans un
environnement vierge.  Ce script charge `quicklisp`, charge botihn, et
enregistre une image exécutable, en indiquant la fonction `main` comme
point d'entrée du programme (`toplevel-function`) :  ::

    (in-package "COMMON-LISP-USER")
    (progn (format t "~%;;; Loading quicklisp.~%") (finish-output) (values))
    (load #P"~/quicklisp/setup.lisp")

    (progn (format t "~%;;; Loading botihn.~%") (finish-output) (values))
    (push (make-pathname :name nil :type nil :version nil
                         :defaults *load-truename*) asdf:*central-registry*)

    (ql:quickload :com.informatimago.small-cl-pgms.botihn)

    (progn (format t "~%;;; Saving hotihn.~%") (finish-output) (values))
    ;; This doesn't return.
    #+ccl (ccl::save-application
           "botihn"
           :mode #o755 :prepend-kernel t
           :toplevel-function (function com.informatimago.small-cl-pgms.botihn:main)
           :init-file nil
           :error-handler :quit)


Un petit `Makefile` permet d'exécuter ce script facilement à partir du
shell `unix` : ::

    all:botihn
    botihn: com.informatimago.small-cl-pgms.botihn.asd  botihn.lisp generate-application.lisp
        ccl -norc < generate-application.lisp




Conclusion
------------------------------------------------------------

Vous pouvez obtenir les sources complets de ce petit exemple à:
`<https://gitlab.com/com-informatimago/com-informatimago/tree/master/small-cl-pgms/botihn/>`_ : ::

  git clone https://gitlab.com/com-informatimago/com-informatimago.git
  cd com-informatimago/small-cl-pgms/botihn/
  emacs # edit configuration
  make

* Epilogue                                                         :noexport:

# Local Variables:
# eval: (auto-fill-mode 1)
# eval: (set-input-method 'latin-1-prefix)
# End:
ViewGit