aboutsummaryrefslogtreecommitdiff
path: root/tests/base32.scm
blob: a999edcaccba2afc7b5d44551280413982312a73 (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
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2015, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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 (test-base32)
  #:use-module (gcrypt hash)
  #:use-module (guix base32)
  #:use-module (guix utils)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 match)
  #:use-module (rnrs bytevectors)
  #:use-module (rnrs io ports))

;; Test the (guix base32) module.

(test-begin "base32")

(test-assert "bytevector->base32-string"
  (fold (lambda (bv expected result)
          (and result
               (string=? (bytevector->base32-string bv)
                         expected)))
        #t

        ;; Examples from RFC 4648.
        (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar"))
        '(""
          "my"
          "mzxq"
          "mzxw6"
          "mzxw6yq"
          "mzxw6ytb"
          "mzxw6ytboi")))

(test-assert "base32-string->bytevector"
  (every (lambda (bv)
           (equal? (base32-string->bytevector
                    (bytevector->base32-string bv))
                   bv))
         ;; Examples from RFC 4648.
         (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar"))))

(test-assert "nix-base32-string->bytevector"
  (every (lambda (bv)
           (equal? (nix-base32-string->bytevector
                    (bytevector->nix-base32-string bv))
                   bv))
         ;; Examples from RFC 4648.
         (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar"))))

(test-equal "&invalid-base32-character"
  #\e
  (guard (c ((invalid-base32-character? c)
             (invalid-base32-character-value c)))
    (nix-base32-string->bytevector
     (string-append (make-string 51 #\a) "e"))))

(test-end)
manager")) (type 'network-management) (snippet '((service network-manager-service-type) (service wpa-supplicant-service-type)))) (system-service (name (G_ "Connman network connection manager")) (type 'network-management) (snippet '((service connman-service-type) (service wpa-supplicant-service-type)))) (system-service (name (G_ "DHCP client (dynamic IP address assignment)")) (type 'network-management) (snippet '((service dhcp-client-service-type)))) (system-service (name (G_ "Static networking service.")) (type 'network-management) (snippet `((service static-networking-service-type (list %loopback-static-networking (static-networking (addresses (list (network-address (device "eth0") ,(comment (G_ ";; Fill-in your IP.\n")) (value "192.168.178.10/24")))) (routes (list (network-route (destination "default") ,(comment (G_ ";; Fill-in your gateway IP.\n")) (gateway "192.168.178.1")))) (requirement '()) (provision '(networking)) ,(comment (G_ ";; Fill-in your nameservers.\n")) (name-servers '("192.168.178.1")))))))) ;; Dealing with documents. (system-service (name (G_ "CUPS printing system (no Web interface by default)")) (type 'document) (snippet '((service cups-service-type))))))) (define (desktop-system-service? service) "Return true if SERVICE is a desktop environment service." (eq? 'desktop (system-service-type service))) (define (system-services->configuration services) "Return the configuration field for SERVICES." (let* ((snippets (append-map system-service-snippet services)) (packages (append-map system-service-packages services)) (desktop? (find desktop-system-service? services)) (base (if desktop? (if (target-hurd?) '%desktop-services/hurd '%desktop-services) (if (target-hurd?) '%base-services/hurd '%base-services))) (native-console-font (match (getenv "LANGUAGE") ((or "be" "bg" "el" "eo" "kk" "ky" "mk" "mn" "ru" "sr" "tg" "uk") "LatGrkCyr-8x16") (_ #f))) (services (if native-console-font `(modify-services ,base (console-font-service-type config => (map (lambda (tty) (cons (car tty) ,native-console-font)) config))) base)) (service-heading (list (vertical-space 1) (comment (G_ "\ ;; Below is the list of system services. To search for available ;; services, run 'guix system search KEYWORD' in a terminal.\n")))) (package-heading (list (vertical-space 1) (comment (G_ "\ ;; Packages installed system-wide. Users can also install packages ;; under their own account: use 'guix search KEYWORD' to search ;; for packages and 'guix install PACKAGE' to install a package.\n"))))) (if (null? snippets) `(,@(if (null? packages) (if (target-hurd?) `(,@package-heading (packages %base-packages/hurd)) '()) `(,@package-heading (packages (append (list ,@packages) ,(if (target-hurd?) '%base-packages/hurd '%base-packages))))) ,@service-heading (services ,services)) `(,@(if (null? packages) (if (target-hurd?) `(,@package-heading (packages %base-packages/hurd)) '()) `(,@package-heading (packages (append (list ,@packages) ,(if (target-hurd?) '%base-packages/hurd '%base-packages))))) ,@service-heading (services (append (list ,@snippets ,@(if desktop? ;; XXX: Assume 'keyboard-layout' is in ;; scope. `((set-xorg-configuration (xorg-configuration (keyboard-layout keyboard-layout)))) '())) ,(vertical-space 1) ,(comment (G_ "\ ;; This is the default list of services we ;; are appending to.\n")) ,services))))))