aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlban Gruin2020-09-12 14:01:24 +0200
committerAlban Gruin2020-09-12 14:30:57 +0200
commit94428f9e3c69ebd23e843fa77259b0dd3dc53142 (patch)
treec214293e75d962588e7c18378b755857f130e2a2
parent31fa3ca1b6511b912beea7cd658ffe5a31048a6b (diff)
ucs: adding a basic webserver, only returning an ICS file on GET queries
Signed-off-by: Alban Gruin <alban at pa1ch dot fr>
-rw-r--r--src/ucs.ml21
1 files changed, 16 insertions, 5 deletions
diff --git a/src/ucs.ml b/src/ucs.ml
index b4e0952..16fce75 100644
--- a/src/ucs.ml
+++ b/src/ucs.ml
@@ -19,7 +19,7 @@ open Lwt
open Cohttp
open Cohttp_lwt_unix
-let body =
+let body () =
let parameters = Uri.encoded_of_query
["start", ["2020-09-01"]; "end", ["2020-10-01"];
"resType", ["103"]; "calView", ["month"];
@@ -30,8 +30,19 @@ let body =
>>= fun (_resp, body) ->
Cohttp_lwt.Body.to_string body
+let server =
+ let callback _conn req _body =
+ let meth = Request.meth req in
+ match meth with
+ | `GET ->
+ body () >>= 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 ()
+ | _ ->
+ 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 body
- |> Course.decode
- |> Ics.to_string
- |> print_endline
+ ignore @@ Lwt_main.run server