[bpt/portal.git] / support.sml

structure Support :> SUPPORT =
struct

open Util Sql Init

datatype status =
	 NEW
       | PENDING
       | CLOSED

type category = { id : int, grp : int, name : string, descr : string }
type issue = { id : int, usr : int, cat : int, title : string, priv : bool, status : status, stamp : C.timestamp }
type post = { id : int, usr : int, iss : int, body : string, stamp : C.timestamp }
type subscription = { usr : int, cat : int }


(* Categories *)

fun mkCatRow [id, grp, name, descr] =
    {id = C.intFromSql id, grp = C.intFromSql grp, name = C.stringFromSql name,
     descr = C.stringFromSql descr}
  | mkCatRow row = rowError ("category", row)

fun lookupCategory id =
    mkCatRow (C.oneRow (getDb ()) ($`SELECT id, grp, name, descr
				      FROM SupCategory
			     	      WHERE id = ^(C.intToSql id)`))

fun listCategories () =
    C.map (getDb ()) mkCatRow ($`SELECT id, grp, name, descr
			         FROM SupCategory
			         ORDER BY name`)

fun mkCatRow' (sub :: rest) =
    (not (C.isNull sub), mkCatRow rest)
  | mkCatRow' row = Init.rowError ("category'", row)

fun listCategoriesWithSubscriptions usr =
    C.map (getDb ()) mkCatRow' ($`SELECT cat, id, grp, name, descr
			          FROM SupCategory LEFT OUTER JOIN SupSubscription
				     ON (usr = ^(C.intToSql usr) AND cat = id)
			          ORDER BY name`)

fun addCategory (grp, name, descr) =
    let
	val db = getDb ()
	val id = nextSeq (db, "SupCategorySeq")
    in
	C.dml db ($`INSERT INTO SupCategory (id, grp, name, descr)
		    VALUES (^(C.intToSql id), ^(C.intToSql grp), ^(C.stringToSql name), ^(C.stringToSql descr))`);
	id
    end

fun modCategory (cat : category) =
    let
	val db = getDb ()
    in
	ignore (C.dml db ($`UPDATE SupCategory SET
			    grp = ^(C.intToSql (#grp cat)), name = ^(C.stringToSql (#name cat)),
			       descr = ^(C.stringToSql (#descr cat))
			    WHERE id = ^(C.intToSql (#id cat))`))
    end

fun deleteCategory id =
    ignore (C.dml (getDb ()) ($`DELETE FROM SupCategory WHERE id = ^(C.intToSql id)`))


(* Issues *)

val statusToSql =
    fn NEW => "0"
     | PENDING => "1"
     | CLOSED => "2"

fun statusFromSql v =
    case C.intFromSql v of
	0 => NEW
      | 1 => PENDING
      | 2 => CLOSED
      | _ => raise Fail "Bad support issue status"

fun mkIssueRow [id, usr, cat, title, priv, status, stamp] =
    {id = C.intFromSql id, usr = C.intFromSql usr, cat = C.intFromSql cat,
     title = C.stringFromSql title, priv = C.boolFromSql priv,
     status = statusFromSql status, stamp = C.timestampFromSql stamp}
  | mkIssueRow row = rowError ("issue", row)

fun lookupIssue id =
    mkIssueRow (C.oneRow (getDb ()) ($`SELECT id, usr, cat, title, priv, status, stamp
		  		       FROM SupIssue
			     	       WHERE id = ^(C.intToSql id)`))

fun listIssues () =
    C.map (getDb ()) mkIssueRow ($`SELECT id, usr, cat, title, priv, status, stamp
			           FROM SupIssue
			           ORDER BY stamp DESC`)

fun listCategoryIssues cat =
    C.map (getDb ()) mkIssueRow ($`SELECT id, usr, cat, title, priv, status, stamp
			           FROM SupIssue
				   WHERE cat = ^(C.intToSql cat)
			           ORDER BY stamp DESC`)

fun listOpenCategoryIssues (cat, usr) =
    C.map (getDb ()) mkIssueRow ($`SELECT id, usr, cat, title, priv, status, stamp
			           FROM SupIssue
				   WHERE cat = ^(C.intToSql cat)
				      AND status < 2
			              AND (NOT priv OR usr = ^(C.intToSql usr))
			           ORDER BY stamp DESC`)

fun listOpenCategoryIssuesAdmin cat =
    C.map (getDb ()) mkIssueRow ($`SELECT id, usr, cat, title, priv, status, stamp
			           FROM SupIssue
				   WHERE cat = ^(C.intToSql cat)
				      AND status < 2
			           ORDER BY stamp DESC`)

fun addIssue (usr, cat, title, priv, status) =
    let
	val db = getDb ()
	val id = nextSeq (db, "SupIssueSeq")
    in
	C.dml db ($`INSERT INTO SupIssue (id, usr, cat, title, priv, status, stamp)
		    VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.intToSql cat),
			    ^(C.stringToSql title), ^(C.boolToSql priv),
			    ^(statusToSql status), CURRENT_TIMESTAMP)`);
	id
    end

fun modIssue (iss : issue) =
    let
	val db = getDb ()
    in
	ignore (C.dml db ($`UPDATE SupIssue SET
			    usr = ^(C.intToSql (#usr iss)), cat = ^(C.intToSql (#cat iss)),
			       title = ^(C.stringToSql (#title iss)), priv = ^(C.boolToSql (#priv iss)),
			       status = ^(statusToSql (#status iss))
			    WHERE id = ^(C.intToSql (#id iss))`))
    end

fun deleteIssue id =
    ignore (C.dml (getDb ()) ($`DELETE FROM SupIssue WHERE id = ^(C.intToSql id)`))


(* Posts *)

fun mkPostRow [id, usr, iss, body, stamp] =
    {id = C.intFromSql id, usr = C.intFromSql usr, iss = C.intFromSql iss,
     body = C.stringFromSql body, stamp = C.timestampFromSql stamp}
  | mkPostRow row = rowError ("post", row)

fun lookupPost id =
    mkPostRow (C.oneRow (getDb ()) ($`SELECT id, usr, iss, body, stamp
		 		      FROM SupPost
			     	      WHERE id = ^(C.intToSql id)`))

fun mkPostRow' (name :: rest) = (C.stringFromSql name, mkPostRow rest)
  | mkPostRow' row = Init.rowError ("post'", row)

fun listPosts iss =
    C.map (getDb ()) mkPostRow' ($`SELECT name, SupPost.id, usr, iss, body, SupPost.stamp
			           FROM SupPost JOIN WebUser ON usr = WebUser.id
				   WHERE iss = ^(C.intToSql iss)
			           ORDER BY stamp`)

fun addPost (usr, iss, body) =
    let
	val db = getDb ()
	val id = nextSeq (db, "SupPostSeq")
    in
	C.dml db ($`INSERT INTO SupPost (id, usr, iss, body, stamp)
		    VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.intToSql iss),
			    ^(C.stringToSql body), CURRENT_TIMESTAMP)`);
	id
    end

fun modPost (post : post) =
    let
	val db = getDb ()
    in
	ignore (C.dml db ($`UPDATE SupPost SET
			    usr = ^(C.intToSql (#usr post)), iss = ^(C.intToSql (#iss post)),
			       body = ^(C.stringToSql (#body post))
			    WHERE id = ^(C.intToSql (#id post))`))
    end

fun deletePost id =
    ignore (C.dml (getDb ()) ($`DELETE FROM SupPost WHERE id = ^(C.intToSql id)`))


(* Subscriptions *)

fun mkSubRow [usr, cat] =
    {usr = C.intFromSql usr, cat = C.intFromSql cat}
  | mkSubRow row = rowError ("subscription", row)

fun subscribed {usr, cat} =
    case C.oneRow (getDb ()) ($`SELECT COUNT( * ) FROM SupSubscription
			        WHERE usr = ^(C.intToSql usr) AND cat = ^(C.intToSql cat)`) of
	[n] => not (C.isNull n) andalso C.intFromSql n > 0
      | r => Init.rowError ("subscribed", r)

fun subscribe (sub as {usr, cat}) =
    if subscribed sub then
	()
    else
	ignore (C.dml (getDb ()) ($`INSERT INTO SupSubscription (usr, cat)
		         	    VALUES (^(C.intToSql usr), ^(C.intToSql cat))`))

fun unsubscribe {usr, cat} =
    ignore (C.dml (getDb ()) ($`DELETE FROM SupSubscription
				WHERE usr = ^(C.intToSql usr) AND cat = ^(C.intToSql cat)`))

val okChars = [#" ", #"-", #".", #"!", #"?", #":", #";", #"'", #"\""]

fun validTitle s = CharVector.exists (fn ch => not (Char.isSpace ch)) s
		   andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse List.exists (fn ch' => ch = ch') okChars) s

fun allowedToSee iss =
    let
	val iss = lookupIssue iss
	val cat = lookupCategory (#cat iss)
    in
	not (#priv iss) orelse Group.inGroupNum (#grp cat) orelse (Init.getUserId () = #usr iss)
    end

fun allowedToEdit iss =
    let
	val iss = lookupIssue iss
	val cat = lookupCategory (#cat iss)
    in
	Group.inGroupNum (#grp cat) orelse (Init.getUserId () = #usr iss)
    end

fun writeRecipients (mail, iss : issue, cat : category) =
    let
	val query =
	    if #priv iss then
		$`SELECT name
		  FROM WebUser JOIN Membership ON (usr = id AND grp = ^(C.intToSql (#grp cat)))`
	    else
		$`SELECT name
		  FROM WebUser JOIN SupSubscription ON (usr = id AND cat = ^(C.intToSql (#id cat)))`

	fun doOne [name] = (Mail.mwrite (mail, C.stringFromSql name);
			    Mail.mwrite (mail, ","))
    in
	Mail.mwrite (mail, "Bcc: ");
	C.app (getDb ()) doOne query;
	Mail.mwrite (mail, "\n")
    end

fun notify (prefix, f) iss =
    let
	val iss = lookupIssue iss
	val cat = lookupCategory (#cat iss)
	val user = Init.lookupUser (#usr iss)

	val mail = Mail.mopen ()
    in
	Mail.mwrite (mail, "From: Hcoop Support System <support@hcoop.net>\nTo: ");
	Mail.mwrite (mail, #name user);
	Mail.mwrite (mail, "@hcoop.net\n");
	writeRecipients (mail, iss, cat);
	Mail.mwrite (mail, "Subject: ");
	Mail.mwrite (mail, prefix);
	Mail.mwrite (mail, #title iss);
	Mail.mwrite (mail, "\n\nURL: ");
	Mail.mwrite (mail, Init.urlPrefix);
	Mail.mwrite (mail, "issue?cat=");
	Mail.mwrite (mail, C.intToSql (#id cat));
	Mail.mwrite (mail, "&id=");
	Mail.mwrite (mail, C.intToSql (#id iss));
	Mail.mwrite (mail, "\n\nSubmitted by: ");
	Mail.mwrite (mail, #name user);
	Mail.mwrite (mail, "\n    Category: ");
	Mail.mwrite (mail, #name cat);
	Mail.mwrite (mail, "\n       Issue: ");
	Mail.mwrite (mail, #title iss);
	Mail.mwrite (mail, "\n     Private: ");
	Mail.mwrite (mail, if #priv iss then "yes" else "no");
	Mail.mwrite (mail, "\n\n");

	f (iss, cat, user, mail);

	OS.Process.isSuccess (Mail.mclose mail)
    end

val notifyCreation = notify ("[New] ",
			     fn (iss, cat, user, mail) =>
				(case listPosts (#id iss) of
				     [] => ()
				   | [(_, post)] => Mail.mwrite (mail, #body post)
				   | _ => raise Fail "Too many posts for supposedly new support issue"))

fun notifyPost pid =
    let
	val post = lookupPost pid
	val poster = Init.lookupUser (#usr post)
    in
	notify ("[Post] ",
		fn (iss, cat, user, mail) =>
		   (Mail.mwrite (mail, "New post by ");
		    Mail.mwrite (mail, #name poster);
		    Mail.mwrite (mail, ":\n\n");
		    Mail.mwrite (mail, #body post))) (#iss post)
    end

val statusToString =
    fn NEW => "New"
     | PENDING => "Pending"
     | CLOSED => "Closed"

fun notifyStatus (usr, oldStatus, newStatus, iss) =
    let
	val user = Init.lookupUser usr
    in
	notify ("[" ^ statusToString newStatus ^ "] ",
		fn (iss, cat, user, mail) =>
		   (Mail.mwrite (mail, #name user);
		    Mail.mwrite (mail, " changed status from ");
		    Mail.mwrite (mail, statusToString oldStatus);
		    Mail.mwrite (mail, " to ");
		    Mail.mwrite (mail, statusToString newStatus);
		    Mail.mwrite (mail, ".\n"))) iss
    end
	       
end
Commit	Line	Data
5a2812ca AC	1	structure Support :> SUPPORT =
	2	struct
	3
	4	open Util Sql Init
	5
	6	datatype status =
	7	NEW
	8	\| PENDING
	9	\| CLOSED
	10
	11	type category = { id : int, grp : int, name : string, descr : string }
	12	type issue = { id : int, usr : int, cat : int, title : string, priv : bool, status : status, stamp : C.timestamp }
	13	type post = { id : int, usr : int, iss : int, body : string, stamp : C.timestamp }
	14	type subscription = { usr : int, cat : int }
	15
	16
	17	(* Categories *)
	18
	19	fun mkCatRow [id, grp, name, descr] =
	20	{id = C.intFromSql id, grp = C.intFromSql grp, name = C.stringFromSql name,
	21	descr = C.stringFromSql descr}
	22	\| mkCatRow row = rowError ("category", row)
	23
	24	fun lookupCategory id =
	25	mkCatRow (C.oneRow (getDb ()) ($`SELECT id, grp, name, descr
	26	FROM SupCategory
	27	WHERE id = ^(C.intToSql id)`))
	28
	29	fun listCategories () =
	30	C.map (getDb ()) mkCatRow ($`SELECT id, grp, name, descr
	31	FROM SupCategory
	32	ORDER BY name`)
	33
	34	fun mkCatRow' (sub :: rest) =
	35	(not (C.isNull sub), mkCatRow rest)
	36	\| mkCatRow' row = Init.rowError ("category'", row)
	37
	38	fun listCategoriesWithSubscriptions usr =
	39	C.map (getDb ()) mkCatRow' ($`SELECT cat, id, grp, name, descr
	40	FROM SupCategory LEFT OUTER JOIN SupSubscription
	41	ON (usr = ^(C.intToSql usr) AND cat = id)
	42	ORDER BY name`)
	43
	44	fun addCategory (grp, name, descr) =
	45	let
	46	val db = getDb ()
	47	val id = nextSeq (db, "SupCategorySeq")
	48	in
	49	C.dml db ($`INSERT INTO SupCategory (id, grp, name, descr)
	50	VALUES (^(C.intToSql id), ^(C.intToSql grp), ^(C.stringToSql name), ^(C.stringToSql descr))`);
	51	id
	52	end
	53
	54	fun modCategory (cat : category) =
	55	let
	56	val db = getDb ()
	57	in
	58	ignore (C.dml db ($`UPDATE SupCategory SET
	59	grp = ^(C.intToSql (#grp cat)), name = ^(C.stringToSql (#name cat)),
	60	descr = ^(C.stringToSql (#descr cat))
	61	WHERE id = ^(C.intToSql (#id cat))`))
	62	end
	63
	64	fun deleteCategory id =
65	ignore (C.dml (getDb ()) ($`DELETE FROM SupCategory WHERE id = ^(C.intToSql id)`))
66
67
68	(* Issues *)
69
70	val statusToSql =
71	fn NEW => "0"
72	\| PENDING => "1"
73	\| CLOSED => "2"
74
75	fun statusFromSql v =
76	case C.intFromSql v of
77	0 => NEW
78	\| 1 => PENDING
79	\| 2 => CLOSED
80	\| _ => raise Fail "Bad support issue status"
81
82	fun mkIssueRow [id, usr, cat, title, priv, status, stamp] =
83	{id = C.intFromSql id, usr = C.intFromSql usr, cat = C.intFromSql cat,
84	title = C.stringFromSql title, priv = C.boolFromSql priv,
85	status = statusFromSql status, stamp = C.timestampFromSql stamp}
86	\| mkIssueRow row = rowError ("issue", row)
87
88	fun lookupIssue id =
89	mkIssueRow (C.oneRow (getDb ()) ($`SELECT id, usr, cat, title, priv, status, stamp
90	FROM SupIssue
91	WHERE id = ^(C.intToSql id)`))
92
93	fun listIssues () =
94	C.map (getDb ()) mkIssueRow ($`SELECT id, usr, cat, title, priv, status, stamp
95	FROM SupIssue
96	ORDER BY stamp DESC`)
97
1cb3df3f AC	98	fun listCategoryIssues cat =
	99	C.map (getDb ()) mkIssueRow ($`SELECT id, usr, cat, title, priv, status, stamp
	100	FROM SupIssue
	101	WHERE cat = ^(C.intToSql cat)
	102	ORDER BY stamp DESC`)
	103
	104	fun listOpenCategoryIssues (cat, usr) =
	105	C.map (getDb ()) mkIssueRow ($`SELECT id, usr, cat, title, priv, status, stamp
	106	FROM SupIssue
	107	WHERE cat = ^(C.intToSql cat)
	108	AND status < 2
	109	AND (NOT priv OR usr = ^(C.intToSql usr))
	110	ORDER BY stamp DESC`)
	111
	112	fun listOpenCategoryIssuesAdmin cat =
	113	C.map (getDb ()) mkIssueRow ($`SELECT id, usr, cat, title, priv, status, stamp
	114	FROM SupIssue
	115	WHERE cat = ^(C.intToSql cat)
	116	AND status < 2
	117	ORDER BY stamp DESC`)
	118
5a2812ca AC	119	fun addIssue (usr, cat, title, priv, status) =
	120	let
	121	val db = getDb ()
	122	val id = nextSeq (db, "SupIssueSeq")
	123	in
	124	C.dml db ($`INSERT INTO SupIssue (id, usr, cat, title, priv, status, stamp)
	125	VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.intToSql cat),
	126	^(C.stringToSql title), ^(C.boolToSql priv),
	127	^(statusToSql status), CURRENT_TIMESTAMP)`);
	128	id
	129	end
	130
	131	fun modIssue (iss : issue) =
	132	let
	133	val db = getDb ()
	134	in
	135	ignore (C.dml db ($`UPDATE SupIssue SET
	136	usr = ^(C.intToSql (#usr iss)), cat = ^(C.intToSql (#cat iss)),
	137	title = ^(C.stringToSql (#title iss)), priv = ^(C.boolToSql (#priv iss)),
	138	status = ^(statusToSql (#status iss))
	139	WHERE id = ^(C.intToSql (#id iss))`))
	140	end
	141
	142	fun deleteIssue id =
	143	ignore (C.dml (getDb ()) ($`DELETE FROM SupIssue WHERE id = ^(C.intToSql id)`))
	144
	145
	146	(* Posts *)
	147
	148	fun mkPostRow [id, usr, iss, body, stamp] =
	149	{id = C.intFromSql id, usr = C.intFromSql usr, iss = C.intFromSql iss,
	150	body = C.stringFromSql body, stamp = C.timestampFromSql stamp}
	151	\| mkPostRow row = rowError ("post", row)
	152
	153	fun lookupPost id =
	154	mkPostRow (C.oneRow (getDb ()) ($`SELECT id, usr, iss, body, stamp
	155	FROM SupPost
	156	WHERE id = ^(C.intToSql id)`))
	157
edeb626e AC	158	fun mkPostRow' (name :: rest) = (C.stringFromSql name, mkPostRow rest)
	159	\| mkPostRow' row = Init.rowError ("post'", row)
	160
5a2812ca	161	fun listPosts iss =
edeb626e AC	162	C.map (getDb ()) mkPostRow' ($`SELECT name, SupPost.id, usr, iss, body, SupPost.stamp
	163	FROM SupPost JOIN WebUser ON usr = WebUser.id
	164	WHERE iss = ^(C.intToSql iss)
	165	ORDER BY stamp`)
5a2812ca AC	166
	167	fun addPost (usr, iss, body) =
	168	let
	169	val db = getDb ()
	170	val id = nextSeq (db, "SupPostSeq")
	171	in
	172	C.dml db ($`INSERT INTO SupPost (id, usr, iss, body, stamp)
	173	VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.intToSql iss),
	174	^(C.stringToSql body), CURRENT_TIMESTAMP)`);
	175	id
	176	end
	177
	178	fun modPost (post : post) =
	179	let
	180	val db = getDb ()
	181	in
	182	ignore (C.dml db ($`UPDATE SupPost SET
	183	usr = ^(C.intToSql (#usr post)), iss = ^(C.intToSql (#iss post)),
	184	body = ^(C.stringToSql (#body post))
	185	WHERE id = ^(C.intToSql (#id post))`))
	186	end
	187
	188	fun deletePost id =
	189	ignore (C.dml (getDb ()) ($`DELETE FROM SupPost WHERE id = ^(C.intToSql id)`))
	190
	191
	192	(* Subscriptions *)
	193
	194	fun mkSubRow [usr, cat] =
	195	{usr = C.intFromSql usr, cat = C.intFromSql cat}
	196	\| mkSubRow row = rowError ("subscription", row)
	197
	198	fun subscribed {usr, cat} =
	199	case C.oneRow (getDb ()) ($`SELECT COUNT( * ) FROM SupSubscription
	200	WHERE usr = ^(C.intToSql usr) AND cat = ^(C.intToSql cat)`) of
	201	[n] => not (C.isNull n) andalso C.intFromSql n > 0
	202	\| r => Init.rowError ("subscribed", r)
	203
	204	fun subscribe (sub as {usr, cat}) =
	205	if subscribed sub then
	206	()
	207	else
	208	ignore (C.dml (getDb ()) ($`INSERT INTO SupSubscription (usr, cat)
	209	VALUES (^(C.intToSql usr), ^(C.intToSql cat))`))
	210
	211	fun unsubscribe {usr, cat} =
	212	ignore (C.dml (getDb ()) ($`DELETE FROM SupSubscription
	213	WHERE usr = ^(C.intToSql usr) AND cat = ^(C.intToSql cat)`))
	214
edeb626e AC	215	val okChars = [#" ", #"-", #".", #"!", #"?", #":", #";", #"'", #"\""]
edeb626e AC	216
1cb3df3f	217	fun validTitle s = CharVector.exists (fn ch => not (Char.isSpace ch)) s
edeb626e AC	218	andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse List.exists (fn ch' => ch = ch') okChars) s
	219
	220	fun allowedToSee iss =
	221	let
	222	val iss = lookupIssue iss
	223	val cat = lookupCategory (#cat iss)
	224	in
	225	not (#priv iss) orelse Group.inGroupNum (#grp cat) orelse (Init.getUserId () = #usr iss)
	226	end
	227
	228	fun allowedToEdit iss =
	229	let
	230	val iss = lookupIssue iss
	231	val cat = lookupCategory (#cat iss)
	232	in
	233	Group.inGroupNum (#grp cat) orelse (Init.getUserId () = #usr iss)
	234	end
	235
	236	fun writeRecipients (mail, iss : issue, cat : category) =
	237	let
	238	val query =
	239	if #priv iss then
	240	$`SELECT name
	241	FROM WebUser JOIN Membership ON (usr = id AND grp = ^(C.intToSql (#grp cat)))`
	242	else
	243	$`SELECT name
	244	FROM WebUser JOIN SupSubscription ON (usr = id AND cat = ^(C.intToSql (#id cat)))`
	245
	246	fun doOne [name] = (Mail.mwrite (mail, C.stringFromSql name);
	247	Mail.mwrite (mail, ","))
	248	in
	249	Mail.mwrite (mail, "Bcc: ");
	250	C.app (getDb ()) doOne query;
	251	Mail.mwrite (mail, "\n")
	252	end
5a2812ca	253
edeb626e AC	254	fun notify (prefix, f) iss =
	255	let
	256	val iss = lookupIssue iss
	257	val cat = lookupCategory (#cat iss)
	258	val user = Init.lookupUser (#usr iss)
	259
	260	val mail = Mail.mopen ()
	261	in
	262	Mail.mwrite (mail, "From: Hcoop Support System <support@hcoop.net>\nTo: ");
	263	Mail.mwrite (mail, #name user);
	264	Mail.mwrite (mail, "@hcoop.net\n");
	265	writeRecipients (mail, iss, cat);
	266	Mail.mwrite (mail, "Subject: ");
	267	Mail.mwrite (mail, prefix);
	268	Mail.mwrite (mail, #title iss);
	269	Mail.mwrite (mail, "\n\nURL: ");
	270	Mail.mwrite (mail, Init.urlPrefix);
	271	Mail.mwrite (mail, "issue?cat=");
	272	Mail.mwrite (mail, C.intToSql (#id cat));
	273	Mail.mwrite (mail, "&id=");
	274	Mail.mwrite (mail, C.intToSql (#id iss));
	275	Mail.mwrite (mail, "\n\nSubmitted by: ");
	276	Mail.mwrite (mail, #name user);
	277	Mail.mwrite (mail, "\n Category: ");
	278	Mail.mwrite (mail, #name cat);
	279	Mail.mwrite (mail, "\n Issue: ");
	280	Mail.mwrite (mail, #title iss);
	281	Mail.mwrite (mail, "\n Private: ");
	282	Mail.mwrite (mail, if #priv iss then "yes" else "no");
	283	Mail.mwrite (mail, "\n\n");
	284
	285	f (iss, cat, user, mail);
	286
	287	OS.Process.isSuccess (Mail.mclose mail)
	288	end
	289
	290	val notifyCreation = notify ("[New] ",
	291	fn (iss, cat, user, mail) =>
	292	(case listPosts (#id iss) of
	293	[] => ()
	294	\| [(_, post)] => Mail.mwrite (mail, #body post)
	295	\| _ => raise Fail "Too many posts for supposedly new support issue"))
	296
	297	fun notifyPost pid =
	298	let
	299	val post = lookupPost pid
	300	val poster = Init.lookupUser (#usr post)
	301	in
	302	notify ("[Post] ",
	303	fn (iss, cat, user, mail) =>
	304	(Mail.mwrite (mail, "New post by ");
	305	Mail.mwrite (mail, #name poster);
	306	Mail.mwrite (mail, ":\n\n");
	307	Mail.mwrite (mail, #body post))) (#iss post)
	308	end
	309
	310	val statusToString =
	311	fn NEW => "New"
	312	\| PENDING => "Pending"
	313	\| CLOSED => "Closed"
	314
	315	fun notifyStatus (usr, oldStatus, newStatus, iss) =
	316	let
	317	val user = Init.lookupUser usr
318	in
319	notify ("[" ^ statusToString newStatus ^ "] ",
320	fn (iss, cat, user, mail) =>
321	(Mail.mwrite (mail, #name user);
322	Mail.mwrite (mail, " changed status from ");
323	Mail.mwrite (mail, statusToString oldStatus);
324	Mail.mwrite (mail, " to ");
325	Mail.mwrite (mail, statusToString newStatus);
326	Mail.mwrite (mail, ".\n"))) iss
327	end
328
5a2812ca	329	end