qos.sml

   1 structure Qos :> QOS = struct
   2
   3 open Util Sql Init
   4
   5 type entry = { kind : string, kindUrl : string option, name : string, url : string option, usr : int, uname : string,
   6                stamp : C.timestamp, pstamp : C.timestamp option, cstamp : C.timestamp option}
   7
   8 fun mkEntryRow [kind, kindUrl, name, url, usr, uname, stamp, pstamp, cstamp] =
   9     {kind = C.stringFromSql kind, kindUrl = if C.isNull kindUrl then NONE else SOME (C.stringFromSql kindUrl),
  10      name = C.stringFromSql name, url = if C.isNull url then NONE else SOME (C.stringFromSql url),
  11      usr = C.intFromSql usr, uname = C.stringFromSql uname, stamp = C.timestampFromSql stamp,
  12      pstamp = if C.isNull pstamp then NONE else SOME (C.timestampFromSql pstamp),
  13      cstamp = if C.isNull cstamp then NONE else SOME (C.timestampFromSql cstamp)}
  14   | mkEntryRow row = rowError ("QOS", row)
  15
  16 fun recent days =
  17     let
  18         val usr = Init.getUserId ()
  19         val db = getDb ()
  20     in
  21         C.map db mkEntryRow ($`SELECT SupCategory.name, 'issue?cat=' || SupCategory.id, title,
  22                                  'issue?cat=' || SupCategory.id || '&id=' || SupIssue.id, usr, WebUser.name,
  23                                  stamp, COALESCE(pstamp, cstamp), cstamp
  24                                  FROM SupIssue JOIN SupCategory ON SupCategory.id = cat
  25                                    JOIN WebUser ON WebUser.id = usr
  26                                  WHERE stamp >= CURRENT_TIMESTAMP - interval '^(C.intToSql days) DAYS'
  27                                    AND (NOT priv OR usr = ^(C.intToSql usr)
  28                                      OR (SELECT COUNT(*) FROM Membership WHERE Membership.usr = ^(C.intToSql usr)
  29                                        AND (Membership.grp = 0 OR Membership.grp = SupCategory.grp)) > 0)
  30                                UNION SELECT 'APT package', NULL, data, NULL, usr, name, stamp, cstamp, cstamp
  31                                  FROM Apt JOIN WebUser ON WebUser.id = usr
  32                                  WHERE stamp >= CURRENT_TIMESTAMP - interval '^(C.intToSql days) DAYS'
  33                                UNION SELECT 'Domain', NULL, data, NULL, usr, name, stamp, cstamp, cstamp
  34                                  FROM Domain JOIN WebUser ON WebUser.id = usr
  35                                  WHERE stamp >= CURRENT_TIMESTAMP - interval '^(C.intToSql days) DAYS'
  36                                UNION SELECT 'Mailing list', NULL, data, NULL, usr, name, stamp, cstamp, cstamp
  37                                  FROM MailingList JOIN WebUser ON WebUser.id = usr
  38                                  WHERE stamp >= CURRENT_TIMESTAMP - interval '^(C.intToSql days) DAYS'
  39                                UNION SELECT 'Security', NULL, data, NULL, usr, name, stamp, cstamp, cstamp
  40                                  FROM Sec JOIN WebUser ON WebUser.id = usr
  41                                  WHERE stamp >= CURRENT_TIMESTAMP - interval '^(C.intToSql days) DAYS'
  42                                ORDER BY stamp DESC`)
  43     end
  44
  45 type grade = { count : int, minutes : int }
  46 type grades = { pending : grade, closed : grade }
  47 type reportCard = { misc : grades,
  48                     apt : grade,
  49                     domain : grade,
  50                     mailingList : grade,
  51                     sec : grade }
  52
  53 fun mkGradeRow [count, minutes] =
  54     {count = C.intFromSql count,
  55      minutes = if C.isNull minutes then 0 else C.intFromSql minutes}
  56   | mkGradeRow row = rowError ("grade", row)
  57
  58 fun reportCard days =
  59     let
  60         val db = getDb ()
  61
  62         fun gradeRow s = mkGradeRow (C.oneRow db s)
  63
  64         fun default tab =
  65             gradeRow ($`SELECT COUNT(*), EXTRACT(MINUTE FROM AVG(cstamp - stamp))
  66                           FROM ^tab
  67                           WHERE stamp >= CURRENT_TIMESTAMP - interval '^(C.intToSql days) DAYS'
  68                             AND cstamp IS NOT NULL`)
  69     in
  70         {misc = {pending = gradeRow
  71                  ($`SELECT COUNT(*), EXTRACT(MINUTE FROM AVG(COALESCE(pstamp, cstamp) - stamp))
  72                       FROM SupIssue
  73                       WHERE stamp >= CURRENT_TIMESTAMP - interval '^(C.intToSql days) DAYS'
  74                         AND COALESCE(pstamp, cstamp) IS NOT NULL`),
  75                  closed = gradeRow
  76                  ($`SELECT COUNT(*), EXTRACT(MINUTE FROM AVG(cstamp - stamp))
  77                       FROM SupIssue
  78                       WHERE stamp >= CURRENT_TIMESTAMP - interval '^(C.intToSql days) DAYS'
  79                         AND cstamp IS NOT NULL`)},
  80          apt = default "Apt",
  81          domain = default "Domain",
  82          mailingList = default "MailingList",
  83          sec = default "Sec"}
  84     end
  85
  86 end