guix-tribes/tests/tribes-deploy-executor.scm

(define-module (tests tribes-deploy-executor)
  #:use-module (srfi srfi-64)
  #:use-module (tribes deploy executor)
  #:use-module (tribes deploy plan)
  #:use-module (tribes packages plugins)
  #:use-module (tribes plugins built-ins)
  #:export (run-tests))

(define valid-signer
  '(("id" . "signer-1")
    ("fingerprint" . "0123456789ABCDEF0123456789ABCDEF01234567")
    ("enabled" . #t)))

(define valid-channel
  '(("id" . "guix-tribes")
    ("channel_id" . "guix-tribes")
    ("url" . "https://git.example.test/guix-tribes.git")
    ("branch" . "main")
    ("commit" . "abc123")
    ("position" . 10)
    ("allowed_signer_ids" . ("signer-1"))
    ("introduction" . (("commit" . "intro123")
                       ("fingerprint" . "0123456789ABCDEF0123456789ABCDEF01234567")))))

(define valid-target
  `(("trusted_signers" . (,valid-signer))
    ("channels" . (,valid-channel))
    ("plugins" . ((("plugin_name" . "aether")
                   ("channel_id" . "guix-tribes")
                   ("enabled" . #t))))))

(define (error-code result)
  (let ((error (json-ref result "error")))
    (and (json-object? error) (json-ref error "code"))))

(define (run-tests)
  (test-begin "tribes-deploy-executor")

  (test-equal "deployment request plugins default to empty list"
    '()
    (deployment-request-plugins
     '(("schemaVersion" . "1")
       ("action" . "apply"))))

  (test-equal "deployment request plugins preserve names"
    '("aether")
    (deployment-request-plugins
     '(("schemaVersion" . "1")
       ("action" . "apply")
       ("plugins" . ("aether")))))

  (test-equal "host config plugins are updated in tribes block"
    '(("schemaVersion" . "1")
      ("tribes" . (("host" . "example.com")
                   ("plugins" . ("aether"))
                   ("disabledPlugins" . ())))
      ("edge" . (("certificateName" . "tribes"))))
    (host-config-with-plugins
     '(("schemaVersion" . "1")
       ("tribes" . (("host" . "example.com")
                    ("plugins" . ())))
       ("edge" . (("certificateName" . "tribes"))))
     '("aether")))

  (test-equal "system target plugin names include installed plugins"
    '("aether" "disabled")
    (system-target-plugin-names
     '(("plugins" . ((("plugin_name" . "aether")
                      ("enabled" . #t))
                     (("plugin_name" . "disabled")
                      ("enabled" . #f)))))))

  (test-equal "system target disabled plugin names include disabled plugins"
    '("disabled")
    (system-target-disabled-plugin-names
     '(("plugins" . ((("plugin_name" . "aether")
                      ("enabled" . #t))
                     (("plugin_name" . "disabled")
                      ("enabled" . #f)))))))

  (test-assert "legacy plans without resolved channel metadata still pull"
    (plan-requires-pull? '(("plan_hash" . "legacy"))))

  (test-assert "plans with an explicit empty channel delta skip pull"
    (not (plan-requires-pull?
          '(("plan_hash" . "plugin-only")
            ("resolved_channels" . #())))))

  (test-assert "plans with resolved channel changes still pull"
    (plan-requires-pull?
     '(("plan_hash" . "channel-update")
       ("resolved_channels" . #((("name" . "guix-tribes")))))))

  (test-equal "runtime capabilities come from built-in Tribes UI manifest"
    '("org.tribe-one.caps.ui@1")
    (tribes-plugin-definitions-provided-capabilities
     guix-tribes-built-in-plugin-definitions))

  (test-equal "host manifest requirements are satisfied by built-ins"
    '()
    guix-tribes-runtime-missing-capabilities)

  (test-equal "resolve-target emits channel-aware plugin package refs"
    '("aether")
    (let* ((plan (resolve-target valid-target))
           (hash-value (json-ref plan "plan_hash"))
           (resolved-plugins
            (let ((plugins (json-ref plan "resolved_plugins")))
              (if (vector? plugins) (vector->list plugins) plugins)))
           (aether (and (pair? resolved-plugins) (car resolved-plugins)))
           (package-ref (and (json-object? aether) (json-ref aether "package_ref"))))
      (test-assert "plan hash is present" (string? hash-value))
      (test-equal "channel commit is propagated to package ref"
        "abc123"
        (json-ref package-ref "commit"))
      (test-equal "registry version is used"
        "0.2.0"
        (json-ref package-ref "version"))
      (plan-plugins plan)))

  (test-equal "resolve-target accepts spaced introduction fingerprints"
    '("sender")
    (let* ((spaced-channel
            `(("id" . "guix-tribes")
              ("channel_id" . "guix-tribes")
              ("url" . "https://git.example.test/guix-tribes.git")
              ("branch" . "main")
              ("commit" . "abc123")
              ("position" . 10)
              ("allowed_signer_ids" . ("signer-1"))
              ("introduction" . (("commit" . "intro123")
                                 ("fingerprint" . "0123 4567 89AB CDEF 0123 4567 89AB CDEF 0123 4567")))))
           (plan
            (resolve-target
             `(("trusted_signers" . (,valid-signer))
               ("channels" . (,spaced-channel))
               ("plugins" . ((("plugin_name" . "sender")
                              ("channel_id" . "guix-tribes")
                              ("enabled" . #t))))))))
      (plan-plugins plan)))

  (test-equal "resolve-target satisfies org.tribe-one.caps.ui@1 from built-in Tribes UI"
    '("sender")
    (let ((plan
           (resolve-target
            `(("trusted_signers" . (,valid-signer))
              ("channels" . (,valid-channel))
              ("plugins" . ((("plugin_name" . "sender")
                             ("channel_id" . "guix-tribes")
                             ("enabled" . #t))))))))
      (plan-plugins plan)))

  (test-equal "resolve-target keeps disabled plugins installed but runtime-disabled"
    '(("aether") ("aether"))
    (let ((plan
           (resolve-target
            `(("trusted_signers" . (,valid-signer))
              ("channels" . (,valid-channel))
              ("plugins" . ((("plugin_name" . "aether")
                             ("channel_id" . "guix-tribes")
                             ("enabled" . #f))))))))
      (list (plan-plugins plan) (plan-disabled-plugins plan))))

  (test-equal "resolve-target rejects duplicate plugin requests"
    "duplicate_plugin"
    (error-code
     (resolve-target
      `(("trusted_signers" . (,valid-signer))
        ("channels" . (,valid-channel))
        ("plugins" . ((("plugin_name" . "aether") ("enabled" . #t))
                       (("plugin_name" . "aether") ("enabled" . #t))))))))

  (test-equal "resolve-target rejects unknown plugins"
    "manifest_invalid"
    (error-code
     (resolve-target
      `(("trusted_signers" . (,valid-signer))
        ("channels" . (,valid-channel))
        ("plugins" . ((("plugin_name" . "missing-plugin")
                       ("channel_id" . "guix-tribes")
                       ("enabled" . #t))))))))

  (test-equal "resolve-target rejects untrusted channels"
    "channel_untrusted"
    (error-code
     (resolve-target
      '(("trusted_signers" . ())
        ("channels" . ((("id" . "guix-tribes")
                        ("channel_id" . "guix-tribes")
                        ("url" . "https://git.example.test/guix-tribes.git")
                        ("commit" . "abc123")
                        ("position" . 10)
                        ("allowed_signer_ids" . ("signer-1"))
                        ("introduction" . (("commit" . "intro123")
                                           ("fingerprint" . "0123456789ABCDEF0123456789ABCDEF01234567"))))))
        ("plugins" . ((("plugin_name" . "aether")
                       ("channel_id" . "guix-tribes")
                       ("enabled" . #t))))))))

  (test-end "tribes-deploy-executor"))