diff options
Diffstat (limited to 'src/server.ml')
| -rw-r--r-- | src/server.ml | 37 |
1 files changed, 33 insertions, 4 deletions
diff --git a/src/server.ml b/src/server.ml index 389da95..371c402 100644 --- a/src/server.ml +++ b/src/server.ml @@ -101,9 +101,29 @@ let respond_link ?(args=[]) base_url kind id = |> Pages.link |> respond +let get_module_link base_url body = + Cohttp_lwt.Body.to_string body >>= fun body -> + let data = Uri.query_of_encoded body in + let groups, module_id, valid = List.fold_right (fun (k, v) (groups, module_id, valid) -> + match k, v, module_id, valid with + | _, _, _, false -> groups, module_id, false + | "groups", ([] | [""]), _, _ -> groups, module_id, true + | "groups", [group], _, _ -> group :: groups, module_id, true + | "groups", g, _, _ -> g @ groups, module_id, true + | "module", [module_id], None, _ -> groups, Some module_id, true + | _, _, _, _ -> groups, None, false) data ([], None, true) in + match module_id, valid with + | Some module_id, true -> + let args = + if groups = [] then [] + else ["groups", groups] in + respond_link ~args base_url Module module_id + | _, _ -> + bad_request () + let serve base_url celcat_url mode stop = get_tz () >>= fun tzname -> - let callback _conn req _body = + let callback _conn req body = let meth = Request.meth req and uri = Request.uri req in let path = Uri.path uri @@ -112,15 +132,24 @@ let serve base_url celcat_url mode stop = query = Uri.query uri in log uri >>= fun () -> match meth, path, query with - | `GET, ([] | ["index.html"]), [] -> respond Pages.main + | `GET, ([] | ["index.html"]), [] -> + respond Pages.main | `GET, ["lnk"], ["group", [group]] -> respond_link base_url Group group - | `GET, ["lnk"], _ -> - bad_request () + | `POST, ["lnk"], [] -> + get_module_link base_url body | `GET, ["ics"; "g"; file], [] when check_ics file -> fetch_and_respond tzname celcat_url file Group | `GET, ["ics"; "m"; file], ([] as groups | ["groups", groups]) when check_ics file -> fetch_and_respond ~groups tzname celcat_url file Module + | `GET, ["filter"], ["module", [module_id]] -> + fetch celcat_url module_id Module >>= fun body -> + Course.decode body + |> Ics.get_all_groups + |> Pages.select module_id + |> respond + | (`GET | `POST), ["lnk"], _ | `GET, ["filter"], _ -> + bad_request () | `GET, ["ics"; "g" | "m"; file], _ when check_ics file -> bad_request () | `GET, _, _ -> |