;;; guix-forge --- Guix software forge meta-service
;;; Copyright © 2023–2025 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2024 jgart <jgart@dismail.de>
;;;
;;; This file is part of guix-forge.
;;;
;;; guix-forge 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.
;;;
;;; guix-forge 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 guix-forge.  If not, see
;;; <https://www.gnu.org/licenses/>.

(define-module (forge klaus)
  #:use-module (forge environment)
  #:use-module ((forge git) #:select (git-without-safe-directory-check))
  #:use-module (forge gunicorn)
  #:use-module (forge nginx)
  #:use-module (forge socket)
  #:use-module ((gnu packages python-xyz)
                #:select (python-docutils python-markdown))
  #:use-module ((gnu packages version-control)
                #:select (python-klaus)
                #:prefix guix:)
  #:use-module (gnu services)
  #:use-module ((gnu services web) #:select (nginx-server-configuration
                                             nginx-location-configuration))
  #:use-module (gnu system file-systems)
  #:use-module (guix deprecation)
  #:use-module (guix packages)
  #:use-module (guix records)
  #:export (<klaus-configuration>
            klaus-configuration
            klaus-configuration?
            klaus-configuration-python-klaus
            klaus-configuration-server-name
            klaus-configuration-socket
            klaus-configuration-repository-directory
            klaus-configuration-site-name
            klaus-service-type
            klaus-gunicorn-app))

(define-public python-klaus
  (package
    (inherit guix:python-klaus)
    (inputs
     ;; We use klaus to serve shared repositories. But, git's safe directory
     ;; check does not permit us to use shared repositories. Disable it. The
     ;; more long term solution is to rewrite klaus to not use the git CLI at
     ;; all. See https://github.com/jonashaag/klaus/issues/322
     (modify-inputs (package-inputs guix:python-klaus)
       (replace "git-minimal" git-without-safe-directory-check)))
    (propagated-inputs
     (modify-inputs (package-propagated-inputs guix:python-klaus)
       ;; Add optional dependencies for markup rendering.
       (prepend python-docutils python-markdown)))))

(define-record-type* <klaus-configuration>
  klaus-configuration make-klaus-configuration
  klaus-configuration?
  (python-klaus klaus-configuration-python-klaus
                (default python-klaus))
  (server-name klaus-configuration-server-name)
  (socket klaus-configuration-socket
          (default (forge-unix-socket
                    (path "/var/run/gunicorn/klaus/socket"))))
  (repository-directory klaus-configuration-repository-directory
                        (default "/srv/git"))
  (site-name klaus-configuration-site-name
             (default #f)))

(define klaus-gunicorn-apps
  (match-record-lambda <klaus-configuration>
    (python-klaus socket repository-directory site-name)
    (list (gunicorn-app
           (name "klaus")
           (package python-klaus)
           (wsgi-app-module "klaus.contrib.wsgi_autoreload")
           (sockets (list socket))
           (environment-variables (cons (environment-variable
                                         (name "KLAUS_REPOS_ROOT")
                                         (value repository-directory))
                                        (if site-name
                                            (list (environment-variable
                                                   (name "KLAUS_SITE_NAME")
                                                   (value site-name)))
                                            (list))))
           (mappings (list (file-system-mapping
                            (source repository-directory)
                            (target source))))))))

(define klaus-nginx-server-blocks
  (match-record-lambda <klaus-configuration>
    (server-name socket)
    (list (nginx-server-configuration
           (server-name (list server-name))
           (locations
            (list (nginx-location-configuration
                   (uri "/")
                   (body (list (socket->nginx-proxy-pass socket))))))))))

(define klaus-service-type
  (service-type
   (name 'klaus)
   (description "Run klaus.")
   (extensions (list (service-extension gunicorn-service-type
                                        klaus-gunicorn-apps)
                     (service-extension forge-nginx-service-type
                                        klaus-nginx-server-blocks)))))

(define-deprecated (klaus-gunicorn-app repository-directory
                                       #:key
                                       (klaus python-klaus)
                                       (sockets (list (forge-unix-socket
                                                       (path "/var/run/gunicorn/klaus/socket"))))
                                       site-name)
  klaus-service-type
  "Return a @code{<gunicorn-app>} object to deploy klaus.

@var{repository-directory} is the path to the directory containing git
repositories to serve.

@var{klaus} is the klaus package to use.

@var{sockets} is a list of @code{<forge-ip-socket>} or
@code{<forge-unix-socket>} objects describing sockets to listen on.

@var{site-name} is the name of the klaus site to be displayed in the
banner."
  (gunicorn-app
   (name "klaus")
   (package klaus)
   (wsgi-app-module "klaus.contrib.wsgi_autoreload")
   (sockets sockets)
   (environment-variables (cons (environment-variable
                                 (name "KLAUS_REPOS_ROOT")
                                 (value repository-directory))
                                (if site-name
                                    (list (environment-variable
                                           (name "KLAUS_SITE_NAME")
                                           (value site-name)))
                                    (list))))
   (mappings (list (file-system-mapping
                    (source repository-directory)
                    (target source))))))