(define-module (hidamari-blue gnu-social)
  #:use-module (guix utils)
  #:use-module (guix build utils)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix store)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix git-download)
  #:use-module (gnu packages web)
  #:use-module (gnu packages bash)
  #:use-module (gnu packages gettext)
  #:use-module (hidamari-blue php)
  #:use-module (gnu packages databases)
  #:use-module (guix build-system gnu)
  #:use-module (guix records)
  #:use-module (guix gexp)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-43)
  #:use-module (ice-9 match)

  #:use-module (gnu services)
  #:use-module (gnu services shepherd)
  #:use-module (gnu services web)
  #:use-module (gnu system shadow)

  #:export (gnu-social-service-type
            gnu-social-nginx-block
            gnu-social

            <gnu-social-config>
            gnu-social-config
            make-gnu-social-config
            gnu-social-config?

            gnu-social-site-name
            gnu-social-site-domain
            gnu-social-site-type
            gnu-social-avatar-dir
            gnu-social-attachments-dir
            gnu-social-pid-dir
            gnu-social-logfile
            gnu-social-ssl?
            gnu-social-db-user
            gnu-social-password-file
            gnu-social-db-host
            gnu-social-db-socket
            gnu-social-db-database
            gnu-social-admin-handle
            gnu-social-admin-email
            gnu-social-user
            gnu-social-gnu-social
            gnu-social-php
            gnu-social-mysql
            gnu-social-theme
            gnu-social-logo
            gnu-social-timezone
            gnu-social-language
            gnu-social-text-limit
            gnu-social-dupe-limit
            gnu-social-site-notice))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; START OF password stuff
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define alphanumeric-str "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890")
(define ascii-special-str "!\"#$%&'()*+,-./:;<=>?[\\]^_`{|}~  ")
(define (string->vector str) (list->vector (string->list str)))
(define alphanumeric (string->vector alphanumeric-str))
(define ascii (string->vector (string-append alphanumeric-str ascii-special-str)))

(define* (random-string str-length #:optional (alphabet ascii))
  (call-with-input-file "/dev/urandom"
    (lambda (port)
      (define alphabet-max (vector-length alphabet))
      (define (loop acc i)
	(if (< i str-length)
	  (cons (floor (/ (get-u8 port) alphabet-max))
	   acc)
	  (list->string acc)))
      (loop '() 0))))

(define (read-password-file file)
  (if (file-exists? file)
      (call-with-input-file file
        (lambda (port)
          (read port)))
      (error "Passoword file" file " does not exist.")))

(define (write-password-file file data)
  (define data-without-meta
    (filter (match-lambda 
	      (('meta:password-was-generated . x) #f)
	      (_ #t))
	    data))
  ;; touch file with limited permissions
  (call-with-output-file (string-append file ".tmp") (const #t))
  (chown file 0 0)
  (chmod file #o600)
  ;; write
  (call-with-output-file (string-append file ".tmp")
    (lambda (port)
      (write data-without-meta port)))
  ;; finalize
  (rename-file (string-append file ".tmp") file))

(define (optional-password secrets name)
  (assoc-ref secrets name))

(define (required-password secrets name)
  (define found (assoc name secrets))
  (if found
      (cdr found)
      (error "No secret named: " name " in password file.")))

(define* (generatable-password! secrets name length #:optional (alphabet ascii))
 (define found (assoc name secrets))
 (if found
     (cdr found)
     (let ((new-password (random-string alphabet)))
       (set! secrets (cons* (cons name new-password)
			    (cons 'meta:password-was-generated #t)
			    secrets))
       new-password)))

;;; Example:
;; (with-passwords
;;  "/root/guix.passwords-store"		; where it will be stored
;;  ((optional mysql-root-password)	; will be #f if it is not in the file
;;   ;; will be generated for 23 alphanumeric characters
;;   ;; and written to the file after the body is run.
;;   (generatable gnu-social-mysql-password 23 alphanumeric)
;;   ;; will throw an error if it is not in the file
;;   (required gnu-social-admin-password))	
;;  (init-gnu-social config
;; 		  mysql-root-password
;; 		  gnu-social-mysql-password
;; 		  gnu-social-admin-password))

(define-syntax with-passwords
  (syntax-rules (optional)
    ;; entry point
    ((_ file (bindings ...) body ...)
     ((lambda (%secrets)
	(binding %secrets file (bindings ...) body ...))
      (read-password-file file)))))
(define-syntax binding
  (syntax-rules (optional required generatable)
    ;; bindings
    ((binding %secrets file ((optional name) rest ...) body ...)
     (let ((name (optional-password %secrets 'name)))
       (binding %secrets file (rest ...) body ...)))
    ((binding %secrets file ((required name) rest ...)  body ...)
     (let ((name (required-password %secrets 'name)))
       (binding %secrets file (rest ...) body ...)))
    ((binding %secrets file ((generatable name length) rest ...) body ...)
     (let ((name (generatable-password! %secrets 'name length)))
       (binding %secrets file (rest ...) body ...)))
    ((binding %secrets file ((generatable name length alphabet) rest ...) body ...)
     (let ((name (generatable-password! %secrets 'name length alphabet)))
       (binding %secrets file(rest ...) body ...)))
    ;; final body
    ((binding %secrets file () body ...)
     (let ((result (begin body ...)))
       ;; write generated passwords before returning the result
       (when (assoc-ref %secrets 'meta:password-was-generated)
	 (write-password-file file %secrets))
       result))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; END OF password stuff
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (mysql-database-exists? database)
  ;;; TODO take mysql service settings
  (file-exists? (string-append "/var/lib/mysql/" database)))

;;; 

;;; TODO test profilesettings -> openID
;;; TODO config for optional different domains for static files
(define-record-type* <gnu-social-config>
  gnu-social-config make-gnu-social-config
  gnu-social-config?
  ;; --- mandetory during init ---
  (site-name       gnu-social-site-name
                   (default "gnu social"))
  (site-domain     gnu-social-site-domain
                   (default "localhost"))
  ;; can be set to single user to change the start page and menues
  (site-type       gnu-social-site-type
                   (default "community"))
  (avatar-dir      gnu-social-avatar-dir
                   (default "/srv/http/gnu-social/avatar"))
  (attachments-dir gnu-social-attachments-dir
                   (default "/srv/http/gnu-social/file"))
  (pid-dir         gnu-social-pid-dir
                   (default "/var/gnusocial/pid"))
  (logfile         gnu-social-logfile
                   (default #f))
  (ssl?            gnu-social-ssl?
                   (default #f))
  (db-user         gnu-social-db-user
                   (default "gnusocial"))
  (password-file   gnu-social-password-file
		   (default "/root/guix.password-store"))
  ;; "localhost" won't work because of mysql.default_socket is incorrectly defined in the php.ini
  ;; https://stackoverflow.com/questions/1676688/php-mysql-connection-not-working-2002-no-such-file-or-directory#comment48706064_6959675
  (db-host         gnu-social-db-host
                   (default "127.0.0.1"))
  (db-socket       gnu-social-db-socket
                   (default #f))
  (db-database     gnu-social-db-database
                   (default "gnusocial"))
  (admin-handle    gnu-social-admin-handle
                   (default "admin"))
  (admin-email     admin-email
                   (default "#f"))
  ;; TODO need a new user for the config file, since that is read by php-fpm
  (user            gnu-social-user ; system user who owns the writable directories
                   (default "nginx"))
  ;; packages
  (gnu-social      gnu-social-gnu-social
                   (default gnu-social))
  (php             gnu-social-php
                   (default php))
  (mysql           gnu-social-mysql
                   (default mariadb))
  ;; --- optional customizations ---
  (theme           gnu-social-theme
                   (default "neo-gnu"))
  (logo            gnu-social-logo
                   (default #f))    ; url string
  (timezone        gnu-social-timezone
                   (default "UTC"))
  (language        gnu-social-language
                   (default "en"))
  ;; How long notices can be. Set to 0 for unlimited.
  (text-limit      gnu-social-text-limit
                   (default 1000))
  ;; How long users must wait (in seconds) to post the same thing again.
  (dupe-limit      gnu-social-dupe-limit
                   (default 60))
  ;; String to be displayed in the header (max 255 characters).
  (site-notice     gnu-social-site-notice
                   (default #f)))

(define* (gnu-social-nginx-block nginx
                                 gnu-social
                                 gnu-social-config
                                 #:key
                                 (fastcgi-php-socket "/var/run/php7-fpm.sock")
				 (listen '("80" "443 ssl"))
                                 ;; (https-port #f)
                                 (ssl-certificate #f)
                                 (ssl-certificate-key #f)
                                 (server-tokens? #f))
  (match-record
   gnu-social-config
   <gnu-social-config>
   (site-domain avatar-dir attachments-dir)

   (nginx-server-configuration
    (index (list "index.php"))
    (server-name (list site-domain))
    (root (file-append gnu-social "/share/gnu-social"))
    ;; (http-port http-port)
    ;; (https-port https-port)
    (listen listen)
    (ssl-certificate ssl-certificate)
    (ssl-certificate-key ssl-certificate-key)
    (server-tokens? server-tokens?)
    (locations
     (list
      (nginx-location-configuration
       (uri "~ \\.php$")
       (body (list
              "fastcgi_split_path_info ^(.+\\.php)(/.+)$;"
              (string-append "fastcgi_pass unix:" fastcgi-php-socket ";")
              "fastcgi_index index.php;"
              (list "include " nginx "/share/nginx/conf/fastcgi.conf;"))))
      (nginx-location-configuration
       (uri "/avatar")
       (body (list (string-append "alias " avatar-dir ";"))))
      (nginx-location-configuration
       (uri "/file")
       (body (list (string-append "alias " attachments-dir ";"))))
      (nginx-location-configuration
       (uri "/scripts")
       (body (list "deny all;")))
      ;; not really required, but for my own legacy redirect
      ;; (nginx-location-configuration
      ;;  (uri "/index.php/")
      ;;  (body (list "rewrite ^/index.php/(.*)$ /index.php?p=$1 last")))
      (nginx-location-configuration
       (uri "/")
       (body (list "try_files $uri $uri/ @gnusocial;")))
      (nginx-named-location-configuration
       (name "gnusocial")
       ;; TODO optimize to not use regex
       ;; (body (list "rewrite ^ /index.php?p=$1 last;"))
       (body (list "rewrite ^(.*)$ /index.php?p=$1 last;"))))))))

;;; TODO defined multiple times (web.scm, telephony.scm)
(define flatten
  (lambda (. lst)
    (define (flatten1 head out)
      (if (list? head)
      (fold-right flatten1 out head)
      (cons head out)))
    (fold-right flatten1 '() lst)))

(define-syntax-rule (write-text-file name args ...)
  (begin
    (call-with-output-file name
     (lambda (port)
       (display (apply string-append (flatten (list args ...))) port)))
    name))

(define (write-gnu-social-config-file config db-password)
  (mkdir-p "/var/gnusocial/config.d/")
  (match-record
   config
   <gnu-social-config>
   (site-name site-domain site-type avatar-dir attachments-dir pid-dir logfile ssl?
              db-user db-host db-socket db-database admin-handle admin-email user
              gnu-social php mysql theme logo timezone language text-limit dupe-limit site-notice)

   (let* ((mysqli (string-append "mysqli://"
                                 db-user
                                 (if db-password
                                     (string-append ":" db-password)
                                     "")
                                 "@" (if db-socket
                                         (string-append "@unix(" db-socket ")")
                                         db-host)
                                 "/" db-database))
	  ;; TODO use config variable for php-fpm user
	  (gnu-social-user (getpwnam "php-fpm"))
	  (config-file (string-append "/var/gnusocial/config.d/"
				      site-domain ".php"))
          (optional (lambda (prefix value suffix)
                      (if value (string-append prefix value suffix) "")))
	  ;; TODO function defined multiple times
	  (touch (lambda (file-name)
                        (call-with-output-file file-name (const #t)))))

     ;; limit permissions to the config, since it contains the db password
     ;; owned by root (0), readable by gnu-social's user group
     (touch config-file)
     (chown config-file 0 (passwd:gid gnu-social-user))	
     (chmod config-file #o640)
     (write-text-file
      config-file
      "<?php\n"
      "if (!defined('GNUSOCIAL')) { exit(1); }\n"
      "$config['site']['name'] = '" site-name "';\n"
      "$config['site']['server'] = '" site-domain "';\n"
      "$config['site']['path'] = false;\n"
      "$config['site']['fancy'] = true;\n"
      "$config['site']['ssl'] = '" (if ssl? "always" "never") "';\n"
      "$config['site']['theme'] = '" theme "';\n"

      "$config['site']['profile'] = '" site-type "';\n"
      (optional "$config['site']['logo'] ='" logo "';\n")
      (optional "$config['site']['timezone'] ='" timezone "';\n")
      (optional "$config['site']['language'] ='" language "';\n")
      "$config['site']['textlimit'] =" (number->string text-limit) ";\n"
      "$config['site']['dupelimit'] =" (number->string dupe-limit) ";\n"

      "$config['db']['database'] = '" mysqli "';\n"
      "$config['db']['type'] = 'mysql';\n"

      "$config['avatar']['dir'] = '" avatar-dir "';\n"
      "$config['attachments']['dir'] = '" attachments-dir "';\n"
      "$config['cache']['dir'] = '" "/tmp/" "';\n"
      "$config['daemon']['piddir'] = '" pid-dir "';\n"


      "// Uncomment below for better performance. Just remember you must run\n"
      "// php scripts/checkschema.php whenever your enabled plugins change!\n"
      "$config['db']['schemacheck'] = 'script';\n"

      (if logfile
	  (string-append "$config['site']['logfile'] = '" logfile "';\n")
	  "")))))

(define gnu-social
  (let ((commit "50f9f23ff19a4f577c429d80411378d6a1747725"))
    (package
     (name "gnu-social")
     (version "1.2.0-beta4")
     (source (origin
              ;; I made some cli-installer patches
              ;; waiting for them to get accepted into master:
              ;; https://git.gnu.io/gnu/gnu-social/merge_requests/155
              (method url-fetch)
              (uri "https://hidamari.blue/gnu-social.tar.bz2")
              (sha256
               (base32
                "0l9vh9lxn6d42yh1nfd4ydsrizp7qa018wz9da41a14fd44bwqwi"))
              ;; (method git-fetch)    ; no tarball available
              ;; (uri (git-reference
              ;;       (url "https://git.gnu.io/gnu/gnu-social.git")
              ;;       (commit commit)))   ; using the latest version
              ;; (sha256
              ;;  (base32
              ;;   "1xja9pbw8dy8jqc44f7z4vd8mrkpcirq1yxxvf4w0lf778z4xasr"))
              ))
     (build-system gnu-build-system)
     (arguments
      `(#:phases
        (modify-phases
         %standard-phases
         (delete 'configure)
         (delete 'check)
         (replace
          'install
          (lambda*
              (#:key outputs #:allow-other-keys)
            (let ((out (string-append (assoc-ref %outputs "out") "/share/gnu-social/"))
                  (php-bin (string-append (assoc-ref %build-inputs "php") "/bin/php"))
                  (bash (string-append (assoc-ref %build-inputs "bash") "/bin/bash")))

              ;; overwrite the config_files array to only try one config file.
              (substitute* "lib/gnusocial.php"
                           (("\\$config_files\\[\\] = INSTALLDIR\\.'/config\\.php';")
                            "$config_files = array('/var/gnusocial/config.d/'.$_server.'.php');"))

              (substitute* "lib/installer.php"
                           (("require_once INSTALLDIR . '/lib/common.php';")
                            "$server = $this->server; require_once INSTALLDIR . '/lib/common.php'; "))

	      (substitute* "lib/primarynav.php"
                           (("\\$user->hasRight\\(Right::CONFIGURESITE\\)")
                            "false"))
	      
              (delete-file "install.php")
              (mkdir-p out)
              (copy-recursively "." out)
              #t))))))

     ;; TODO replace the bundled jquery if someone ever manages to package that juggernaut
     (inputs `(("php" ,php)
               ("bash" ,bash)))
     (native-inputs `(("gettext" ,gnu-gettext)))
     (home-page "https://gnu.io/social")
     (synopsis "Federated microblogging platform for the web")
     (description
      "GNU Social is a federated microblogging platform.")
     (license license:agpl3+))))

(define (gnu-social-activation config)
  (match-record
   config
   <gnu-social-config>
   (site-name site-domain site-type avatar-dir attachments-dir pid-dir logfile ssl?
              db-user password-file db-host db-socket db-database admin-handle admin-email user
              gnu-social php mysql theme logo timezone language text-limit dupe-limit site-notice)
   
   (let* ((gnu-social-version (package-version gnu-social))
	  ;; TODO put into config
	  (installed-version-filepath "/var/gnusocial/version")
	  (installed-version (if (file-exists? installed-version-filepath)
				 (call-with-input-file installed-version-filepath
				   (lambda (port)
				     (read port)))
				 #f)))
     (with-passwords
      password-file
      ((optional mysql-root-password)
       (generatable gnu-social-db-password 32)
       (generatable gnu-social-admin-password 32))
      #~(begin
	  (use-modules (guix build utils)
		       (ice-9 match)
		       (srfi srfi-1))
	  (let ((user (getpwnam #$user))
		(sh (string-append #$bash "/bin/sh"))
		(php (string-append #$php "/bin/php"))
		(mysql (string-append #$mysql "/bin/mysql"))
		(install-script (string-append #$gnu-social "/share/gnu-social/scripts/install_cli.php"))
		(config-file #$(write-gnu-social-config-file config gnu-social-db-password))
		;; TODO remove, since it's already in web.scm, might move to guix utils
		(flatten (lambda (. lst)
			   (define (flatten1 head out)
			     (if (list? head)
				 (fold-right flatten1 out head)
				 (cons head out)))
			   (fold-right flatten1 '() lst)))
		(touch (lambda (file-name)
			 (call-with-output-file file-name (const #t))))
		(write-installed-version
		 (lambda ()
		   ;; create proof of successful version installation as .tmp
		   (call-with-output-file (string-append #$installed-version-filepath ".tmp")
		     (lambda (port)
		       (write #$gnu-social-version port)))
		   ;; rename to actual name
		   (rename-file (string-append #$installed-version-filepath ".tmp")
				#$installed-version-filepath)
		   #t)))
	    ;; prepare writable directories
	    (mkdir-p #$avatar-dir)
	    (mkdir-p #$attachments-dir)
	    (chown #$avatar-dir (passwd:uid user) (passwd:gid user))
	    (chown #$attachments-dir (passwd:uid user) (passwd:gid user))

	    ;; prepare logfile
	    (touch #$logfile)
	    (chown #$logfile (passwd:uid user) (passwd:gid user))

	    (display "wrote gnu-social config ") (display config-file) (newline)

	    ;; upgrade/install && check-addon-changes
	    (and (cond ((not (equal? #$installed-version #$gnu-social-version))
			;; upgrade existing installation
			(fromat #t "Upgrading gnu-social database ~a from ~a to ~a."
				#$database
				#$installed-version #$gnu-social-version)
			(and (zero? (system* php (string-append #$gnu-social "/share/gnu-social/scripts/stopdaemons.sh")))
			     (zero? (system* php (string-append #$gnu-social "/share/gnu-social/scripts/upgrade.php")
					     "--server" #$site-domain))
			     (zero? (system* php (string-append #$gnu-social "/share/gnu-social/scripts/startdaemons.sh")))
			     (write-installed-version)))
		       ((not #$installed-version)
			;; inital install
			;; create database if it's the default setup
			(format "Installing database for gnu social version ~a." #$gnu-social-version)
			;; create mysql database and user
			(and (zero? (apply system* mysql
					   "--execute"
					   ;; TODO FIXME escape ' signs in username/password
					   (string-append "
CREATE DATABASE IF NOT EXISTS " #$db-database ";
CREATE USER IF NOT EXISTS '" #$db-user "'@'localhost' identified by '" #$gnu-social-db-password "';
GRANT ALL PRIVILEGES ON " #$db-database ".* TO '" #$db-user "'@'localhost';")
					   
					   "--user" "root"
					   (cond (#$db-host (list "--host" #$db-host))
						 (#$db-socket (list "--socket" #$db-socket))
						 (#t (error "gnu-social-service: "
							    "either db-host or db-socket must be set")))
					   ;; TODO FIXME SECURITY this will appear in the system's process list
					   (if #$mysql-root-password
					       (list (string-append "--password=" #$mysql-root-password))
					       '())))
			     ;; call the install script
			     (zero? (apply system* php install-script
					   (filter (lambda (x) (or (not (list? x))
								   (not (null? x))))
						   (flatten
						    "--skip-config"
						    "--sitename"     #$site-name
						    "--server"       #$site-domain
						    "--site-profile" #$site-type

						    "--dbtype"   "mysql"
						    "--host"     #$db-host
						    "--database" #$db-database
						    "--username" #$db-user
						    (if #$gnu-social-db-password
							(list "--password" #$gnu-social-db-password)
							'())

						    "--admin-nick" #$admin-handle
						    "--admin-pass" #$gnu-social-admin-password
						    (if #$admin-email
							(list "--admin-email" #$admin-email)
							'())))))
			     (write-installed-version)))
		       ;; same version already installed, do nothing
		       (else #t))
		 ;; call the routing update script, in case any new addons were installed
		 (zero? (system* php (string-append #$gnu-social "/share/gnu-social/scripts/checkschema.php")
				 "--server" #$site-domain)))))))))

(define gnu-social-service-type
  (service-type (name 'gnu-social)
                (extensions
                 (list (service-extension activation-service-type
                                          gnu-social-activation)))))