aboutsummaryrefslogtreecommitdiff
path: root/gnu/tests/guix.scm
blob: 6139e31cf0c8a461f1e88503fc7a2387f3cdb3a7 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;;
;;; 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 guix)
  #:use-module (gnu tests)
  #:use-module (gnu system)
  #:use-module (gnu system file-systems)
  #:use-module (gnu system shadow)
  #:use-module (gnu system vm)
  #:use-module (gnu services)
  #:use-module (gnu services guix)
  #:use-module (gnu services databases)
  #:use-module (gnu services shepherd)
  #:use-module (gnu services networking)
  #:use-module (gnu packages databases)
  #:use-module (guix packages)
  #:use-module (guix modules)
  #:use-module (guix records)
  #:use-module (guix gexp)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (ice-9 match)
  #:export (%test-guix-data-service))


;;;
;;; Guix Data Service
;;;

(define guix-data-service-initial-database-setup-service
  (let ((user "guix_data_service")
        (name "guix_data_service"))
    (define start-gexp
      #~(lambda ()
          (let ((pid (primitive-fork))
                (postgres (getpwnam "postgres")))
            (if (eq? pid 0)
                (dynamic-wind
                  (const #t)
                  (lambda ()
                    (setgid (passwd:gid postgres))
                    (setuid (passwd:uid postgres))
                    (primitive-exit
                     (if (and
                          (zero?
                           (system* #$(file-append postgresql "/bin/createuser")
                                    #$user))
                          (zero?
                           (system* #$(file-append postgresql "/bin/createdb")
                                    "-O" #$user #$name)))
                         0
                         1)))
                  (lambda ()
                    (primitive-exit 1)))
                (zero? (cdr (waitpid pid)))))))

    (shepherd-service
     (requirement '(postgres))
     (provision '(guix-data-service-initial-database-setup))
     (start start-gexp)
     (stop #~(const #f))
     (respawn? #f)
     (one-shot? #t)
     (documentation "Setup Guix Data Service database."))))

(define %guix-data-service-os
  (simple-operating-system
   (service dhcp-client-service-type)
   (service postgresql-service-type
            (postgresql-configuration
             (config-file
              (postgresql-config-file
               (hba-file
                (plain-file "pg_hba.conf"
                            "
local	all	all			trust
host	all	all	127.0.0.1/32 	trust
host	all	all	::1/128 	trust"))))))
   (service guix-data-service-type
            (guix-data-service-configuration
             (host "0.0.0.0")))
   (simple-service 'guix-data-service-database-setup
                   shepherd-root-service-type
                   (list guix-data-service-initial-database-setup-service))))

(define (run-guix-data-service-test)
  (define os
    (marionette-operating-system
     %guix-data-service-os
     #:imported-modules '((gnu services herd)
                          (guix combinators))))

  (define forwarded-port 8080)

  (define vm
    (virtual-machine
     (operating-system os)
     (memory-size 1024)
     (port-forwardings `((,forwarded-port . 8765)))))

  (define test
    (with-imported-modules '((gnu build marionette))
      #~(begin
          (use-modules (srfi srfi-11) (srfi srfi-64)
                       (gnu build marionette)
                       (web uri)
                       (web client)
                       (web response))

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

          (mkdir #$output)
          (chdir #$output)

          (test-begin "guix-data-service")

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

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

          (test-equal "http-get"
            200
            (let-values
                (((response text)
                  (http-get #$(simple-format
                               #f "http://localhost:~A/healthcheck" forwarded-port)
                            #:decode-body? #t)))
              (response-code response)))

          (test-end)
          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))

  (gexp->derivation "guix-data-service-test" test))

(define %test-guix-data-service
  (system-test
   (name "guix-data-service")
   (description "Connect to a running Guix Data Service.")
   (value (run-guix-data-service-test))))
(curl (assoc-ref inputs "curl")) (fribidi (assoc-ref inputs "fribidi")) (rlwrap (assoc-ref inputs "rlwrap"))) (wrap-program bin `("PATH" ":" prefix (,(string-append out "/bin:" curl "/bin:" fribidi "/bin:" rlwrap "/bin"))))))) (add-after 'unpack 'emacs-make-autoloads (assoc-ref emacs:%standard-phases 'make-autoloads)) (add-after 'install 'emacs-install (assoc-ref emacs:%standard-phases 'install)) (add-after 'emacs-install 'emacs-build (assoc-ref emacs:%standard-phases 'build))) #:make-flags (list (string-append "PREFIX=" %output) "NETWORK_ACCESS=no test") #:imported-modules (,@%default-gnu-imported-modules (guix build emacs-build-system) (guix build emacs-utils)) #:modules ((guix build gnu-build-system) ((guix build emacs-build-system) #:prefix emacs:) (guix build utils)) #:test-target "test")) (inputs (list bash-minimal curl fribidi rlwrap)) (native-inputs (list emacs-minimal util-linux)) ; hexdump, for the test (home-page "https://www.soimort.org/translate-shell/") (synopsis "Translations from the command line") (description "Translate Shell (formerly Google Translate CLI) is a command-line translator powered by Google Translate (default), Bing Translator, Yandex.Translate and Apertium. It gives you easy access to one of these translation engines from your terminal.") (license license:public-domain))) (define-public lttoolbox (package (name "lttoolbox") (version "3.5.4") (source (origin (method url-fetch) (uri (string-append "https://github.com/apertium/lttoolbox/releases/download/v" version "/lttoolbox-" version ".tar.xz")) (sha256 (base32 "0kn9xg9sc64amd6ah5gi4qij0bhfbmc2jjvxbjjrsdd8iq054cgm")))) (build-system gnu-build-system) (arguments `(#:configure-flags (list "--disable-static") #:phases (modify-phases %standard-phases (replace 'bootstrap ;; The included ./autogen.sh unconditionally runs ./configure before ;; its shebangs have been patched. (lambda _ (invoke "autoreconf" "-vfi")))))) (inputs (list libxml2)) (native-inputs (list autoconf automake libtool pkg-config)) (home-page "https://wiki.apertium.org/wiki/Lttoolbox") (synopsis "Lexical processing toolbox") (description "Lttoolbox is a toolbox for lexical processing, morphological analysis and generation of words. Analysis is the process of splitting a word (e.g. cats) into its lemma \"cat\" and the grammatical information @code{<n><pl>}. Generation is the opposite process.") (license (list license:gpl2 ; main license license:expat)))) ; utf8/* (define-public apertium (package (name "apertium") (version "3.5.2") (source (origin (method url-fetch) (uri (string-append "https://github.com/apertium/apertium/releases/download/v" version "/apertium-" version ".tar.gz")) (sha256 (base32 "0lrx58ipx2kzh1pd3xm1viz05dqyrq38jbnj9dnk92c9ckkwkp4h")) (file-name (string-append name "-" version ".tar.gz")))) (build-system gnu-build-system) (inputs (list libxml2 libxslt lttoolbox pcre)) (native-inputs `(("apertium-get" ,(origin (method git-fetch) (uri (git-reference (url "https://github.com/apertium/apertium-get") (commit "692d030e68008fc123089cf2446070fe8c6e3a3b"))) (sha256 (base32 "0kgp68azvds7yjwfz57z8sa5094fyk5yr0qxzblrw7bisrrihnav")))) ("flex" ,flex) ("pkg-config" ,pkg-config) ;; python is only required for running the test suite ("python" ,python))) (arguments `(#:phases (modify-phases %standard-phases ;; If apertium-get does not exist in the source tree, the build tries ;; to download it using an svn checkout. To avoid this, copy ;; apertium-get into the source tree. (add-after 'unpack 'unpack-apertium-get (lambda* (#:key inputs #:allow-other-keys) (copy-recursively (assoc-ref inputs "apertium-get") "apertium/apertium-get") #t))))) (home-page "https://www.apertium.org/") (synopsis "Rule based machine translation system") (description "Apertium is a rule based machine translation system featuring a shallow-transfer machine translation engine. The design of the system makes translations fast (translating tens of thousands of words per second on ordinary desktop computers) and, in spite of the errors, reasonably intelligible and easily correctable.") (license (list license:gpl2 ; main license license:expat)))) ; utf8/* (define-public sdcv (package (name "sdcv") (version "0.5.5") (source (origin (method git-fetch) (uri (git-reference (url "https://github.com/Dushistov/sdcv/") (commit (string-append "v" version)))) (file-name (git-file-name name version)) (sha256 (base32 "17jwcgc3jdp41rvxqi7zdsysfpjgzqq4z1l345qwffp1an6yaaqk")))) (build-system cmake-build-system) (arguments `(#:configure-flags '("-DBUILD_TESTS=YES") #:phases (modify-phases %standard-phases (add-after 'build 'build-lang (lambda _ (invoke "make" "lang"))) (add-before 'check 'pre-check (lambda _ (setenv "HOME" (getcwd)) #t))))) (native-inputs `(("gettext" ,gettext-minimal) ("pkg-config" ,pkg-config) ;; For tests. ("jq" ,jq))) (inputs (list glib ncurses readline zlib)) (home-page "https://dushistov.github.io/sdcv/") (synopsis "Console version of StarDict") (description "sdcv is simple text-based utility for work with dictionaries in StarDict's format.") (license license:gpl2+))) (define-public skk-jisyo (let ((commit "38c81dbc74cdbdead843364023dea837f239a48c") (revision "0")) (package (name "skk-jisyo") (version (git-version "0" revision commit)) (source (origin (method git-fetch) (uri (git-reference (url "https://github.com/skk-dev/dict") (commit commit))) (file-name (git-file-name name version)) (sha256 (base32 "121j73bgd7fvj7zvaidqvgzfdvimig3f0vsyfv4vndwfgskh2r7z")))) (build-system copy-build-system) (arguments '(#:install-plan '(("./" "share/skk" #:include-regexp ("SKK-JISYO\\.*") #:exclude-regexp ("\\.gz$" "\\.md5$") #:exclude ("SKK-JISYO.pubdic+" "SKK-JISYO.wrong.annotated" "SKK-JISYO.wrong"))) #:phases (modify-phases %standard-phases (add-before 'install 'decompress (lambda* (#:key outputs #:allow-other-keys) (map (lambda (arg) (invoke "gzip" "-v" "-d" arg)) (find-files "." "SKK-JISYO\\..*\\.gz$")) (invoke "tar" "xvf" "zipcode.tar.gz")))))) (home-page "https://skk-dev.github.io/dict/") (synopsis "Jisyo (dictionary) files for the SKK Japanese-input software") (description "This package provides @file{SKK-JISYO.L}, the standard dictionary file for SKK Japanese input systems, and various dictionary files. @file{SKK-JISYO.L} can be used with @code{emacs-ddskk} or @code{uim} package.") (license license:gpl2+)))) (define-public freedict-tools (package (name "freedict-tools") (version "0.6.0") (source (origin (method git-fetch) (uri (git-reference (url "https://github.com/freedict/tools") (commit "3596640e6e0582cc5fb76a342e5d8e7413aa4b34"))) ;"0.6.0" tag (file-name (git-file-name name version)) (sha256 (base32 "1raayynvn1j8x0ck8pnbbljl6zxnsyzzil7y54xz03dpj7k9w7mk")) (patches (search-patches "freedict-tools-fix-determinism.patch")))) (inputs (list espeak-ng python perl gzip tar libxslt dictd perl-libxml)) (arguments (list #:tests? #f #:phases #~(modify-phases %standard-phases (delete 'configure) (add-before 'build 'set-prefix-in-makefile (lambda* (#:key inputs #:allow-other-keys) (substitute* "Makefile" (("PREFIX \\?=.*") (string-append "PREFIX = " #$output "\n"))) (substitute* "mk/dicts.mk" (("available_platforms := src dictd slob") "available_platforms := dictd"))))))) (build-system gnu-build-system) (synopsis "Build and manage FreeDict dictionaries") (description "FreeDict is a project that offers over 140 free dictionaries in about 45 languages, with the right to study, change and modify them. You can use them offline on your computer or mobile phone and export them to any format and application. In order to limit store size and build complexity, only the build targets that build dictionaries in dictd format are retained when this Guix package is installed.") (home-page "https://freedict.org") (license license:gpl2+))) (define-public freedict-dictionaries (let ((commit "914b5f754b695e9422bf951837b0682a077e244e") (revision "0")) (package (name "freedict-dictionaries") (version (git-version "0.0.0" revision commit)) (source (origin (method git-fetch) (uri (git-reference (url "https://github.com/freedict/fd-dictionaries") (commit commit))) (file-name (git-file-name name version)) (sha256 (base32 "0a8k5rq94rl1nmz0354sx2gmyqica0yjavirh5v5wdybkfq8nv83")))) (inputs (list espeak-ng libxslt dictd perl-libxml freedict-tools)) (native-inputs (list python perl)) (arguments (list ;; "validation" target fails because of hardcoded ;; path /usr/bin/xmllint in freedict-tools #:tests? #f #:make-flags #~(list (string-append "PREFIX=" #$output)) #:phases #~(modify-phases %standard-phases (delete 'configure) (add-before 'build 'set-tools-prefix-in-makefile (lambda* (#:key inputs #:allow-other-keys) (substitute* "Makefile" (("FREEDICT_TOOLS \\?= ../tools") (string-append "export FREEDICT_TOOLS = " #$(file-append (this-package-input "freedict-tools") "/share/freedict"))))))))) (build-system gnu-build-system) (synopsis "Multilingual dictionaries compiled to the DICT format") (description "FreeDict is a project that offers over 140 free dictionaries in about 45 languages, with the right to study, change and modify them. You can use them offline on your computer or mobile phone and export them to any format and application.") (home-page "https://freedict.org") (license license:gpl2+))))