Bots in tests

Dockerfile-tests

@@ -1,7 +1,16 @@
 FROM ghcr.io/marckaufmann/racket:7.9-cs-full
 
+RUN apt-get update \
+  && apt-get install -y --no-install-recommends libgtk-3-0 libdbus-glib-1-2 xvfb
+
+RUN curl -L 'https://download.mozilla.org/?product=firefox-latest-ssl&os=linux64&lang=en-US' > /tmp/firefox.tar \
+    && (cd /tmp && tar -xvf firefox.tar) \
+    && mv /tmp/firefox /opt/firefox \
+    && ln -s /opt/firefox/firefox /usr/bin/firefox
+
 WORKDIR /opt/congame
 COPY .git /opt/congame/.git
+COPY bin /opt/congame/bin
 COPY ci /opt/congame/ci
 COPY congame /opt/congame/congame
 COPY congame-core /opt/congame/congame-core
@@ -23,4 +32,4 @@ RUN raco pkg install -D --auto --batch \
   congame-price-lists/ \
   congame/ \
   congame-tests/
-CMD ["raco", "test", "/opt/congame/congame-tests"]
+CMD ["/opt/congame/bin/run-tests.sh"]

bin/run-tests.sh

@@ -0,0 +1,7 @@
+#!/usr/bin/env bash
+
+set -euo pipefail
+
+Xvfb :5 -ac &
+export DISPLAY=:5
+raco test /opt/congame/congame-tests

congame-core/components/bot.rkt

@@ -40,7 +40,7 @@
             (hash-set steppers (list (bot-stepper-id s) '*root*) s)]))))
 
 (define/contract (make-bot-stepper id action)
-  (-> symbol? (-> void?) bot-stepper?)
+  (-> symbol? (-> any) bot-stepper?)
   (bot-stepper id action))
 
 (define/contract (make-bot-stepper/study study-id b)
@@ -68,6 +68,7 @@
    current-page
    continuer
    click
+   wait-for
    find
    find-all
    find-attribute
@@ -89,7 +90,7 @@
                             #:username username
                             #:password password
                             #:headless? [headless? #t]
-                            #:delay [delay 0])
+                            #:delay [delay 0.25])
     (->* (bot?
           #:study-url string?
           #:username string?
@@ -153,6 +154,9 @@
 
   ;; helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+  (define (wait-for selector)
+    (page-wait-for! (current-page) selector))
+
   (define (find selector)
     (page-query-selector! (current-page) selector))
 

congame-pjb-studies/pjb-pilot-bot.rkt

@@ -40,7 +40,6 @@
 
 ;; TODO: Give bots the ability to `get' (but maybe not put!) data.
 (module+ main
-
   (run-bot
    #:study-url "http://127.0.0.1:5100/study/pilot1"
    #:username "bot@example.com"

congame-pjb-studies/pjb-pilot.rkt

@@ -261,18 +261,9 @@
              (button ((type "submit") (class "button")) "Submit")))))))
 
 (define (test-study-requirements-step/bot)
-  (element-click! (bot:find "#play"))
   (for ([checkbox (bot:find-all "input[type=checkbox]")])
-    (displayln (format "checkbox is ~a" checkbox))
-    (flush-output)
     (element-click! checkbox))
-  ;; Use JS to submit the page faster; actually click the play button
-  ;; and wait for the button to appear to simulate the real world.
-  ;; FIXME: JS version to skip wait leads to checkbox clicking being done after the page is submitted,
-  ;; leading to an error.
-  #;(void
-   (page-execute-async! (bot:current-page) "document.querySelector('form').submit()"))
-  (element-click! (page-wait-for! (bot:current-page) "button[type=submit]")))
+  (page-execute-async! (bot:current-page) "document.querySelector('button[type=submit]').click()"))
 
 (define (test-study-requirements)
   (page

congame-pjb-studies/relax.rkt

@@ -121,13 +121,13 @@
                                                   ("second" . "Second song")
                                                   ("third"  . "Third song")))))
     ,@(rw "second-preferred-song" (widget-errors))
-    (:label "Do you like classical music?"
-            (rw "like-classical?" (widget-radio-group '(("yes" . "Yes")
-                                                        ("no"  . "No")))))
+    (:label.radio-group "Do you like classical music?"
+                        (rw "like-classical?" (widget-radio-group '(("yes" . "Yes")
+                                                                    ("no"  . "No")))))
     ,@(rw "like-classical?" (widget-errors))
-    (:label "Do you think that you heard any of the songs before?"
-            (rw "heard-song-before?" (widget-radio-group '(("yes" . "Yes")
-                                                           ("no"  . "No")))))
+    (:label.radio-group "Do you think that you heard any of the songs before?"
+                        (rw "heard-song-before?" (widget-radio-group '(("yes" . "Yes")
+                                                                       ("no"  . "No")))))
     ,@(rw "heard-song-before?" (widget-errors))
     (:button.button.next-button ((:type "submit")) "Submit"))))
 
@@ -150,9 +150,10 @@
                             [:src (resource-uri songs (string-append "snip-" song-name))])))))))))
 
 (define (evaluate-songs/bot)
-  (define f (bot:find "form"))
-  (define rs (bot:element-find-all f "input[type=radio]"))
-  (element-click! (car rs))
+  (define f (bot:wait-for "form"))
+  (for ([group-el (bot:element-find-all f ".radio-group")])
+    (define first-radio-el (bot:element-find group-el "input[type=radio]"))
+    (element-click! first-radio-el))
   (element-click! (bot:find "button[type=submit]")))
 
 (define (play-songs/bot)

congame-tests/congame/bots.rkt

@@ -0,0 +1,75 @@
+#lang racket/base
+
+(require component
+         congame-pjb-studies/pjb-pilot-bot
+         congame-web/components/user
+         congame-web/dynamic
+         (submod congame/components/bot actions)
+         (except-in congame/components/study fail)
+         db
+         deta
+         koyo/database
+         koyo/logging
+         rackunit
+         "common.rkt")
+
+(define stop-logger void)
+(define test-system
+  (system-replace prod-system 'db make-test-database))
+(define bot-tests
+  (test-suite
+   "bots"
+   #:before
+   (lambda ()
+     (set! stop-logger
+           (start-logger
+            #:levels `((app                  . debug)
+                       (mail-adapter         . debug)
+                       (memory-session-store . debug)
+                       (north-adapter        . debug)
+                       (server               . debug)
+                       (session              . debug)
+                       (study                . debug)
+                       (system               . debug)
+                       (worker               . info))))
+     (system-start test-system)
+     (define db (system-ref test-system 'db))
+     (with-database-connection [conn db]
+       (query-exec conn "TRUNCATE users, study_participants, study_instances, studies CASCADE;"))
+     (define users (system-ref test-system 'users))
+     (define bot-user
+       (make-test-user! users "bot@example.com" "password" #:bot? #t))
+     (user-manager-verify! users (user-id bot-user) (user-verification-code bot-user))
+     (define pjb-pilot-instance
+       (with-database-transaction [conn db]
+         (define pjb-pilot-study
+           (insert-one! conn (make-study-meta
+                              #:name "pjb-pilot"
+                              #:slug "pjb-pilot"
+                              #:racket-id 'pjb-pilot-study)))
+
+         (insert-one! conn (make-study-instance
+                            #:study-id (study-meta-id pjb-pilot-study)
+                            #:name "pjb-pilot"
+                            #:slug "pjb-pilot"
+                            #:status 'active))))
+     (enroll-participant! db
+                          (user-id bot-user)
+                          (study-instance-id pjb-pilot-instance)))
+   #:after
+   (lambda ()
+     (system-stop test-system))
+
+   (test-suite
+    "pjb-pilot-bot"
+
+    (run-bot
+     #:study-url "http://127.0.0.1:8000/study/pjb-pilot"
+     #:username "bot@example.com"
+     #:password "password"
+     #:headless? #t
+     (pjb-pilot-bot pjb-pilot-bot-model)))))
+
+(module+ test
+  (require rackunit/text-ui)
+  (run-tests bot-tests))

congame-tests/congame/common.rkt

@@ -76,5 +76,6 @@
 
 (define (make-test-user! users
                          [username "bogdan@example.com"]
-                         [password "hunter2"])
-  (user-manager-create! users username password))
+                         [password "hunter2"]
+                         #:bot? [bot? #f])
+  (user-manager-create! users username password (if bot? 'bot 'user)))

congame-tests/info.rkt

@@ -5,7 +5,10 @@
 (define deps '())
 (define build-deps '("base"
                      "component-lib"
+                     "congame-core"
+                     "congame-pjb-studies"
                      "db-lib"
+                     "deta-lib"
                      "koyo-lib"
                      "koyo-north"
                      "threading-lib"

congame/components/user.rkt

@@ -105,11 +105,12 @@
   (-> database? user-manager?)
   (user-manager db))
 
-(define/contract (user-manager-create! um username password)
-  (-> user-manager? string? string? user?)
+(define/contract (user-manager-create! um username password [role 'user])
+  (->* (user-manager? string? string?) ((or/c 'admin 'user 'bot)) user?)
 
   (define user
-    (~> (make-user #:username username)
+    (~> (make-user #:username username
+                   #:role role)
         (set-user-password password)))
 
   (with-handlers ([exn:fail:sql:constraint-violation?