;;
;; notifications.scm
;;
;; Email notifications and reminders.
;;
;; ISC License
;;
;; Copyright 2023 Brmlab, z.s.
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
;;
;; Permission to use, copy, modify, and/or distribute this software
;; for any purpose with or without fee is hereby granted, provided
;; that the above copyright notice and this permission notice appear
;; in all copies.
;; 
;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;;

(declare (unit notifications))

(module
 notifications
 (
  make+print-reminder-email
  make+send-reminder-email

  make+print-summary-email
  make+send-summary-email
  )

 (import scheme
	 (chicken base)
	 (chicken format)
	 (chicken string)
	 (chicken sort)
	 (chicken port)
	 brmember
	 util-mail
	 util-bst-ldict
	 members-payments
	 util-format
	 brmember-format
	 configuration
	 util-time
	 members-fees
	 mbase
	 members-print
	 table
	 bank-account
	 logging
	 srfi-1
	 mailinglist)

 ;; Prints email to the console
 (define (print-notification-email em)
   (print "### From: " (ldict-ref em 'from (*email-from*)))
   (print "### To: " (ldict-ref em 'to))
   (print "### Subject: " (ldict-ref em 'subject))
   (when (*notifications-cc*)
     (print "### CC: " (*notifications-cc*)))
   (let loop ((lines (ldict-ref em 'body)))
     (when (not (null? lines))
       (print (car lines))
       (loop (cdr lines)))))

 ;; Sends notification email - the dictionary representation
 (define (send-notification-email em)
   (log-info "Sending ~A to ~A~A"
	     (ldict-ref em 'subject)
	     (ldict-ref em 'to)
	     (if (*mailto-override*)
		 (format " (overriden to ~A)" (*mailto-override*))
		 ""))
   (send-mail (ldict-ref em 'body)
	      #:from (*email-from*)
	      #:headers (ldict-ref em 'headers '())
	      #:to (filter
		    identity
		    (list (ldict-ref em 'to)
			   (ldict-ref em 'cc #f)))
	      #:subject (ldict-ref em 'subject)))

 ;; Creates reminder email body
 (define (reminder-email-body mr)
   (let ((C identity)
	 (M (lambda (s)
	      (brmember-format s mr)))
	 (F format)
	 (absdebt (format-amount (- (member-total-balance mr))))
	 (macc "2500079551/2010"))
     (list
      (M "Ahoj ~N,")
      (C "podle evidence členů a bankovního účtu to vypadá, že máš nedoplatek")
      (F "ve výši ~A Kč." absdebt)
      (C "Zkontroluj, prosím, zda tvé platby členských příspěvků")
      (M "s tvým variabilním symbolem ~I byly zaslány na")
      (F "správný účet ~A." macc)
      (C "Historii členských poplatků si po přihlášení na brmlab.cz můžeš zkontrolovat")
      (C "také na adrese https://brmlab.cz/?do=payments")
      (C "Pokud se domníváš, že někde vznikla chyba, neprodleně nás prosím kontaktuj.")
      ""
      ""
      (M "Dear ~N,")
      (C "according to the members database and bank account statements, it appears")
      (F "your payment of ~A CZK is missing." absdebt)
      (C "Please, check whether your membership fees were transfered")
      (M "correctly with the variable symbol (identification) ~I to")
      (F "the correct bank account ~A." macc)
      (C "The member fees history can be seen at address https://brmlab.cz/?do=payments")
      (C "(you may need to login to brmlab.cz first).")
      (C "If you think there is an error in our evidence, please contact us ASAP.")
      ""
      "--"
      "Brmlab Hackerspace Members Database"
      )))

 ;; Creates reminder email dictionary
 (define (make-reminder-email mr)
   (make-ldict
    `((to . ,(brmember-info mr 'mail))
      (cc . ,(*notifications-cc*))
      (subject . "Připomínka členských příspěvků / Membership fees reminder")
      (body . ,(reminder-email-body mr))
      (headers . ,(list "Content-Type: text/plain; charset=\"UTF-8\""
			(format "From: ~A" (*email-from*))
			(format "CC: ~A" (*notifications-cc*))))
      )))

 ;; Creates and prints reminder email for given member record
 (define (make+print-reminder-email mr)
   (print-notification-email
    (make-reminder-email mr)))

 ;; Actually send emails
 (define (make+send-reminder-email mr)
   (let ((em (make-reminder-email mr)))
     (send-notification-email em)))

 ;; Summary email of membership fees payments
 (define (summary-email-body mb mls)
   (let* ((mbs (members-summary mb))
	  (students (car mbs))
	  (full (cdr mbs))
	  (income (+ (* (lookup-member-fee 'normal) full)
		     (* (lookup-member-fee 'student) students)))
	  (income-lst
	   (list (get-expected-income-string mb)))
	  (unpaired (mbase-unpaired mb))
	  (unpaired-lst
	   (if (null? unpaired)
	       '()
	       (append
		(list ""
		      "Unpaired transactions:")
		(unpaired-table mb #:border-style 'ascii))))
	  (soonexps (sort
		     (find-members-by-predicate
		      mb
		      (brmember-suspended-for 21 24))
		     brmember<?))
	  (soonexps-lst
	   (if (null? soonexps)
	       #f
	       (list ""
		     (format "Expiring members (~A): ~A"
			     (length soonexps)
			     (string-intersperse
			      (map
			       (lambda (mr)
				 (brmember-format "~N (~S)" mr))
			       soonexps)
			      ",")))))
	  (mlcheck-lst
	   (cons ""
		 (string-split
		  (with-output-to-string
		    (lambda ()
		      (print-mailing-list-checks mb mls)))
		  "\n")))
	  (debtors (sort
		    (members-to-notify mb 1)
		    brmember<?))
	  (debtors-lst
	   (if (null? debtors)
	       '()
	       (append
		(list ""
		      "Active debtors:")
		(table->string-list
		 (cons (list "Id" "Member" "Type" "Balance" "Last payment")
		       (map (lambda (mr)
			      (list (brmember-id mr)
				    (brmember-nick mr)
				    (if (brmember-student? mr)
					'student
					'normal)
				    (format "\t~A" (+ 0.0 (member-total-balance mr)))
				    (let* ((payments (brmember-payments mr))
					   (tr (if (null? payments)
						   #f
						   (car (reverse payments)))))
				      (if tr
					  (bank-transaction-date tr)
					  "-"))
				    ))
			    debtors))
		 #:border-style 'ascii
		 #:border '(((#:bottom #:right light) ... (#:bottom light))
			    ((#:right light) ... none)
			    ...)
		 ))))
	  (boring (sort
		   (find-members-by-predicate
		    mb
		    (lambda (mr)
		      (and (brmember-active? mr)
			   (not (member-to-notify? mr)))))
		   brmember<?))
	  (boring-lst
	   (if (null? boring)
	       '()
	       (append
		(list ""
		      "Other active members:")
		(table->string-list
		 (cons (list "Id" "Member" "Type" "Balance" "Last payment")
		       (map (lambda (mr)
			      (list (brmember-id mr)
				    (brmember-nick mr)
				    (if (brmember-student? mr)
					'student
					'normal)
				    (format "\t~A" (member-total-balance mr))
				    (let* ((payments (brmember-payments mr))
					   (tr (if (null? payments)
						   #f
						   (car (reverse payments)))))
				      (if tr
					  (bank-transaction-date tr)
					  "-"))
				    ))
			    boring))
		 #:border-style 'ascii
		 #:border '(((#:bottom #:right light) ... (#:bottom light))
			    ((#:right light) ... none)
			    ...)
		 ))))
	  (dwpu (filter (lambda (dwu)
			  (or (member "member" (list-ref dwu 3))
			      (member "council" (list-ref dwu 3))
			      (member "admin" (list-ref dwu 3))))
			(ldict-ref mb 'dokuwiki)))
	  (dw-lst
	   (if (null? dwpu)
	       '()
	       (list ""
		     "DokuWiki users (non-members) in wrong group(s):"
		     (string-append
		      "  "
		      (string-intersperse
		       (map car dwpu)
		       ", ")))))
	  (dwmu (find-members-by-predicate mb (compose not brmember-dokuwiki-groups-ok?)))
	  (dw2-lst
	   (if (null? dwmu)
	       '()
	       (list ""
		     "Members in wrong dokuwiki group(s):"
		     (string-append
		      "  "
		      (string-intersperse
		       (map brmember-nick dwmu)
		       ", "))))))
     (append income-lst
	     unpaired-lst
	     soonexps-lst
	     mlcheck-lst
	     debtors-lst
	     boring-lst
	     dw-lst
	     dw2-lst
	     (list ""
		   "--"
		   "Brmlab Hackerspace Members Database"
		   ))))

 ;; Creates the summary email structure
 (define (make-summary-email mb mls)
   (make-ldict
    `((to . ,(*summary-mailto*))
      (subject . ,(format "Členské příspěvky ~A"
			  (today/iso)))
      (body . ,(summary-email-body mb mls)))))

 ;; Just print to standard output
 (define (make+print-summary-email mb mls)
   (let ((em (make-summary-email mb mls)))
     (print-notification-email em)))

 ;; Actually send emails
 (define (make+send-summary-email mr mls)
   (let ((em (make-summary-email mr mls)))
     (send-notification-email em)))

 )