;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.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 services cgit)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages version-control)
  #:use-module (gnu services base)
  #:use-module (gnu services configuration)
  #:use-module (gnu services shepherd)
  #:use-module (gnu services web)
  #:use-module (gnu services)
  #:use-module (gnu system shadow)
  #:use-module (guix gexp)
  #:use-module (guix packages)
  #:use-module (guix records)
  #:use-module (guix store)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:export (repository-cgit-configuration
            cgit-configuration
            %cgit-configuration-nginx
            cgit-configuration-nginx-config
            opaque-cgit-configuration
            cgit-service-type))

;;; Commentary:
;;;
;;; This module provides a service definition for the Cgit a web frontend for
;;; Git repositories written in C.
;;;
;;; Note: fields of <cgit-configuration> and <repository-cgit-configuration>
;;; should be specified in the specific order.
;;;
;;; Code:

(define %cgit-configuration-nginx
  (nginx-server-configuration
   (root cgit)
   (locations
    (list
     (nginx-location-configuration
      (uri "@cgit")
      (body '("fastcgi_param SCRIPT_FILENAME $document_root/lib/cgit/cgit.cgi;"
              "fastcgi_param PATH_INFO $uri;"
              "fastcgi_param QUERY_STRING $args;"
              "fastcgi_param HTTP_HOST $server_name;"
              "fastcgi_pass 127.0.0.1:9000;")))))
   (try-files (list "$uri" "@cgit"))
   (listen '("80"))
   (ssl-certificate #f)
   (ssl-certificate-key #f)))


;;;
;;; Serialize <cgit-configuration>
;;;

(define (uglify-field-name field-name)
  (string-delete #\? (symbol->string field-name)))

(define (serialize-field field-name val)
  #~(format #f "~a=~a\n" #$(uglify-field-name field-name) #$val))

(define (serialize-string field-name val)
  (if (and (string? val) (string=? val ""))
      ""
      (serialize-field field-name val)))

(define (serialize-list field-name val)
  (if (null? val) "" (serialize-field field-name (string-join val))))

(define robots-list? list?)

(define (serialize-robots-list field-name val)
  (if (null? val) "" (serialize-field field-name (string-join val ", "))))

(define (integer? val)
  (exact-integer? val))

(define (serialize-integer field-name val)
  (serialize-field field-name (number->string val)))

(define (serialize-boolean field-name val)
  (serialize-integer field-name (if val 1 0)))

(define (serialize-repository-cgit-configuration x)
  (serialize-configuration x repository-cgit-configuration-fields))

(define (repository-cgit-configuration-list? val)
  (list? val))

(define (serialize-repository-cgit-configuration-list field-name val)
  #~(string-append
     #$@(map serialize-repository-cgit-configuration val)))

(define (file-object? val)
  (or (file-like? val) (string? val)))
(define (serialize-file-object field-name val)
  (serialize-string field-name val))

(define (project-list? val)
  (or (list? val)
      (file-object? val)))


;;;
;;; Serialize <nginx-server-configuration>
;;;

(define (nginx-server-configuration-list? val)
  (and (list? val) (and-map nginx-server-configuration? val)))

(define (serialize-nginx-server-configuration-list field-name val)
  "")


;;;
;;; Serialize <repository-cgit-configuration>
;;;

(define (serialize-repo-field field-name val)
  #~(format #f "repo.~a=~a\n" #$(uglify-field-name field-name) #$val))

(define (serialize-repo-list field-name val)
  (if (null? val) "" (serialize-repo-field field-name (string-join val))))

(define repo-boolean? boolean?)

(define (serialize-repo-integer field-name val)
  (serialize-repo-field field-name (number->string val)))

(define (serialize-repo-boolean field-name val)
  (serialize-repo-integer field-name (if val 1 0)))
(define-maybe repo-boolean)

(define repo-list? list?)

(define repo-string? string?)

(define (serialize-repo-string field-name val)
  (if (string=? val "") "" (serialize-repo-field field-name val)))

(define repo-file-object? file-object?)
(define serialize-repo-file-object serialize-repo-string)

(define module-link-path? list?)

(define (serialize-module-link-path field-name val)
  (if (null? val) ""
      (match val
        ((path text)
         (format #f "repo.module-link.~a=~a\n" path text)))))

(define (serialize-project-list _ val)
  (if (null? val) ""
      (serialize-field
       'project-list
       (if (file-object? val)
           val
           (plain-file "project-list" (string-join val "\n"))))))

(define (serialize-extra-options extra-options)
  (string-join extra-options "\n" 'suffix))

(define repository-directory? string?)

(define (serialize-repository-directory _ val)
  (if (string=? val "") "" (format #f "scan-path=~a\n" val)))

(define mimetype-alist? list?)

(define (serialize-mimetype-alist field-name val)
  (format #f "# Mimetypes\n