Add snac service

Evgeny PisemskySun Nov 09 14:00:46+0300 2025

9f134d8

Add snac service

modules/cogd/services/fediverse.scm unknown status 1

1+
;;; SPDX-FileCopyrightText: 2025 Evgeny Pisemsky <mail@pisemsky.site>
2+
;;;
3+
;;; SPDX-License-Identifier: GPL-3.0-or-later
4+
5+
(define-module (cogd services fediverse))
6+
7+
(use-modules (guix gexp)
8+
             (guix records)
9+
             (gnu packages admin)
10+
             (gnu packages fediverse)
11+
             (gnu system shadow)
12+
             (gnu services)
13+
             (gnu services shepherd))
14+
15+
(export snac-configuration
16+
        snac-configuration?
17+
        snac-configuration-package
18+
        snac-configuration-network-address
19+
        snac-configuration-network-port
20+
        snac-configuration-host-name
21+
        snac-service-type)
22+
23+
(define snac-home "/var/lib/snac")
24+
25+
(define-record-type* <snac-configuration>
26+
  snac-configuration
27+
  make-snac-configuration
28+
  snac-configuration?
29+
  (package
30+
   snac-configuration-package
31+
   (default snac2))
32+
  (network-address
33+
   snac-configuration-network-address
34+
   (default "127.0.0.1"))
35+
  (network-port
36+
   snac-configuration-network-port
37+
   (default "8001"))
38+
  (host-name
39+
   snac-configuration-host-name
40+
   (default "localhost")))
41+
42+
(define snac-accounts
43+
  (const
44+
   (list (user-group
45+
          (name "snac")
46+
          (system? #t))
47+
         (user-account
48+
          (name "snac")
49+
          (group "snac")
50+
          (system? #t)
51+
          (home-directory snac-home)))))
52+
53+
(define (snac-wrapper config)
54+
  (match-record config <snac-configuration>
55+
                (package network-address network-port host-name)
56+
    (program-file
57+
     "snac-wrapper"
58+
     (let ((program (file-append package "/bin/snac"))
59+
           (basedir (string-append snac-home "/data")))
60+
       #~(begin
61+
           (use-modules (ice-9 popen))
62+
           (unless (file-exists? (string-append #$basedir "/server.json"))
63+
             (let ((port (open-pipe* OPEN_WRITE #$program "init" #$basedir)))
64+
               (display (string-append #$network-address "\r\n"
65+
                                       #$network-port "\r\n"
66+
                                       #$host-name "\r\n\r\n\r\n") port)
67+
               (close-pipe port)))
68+
           (system* #$program "upgrade" #$basedir)
69+
           (execl #$program #$program "httpd" #$basedir))))))
70+
71+
(define (snac-shepherd-service config)
72+
  (list (shepherd-service
73+
          (documentation "Run the Snac instance.")
74+
          (provision '(snac))
75+
          (requirement '(user-processes networking))
76+
          (start #~(make-forkexec-constructor
77+
                    (list #$(snac-wrapper config))
78+
                    #:user "snac"
79+
                    #:group "snac"))
80+
          (stop #~(make-kill-destructor)))))
81+
82+
(define snac-service-type
83+
  (service-type
84+
   (description "Run the Snac instance.")
85+
   (name 'snac)
86+
   (extensions
87+
    (list (service-extension account-service-type snac-accounts)
88+
          (service-extension shepherd-root-service-type snac-shepherd-service)))
89+
   (default-value (snac-configuration))))
modules/cogd/tests/fediverse.scm unknown status 1
1+
;;; SPDX-FileCopyrightText: 2025 Evgeny Pisemsky <mail@pisemsky.site>
2+
;;;
3+
;;; SPDX-License-Identifier: GPL-3.0-or-later
4+
5+
(define-module (cogd tests fediverse))
6+
7+
(use-modules (gnu tests)
8+
             (gnu system vm)
9+
             (gnu services)
10+
             (gnu services networking)
11+
             (guix modules)
12+
             (guix gexp)
13+
             (cogd services fediverse))
14+
15+
(export test-snac)
16+
17+
(define (run-snac-test)
18+
  (define os
19+
    (marionette-operating-system
20+
     (simple-operating-system (service dhcpcd-service-type)
21+
                              (service snac-service-type
22+
                                       (snac-configuration
23+
                                        (network-address "0.0.0.0"))))
24+
     #:imported-modules (source-module-closure
25+
                         '((gnu services herd)))))
26+
27+
  (define vm
28+
    (virtual-machine
29+
      (operating-system os)
30+
      (port-forwardings `((8001 . 8001)))))
31+
32+
  (define test
33+
    (with-imported-modules '((gnu build marionette))
34+
      #~(begin
35+
          (use-modules (srfi srfi-11)
36+
                       (srfi srfi-64)
37+
                       (web uri)
38+
                       (web client)
39+
                       (web response)
40+
                       (gnu build marionette))
41+
42+
          (define marionette
43+
            (make-marionette (list #$vm)))
44+
45+
          (test-runner-current (system-test-runner #$output))
46+
          (test-begin "snac")
47+
48+
          (test-assert "service started"
49+
            (marionette-eval
50+
             '(begin
51+
                (use-modules (gnu services herd))
52+
                (wait-for-service 'snac))
53+
             marionette))
54+
55+
          (test-assert "service port bound"
56+
            (wait-for-tcp-port 8001 marionette))
57+
58+
          (test-assert "service config created"
59+
            (marionette-eval
60+
             '(file-exists? "/var/lib/snac/data/server.json")
61+
             marionette))
62+
63+
          (test-equal "service responded on http"
64+
            200
65+
            (begin
66+
              (let-values (((response text)
67+
                            (http-get "http://localhost:8001")))
68+
                (response-code response))))
69+
70+
          (test-end))))
71+
72+
  (gexp->derivation "snac-test" test))
73+
74+
(define test-snac
75+
  (system-test
76+
   (name "snac")
77+
   (description "Test a Snac instance.")
78+
   (value (run-snac-test))))
79+
80+
test-snac