(* * Copyright (C) 2020 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 * by the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * ucs is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Affero General Public License for more details. * * You should have received a copy of the GNU Affero General Public License * along with ucs. If not, see . *) 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 req = let uri = Request.uri req and datetime = CalendarLib.( Printer.Calendar.sprint "%Y-%m-%d %H:%M:%S" @@ Calendar.now ()) in Lwt_io.printlf "[%s] %s" datetime (Uri.path uri) let server = let callback _conn req _body = let meth = Request.meth req and uri = Request.uri req |> Uri.path |> Astring.String.cuts ~empty:false ~sep:"/" |> List.map Uri.pct_decode in log req >>= fun () -> match meth, uri with | `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 -> let body = Ics.to_string @@ Course.decode body and headers = Header.init_with "Content-Type" "text/calendar" in Server.respond_string ~status:`OK ~body ~headers () | `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 () = ignore @@ Lwt_main.run server