diff options
Diffstat (limited to 'src/ucs.ml')
| -rw-r--r-- | src/ucs.ml | 55 |
1 files changed, 1 insertions, 54 deletions
@@ -15,58 +15,5 @@ * along with ucs. If not, see <http://www.gnu.org/licenses/>. *) -open Lwt -open Cohttp -open Cohttp_lwt_unix - -let fetch group = - let parameters = Uri.encoded_of_query - ["start", ["2020-09-01"]; "end", ["2020-10-01"]; - "resType", ["103"]; "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 - Client.post ~body ~headers (Uri.of_string "https://edt.univ-tlse3.fr/calendar2/Home/GetCalendarData") - >>= fun (_resp, body) -> - Cohttp_lwt.Body.to_string body - -let log uri = - let datetime = CalendarLib.( - Printer.Calendar.sprint "%Y-%m-%d %H:%M:%S" @@ Calendar.now ()) in - Lwt_io.printlf "[%s] %s" datetime (Uri.path_and_query uri) - -let respond ?(mime="text/html; charset=utf-8") ?(status=`OK) body = - let headers = Header.init_with "Content-Type" mime in - Server.respond_string ~status ~body ~headers () - -let server = - let callback _conn req _body = - let meth = Request.meth req and - uri = Request.uri req in - let path = Uri.path uri - |> Astring.String.cuts ~empty:false ~sep:"/" - |> List.map Uri.pct_decode and - query = Uri.query uri in - log uri >>= fun () -> - match meth, path, query with - | `GET, ([] | ["index.html"]), [] -> respond Pages.main - | `GET, ["lnk"], ["group", [group]] -> - let lnk = "/ics/" ^ group ^ ".ics" in - respond @@ Pages.link lnk - | `GET, ["lnk"], _ -> - 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 -> - Course.decode body - |> Ics.to_string - |> respond ~mime:"text/calendar; charset=utf-8" - | `GET, _, _ -> - Server.respond_string ~status:`Not_found ~body:"Not found\n" () - | _ -> - Server.respond_string - ~status:`Method_not_allowed ~body:"Method not allowed\n" () in - Server.create ~mode:(`TCP (`Port 8080)) (Server.make ~callback ()) - let () = - Lwt_main.run server + Lwt_main.run (Server.serve "/" (Uri.of_string "/") (`TCP (`Port 8080))) |