server: allow to fetch module timetables in addition to groups

This add a new type, fetch_kind, and a function, kind_to_res_type, to
select the type of timetable we want to fetch: Group, or Module.  For
now, Module is not used, so warning 37 is disabled in fetch_kind.  It
will be enabled back in the next commit.

Signed-off-by: Alban Gruin <alban at pa1ch dot fr>

1 files changed, 13 insertions, 5 deletions

diff --git a/src/server.ml b/src/server.ml
index a27e5d6..7107fdf 100644
--- a/src/server.ml
+++ b/src/server.ml
@@ -1,5 +1,5 @@
 (*
- *    Copyright (C) 2020  Alban Gruin
+ *    Copyright (C) 2020, 2021  Alban Gruin
  *
  *    ucs is free software: you can redistribute it and/or modify
  *    it under the terms of the GNU Affero General Public License as published
@@ -26,13 +26,22 @@ let format_date = Printer.Date.sprint "%Y-%m-%d" and
     a_month = Date.Period.make 0 1 0 and
     a_year = Date.Period.make 1 0 0
 
-let fetch celcat_url group =
+type [@warning "-37"] fetch_kind =
+  | Group
+  | Module
+
+let kind_to_res_type = function
+  | Group -> "103"
+  | Module -> "100"
+
+let fetch celcat_url group kind =
   let current_date = Date.today () in
   let lower_date = format_date @@ Date.rem current_date a_month and
       upper_date = format_date @@ Date.add current_date a_year in
+  let res_type = kind_to_res_type kind in
   let parameters = Uri.encoded_of_query
                      ["start", [lower_date]; "end", [upper_date];
-                      "resType", ["103"]; "calView", ["month"];
+                      "resType", [res_type]; "calView", ["month"];
                       "federationIds[]", [group]; "colourScheme", ["3"]] in
   let body = Cohttp_lwt.Body.of_string parameters and
       headers = Header.init_with "Content-Type" "application/x-www-form-urlencoded" in
@@ -63,7 +72,6 @@ let get_tz () =
 
 let serve base_url celcat_url mode stop =
   get_tz () >>= fun tzname ->
-  let fetch = fetch celcat_url in
   let callback _conn req _body =
     let meth = Request.meth req and
         uri = Request.uri req in
@@ -81,7 +89,7 @@ let serve base_url celcat_url mode stop =
        Server.respond_string ~status:`Bad_request ~body:"Bad request\n" ()
     | `GET, ["ics"; file], [] when Astring.String.is_suffix ~affix:".ics" file ->
        let group = String.(sub file 0 (length file - 4)) in
-       fetch group >>= fun body ->
+       fetch celcat_url group Group >>= fun body ->
        Course.decode body
        |> Ics.to_string tzname
        |> respond ~mime:"text/calendar; charset=utf-8"