Show personal data processing notice to election administrators

src/web/web_services.ml

@@ -26,6 +26,7 @@ open Web_common
 
 let home = service ~path:[""] ~get_params:unit ()
 let admin = service ~path:["admin"] ~get_params:unit ()
+let admin_gdpr_accept = post_coservice ~csrf_safe:true ~fallback:admin ~post_params:unit ()
 let site_login = service ~path:["login"] ~get_params:(opt (string "service")) ()
 let logout = service ~path:["logout"] ~get_params:unit ()
 

src/web/web_site.ml

@@ -327,8 +327,17 @@ let with_site_user f =
   | Some u -> f u
   | None -> forbidden ()
 
+let () =
+  Redirection.register ~service:admin_gdpr_accept
+    (fun () () ->
+      Eliom_reference.set Web_state.show_cookie_disclaimer false >>
+      return admin
+    )
+
 let () = Html5.register ~service:admin
   (fun () () ->
+    let%lwt gdpr = Eliom_reference.get Web_state.show_cookie_disclaimer in
+    if gdpr then T.admin_gdpr () else
     let cont () = Redirection.send admin in
     Eliom_reference.set Web_state.cont [cont] >>
     let%lwt site_user = Web_state.get_site_user () in

src/web/web_templates.ml

@@ -173,6 +173,27 @@ let format_election election =
 let unsafe_a uri text =
   Printf.ksprintf Unsafe.data "<a href=\"%s\">%s</a>" uri text
 
+let admin_gdpr () =
+  let title = site_title ^ " — Personal data processing notice" in
+  let content =
+    [
+      div [
+          pcdata "To use this site, you must accept our ";
+          unsafe_a !gdpr_uri "personal data policy";
+          pcdata ".";
+        ];
+      post_form ~service:admin_gdpr_accept
+        (fun () ->
+          [
+            div [
+                string_input ~input_type:`Submit ~value:"Accept" ();
+              ];
+          ]
+        ) ();
+    ]
+  in
+  base ~title ~content ()
+
 let admin ~elections () =
   let title = site_title ^ " — Administration" in
   match elections with

src/web/web_templates.mli

@@ -23,6 +23,7 @@ open Serializable_t
 open Web_serializable_t
 open Signatures
 
+val admin_gdpr : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
 val admin : elections:('a election list * 'a election list * 'a election list * (uuid * string) list) option -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
 
 val new_election_failure : [ `Exists | `Exception of exn ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t