;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>.
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix 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 General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu tests telephony)
  #:use-module (gnu)
  #:use-module (gnu packages)
  #:use-module (gnu packages guile)
  #:use-module (gnu tests)
  #:use-module (gnu system vm)
  </td></tr></table>
<table class='tabs'><tr><td>
<a class='active' href='/guix/about/'>about</a><a href='/guix/'>summary</a><a href='/guix/refs/?id=48a51af9d2c14e46ee073c6925e0d1b68e3292c9'>refs</a><a href='/guix/log/'>log</a><a href='/guix/tree/?id=48a51af9d2c14e46ee073c6925e0d1b68e3292c9'>tree</a><a href='/guix/commit/?id=48a51af9d2c14e46ee073c6925e0d1b68e3292c9'>commit</a><a href='/guix/diff/?id=48a51af9d2c14e46ee073c6925e0d1b68e3292c9'>diff</a></td><td class='form'><form class='right' method='get' action='/guix/log/'>
<input type='hidden' name='id' value='48a51af9d2c14e46ee073c6925e0d1b68e3292c9'/><select name='qt'>
<option value='grep'>log msg</option>
<option value='author'>author</option>
<option value='committer'>committer</option>
<option value='range'>range</option>
</select>
<input class='txt' type='search' size='10' name='q' value=''/>
<input type='submit' value='search'/>
</form>
</td></tr></table>
<div class='content'><div id='summary'><pre>
# This is a &quot;service unit file&quot; for the systemd init system to launch
# &apos;guix publish&apos;.  Drop it in /etc/systemd/system or similar to have
# &apos;guix publish&apos; automatically started.

[Unit]
Description=Publish the GNU Guix store
Requires=guix-daemon.service
PartOf=guix-daemon.service
After=guix-daemon.service

[Service]
ExecStart=@localstatedir@/guix/profiles/per-user/root/current-guix/bin/guix publish --user=nobody --port=8181
Environment=&apos;GUIX_LOCPATH=@localstatedir@/guix/profiles/per-user/root/guix-profile/lib/locale&apos; LC_ALL=en_US.utf8
StandardOutput=journal
StandardError=journal

# Despite the name, this is rate-limited: a broken daemon will eventually fail.
Restart=always

# See &lt;https://lists.gnu.org/archive/html/guix-devel/2016-04/msg00608.html&gt;.
TasksMax=1024

[Install]
WantedBy=multi-user.target
</pre>
</div></div> <!-- class=content -->
                         <div class=footer>generated by
                             <a href="https://git.zx2c4.com/cgit/about/">
                                 cgit
                             </a>
                         </div>
                        </div> <!-- id=cgit -->
</body>
</html>
   (firmware '())

    (services (cons* (service jami-service-type
                              (if provisioning?
                                  (jami-configuration
                                   (debug? #t)
                                   (accounts (list %dummy-jami-account)))
                                  (jami-configuration
                                   (debug? #t))))
                     (service dbus-root-service-type)
                     ;; The following services/packages are added for
                     ;; debugging purposes.
                     (service dhcp-client-service-type)
                     (service openssh-service-type
                              (openssh-configuration
                               (permit-root-login #t)
                               (allow-empty-passwords? #t)))
                     %base-services))
    (packages (cons* (specification->package "recutils")
                     (specification->package "strace")
                     %base-packages))))

(define %jami-os
  (make-jami-os))

(define %jami-os-provisioning
  (make-jami-os #:provisioning? #t))

(define* (run-jami-test #:key provisioning?)
  "Run tests in %JAMI-OS.  When PROVISIONING? is true, test the
accounts provisioning feature of the service."
  (define os (marionette-operating-system
              (if provisioning?
                  %jami-os-provisioning
                  %jami-os)
              #:imported-modules '((gnu services herd)
                                   (guix combinators))))
  (define vm (virtual-machine
              (operating-system os)
              (memory-size 512)))

  (define username (assoc-ref %jami-account-content-sexp
                              "Account.username"))

  (define test
    (with-imported-modules (source-module-closure
                            '((gnu build marionette)
                              (gnu build jami-service)))
      #~(begin
          (use-modules (rnrs base)
                       (srfi srfi-11)
                       (srfi srfi-64)
                       (gnu build marionette)
                       (gnu build jami-service))

          (define marionette
            (make-marionette (list #$vm)))

          (test-runner-current (system-test-runner #$output))
          (test-begin "jami")

          (test-assert "service is running"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (match (start-service 'jami)
                  (#f #f)
                  (('service response-parts ...)
                   (match (assq-ref response-parts 'running)
                     ((pid) (number? pid))))))
             marionette))

          (test-assert "service can be stopped"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd)
                             (rnrs base))
                (setenv "PATH" "/run/current-system/profile/bin")
                (let ((pid (match (start-service 'jami)
                             (#f #f)
                             (('service response-parts ...)
                              (match (assq-ref response-parts 'running)
                                ((pid) pid))))))

                  (assert (number? pid))

                  (match (stop-service 'jami)
                    (services           ;a list of service symbols
                     (member 'jami services)))
                  ;; Sometimes, the process still appear in pgrep, even
                  ;; though we are using waitpid after sending it SIGTERM
                  ;; in the service; use retries.
                  (with-retries 20 1
                    (not (zero? (status:exit-val
                                 (system* "pgrep" "jamid")))))))
             marionette))

          (test-assert "service can be restarted"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd)
                             (rnrs base))
                ;; Start and retrieve the current PID.
                (define pid (match (start-service 'jami)
                              (#f #f)
                              (('service response-parts ...)
                               (match (assq-ref response-parts 'running)
                                 ((pid) pid)))))
                (assert (number? pid))

                ;; Restart the service.
                (restart-service 'jami)

                (define new-pid (match (start-service 'jami)
                                  (#f #f)
                                  (('service response-parts ...)
                                   (match (assq-ref response-parts 'running)
                                     ((pid) pid)))))
                (assert (number? new-pid))

                (not (eq? pid new-pid)))
             marionette))

          (unless #$provisioning? (test-skip 1))
          (test-assert "jami accounts provisioning, account present"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd)
                             (rnrs base))
                ;; Accounts take some time to appear after being added.
                (with-retries 20 1
                  (with-shepherd-action 'jami ('list-accounts) results
                    (let ((account (assoc-ref (car results) #$username)))
                      (assert (string=? #$username
                                        (assoc-ref account
                                                   "Account.username")))))))
             marionette))

          (unless #$provisioning? (test-skip 1))
          (test-assert "jami accounts provisioning, allowed-contacts"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd)
                             (rnrs base)
                             (srfi srfi-1))

                ;; Public mode is disabled.
                (with-shepherd-action 'jami ('list-account-details)
                                      results
                  (let ((account (assoc-ref (car results) #$username)))
                    (assert (string=? "false"
                                      (assoc-ref account
                                                 "DHT.PublicInCalls")))))

                ;; Allowed contacts match those declared in the configuration.
                (with-shepherd-action 'jami ('list-contacts) results
                  (let ((contacts (assoc-ref (car results) #$username)))
                    (assert (lset= string-ci=? contacts '#$%allowed-contacts)))))
             marionette))

          (unless #$provisioning? (test-skip 1))
          (test-assert "jami accounts provisioning, moderators"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd)
                             (rnrs base)
                             (srfi srfi-1))

                ;; Moderators match those declared in the configuration.
                (with-shepherd-action 'jami ('list-moderators) results
                  (let ((moderators (assoc-ref (car results) #$username)))
                    (assert (lset= string-ci=? moderators '#$%moderators))))

                ;; Moderators can be added via the Shepherd action.
                (with-shepherd-action 'jami
                    ('add-moderator "cccccccccccccccccccccccccccccccccccccccc"
                                    #$username) results
                  (let ((moderators (car results)))
                    (assert (lset= string-ci=? moderators
                                   (cons "cccccccccccccccccccccccccccccccccccccccc"
                                         '#$%moderators))))))
             marionette))

          (unless #$provisioning? (test-skip 1))
          (test-assert "jami service actions, ban/unban contacts"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd)
                             (rnrs base)
                             (srfi srfi-1))

                ;; Globally ban a contact.
                (with-shepherd-action 'jami
                    ('ban-contact "1dbcb0f5f37324228235564b79f2b9737e9a008f") _
                  (with-shepherd-action 'jami ('list-banned-contacts) results
                    (every (match-lambda
                             ((username . banned-contacts)
                              (member "1dbcb0f5f37324228235564b79f2b9737e9a008f"
                                      banned-contacts)))
                           (car results))))

                ;; Ban a contact for a single account.
                (with-shepherd-action 'jami
                    ('ban-contact "dddddddddddddddddddddddddddddddddddddddd"
                                  #$username) _
                  (with-shepherd-action 'jami ('list-banned-contacts) results
                    (every (match-lambda
                             ((username . banned-contacts)
                              (let ((found? (member "dddddddddddddddddddddddddddddddddddddddd"
                                                    banned-contacts)))
                                (if (string=? #$username username)
                                    found?
                                    (not found?)))))
                           (car results)))))
             marionette))

          (unless #$provisioning? (test-skip 1))
          (test-assert "jami service actions, enable/disable accounts"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd)
                             (rnrs base))

                (with-shepherd-action 'jami
                    ('disable-account #$username) _
                  (with-shepherd-action 'jami ('list-accounts) results
                    (let ((account (assoc-ref (car results) #$username)))
                      (assert (string= "false"
                                       (assoc-ref account "Account.enable"))))))

                (with-shepherd-action 'jami
                    ('enable-account #$username) _
                  (with-shepherd-action 'jami ('list-accounts) results
                    (let ((account (assoc-ref (car results) #$username)))
                      (assert (string= "true"
                                       (assoc-ref account "Account.enable")))))))
             marionette))

          (unless #$provisioning? (test-skip 1))
          (test-assert "jami account parameters"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd)
                             (rnrs base)
                             (srfi srfi-1))

                (with-shepherd-action 'jami ('list-account-details) results
                  (let ((account-details (assoc-ref (car results)
                                                    #$username)))
                    (assert (lset<=
                             equal?
                             '(("Account.hostname" .
                                "bootstrap.me;fallback.another.host")
                               ("Account.peerDiscovery" . "false")
                               ("Account.rendezVous" . "true")
                               ("RingNS.uri" . "https://my.name.server"))
                             account-details)))))
             marionette))

          (test-end))))

  (gexp->derivation (if provisioning?
                        "jami-provisioning-test"
                        "jami-test")
    test))

(define %test-jami
  (system-test
   (name "jami")
   (description "Basic tests for the jami service.")
   (value (run-jami-test))))

(define %test-jami-provisioning
  (system-test
   (name "jami-provisioning")
   (description "Provisioning test for the jami service.")
   (value (run-jami-test #:provisioning? #t))))

;; Local Variables:
;; eval: (put 'with-retries 'scheme-indent-function 2)
;; End: