Commit f623971b authored by Stephane Glondu's avatar Stephane Glondu

Fix numerous warnings

parent 099da35d
......@@ -3,3 +3,6 @@
<src/web/*.{ml,mli,byte,native,odoc}>: thread, package(eliom.server), syntax(camlp4o), package(lwt.syntax), package(csv)
<src/tool/tool_cmdline.*>: package(zarith), package(calendar), package(cryptokit), package(cmdliner), use_platform-native
<src/tool/tool_js*> or <src/platform/js/*> or <src/booth/*>: package(js_of_ocaml), syntax(camlp4o), package(js_of_ocaml.syntax), package(lwt.syntax), use_platform-js
<**/*serializable_j.ml>: warn(-32)
true: warn(A-3-6-44-48)
......@@ -346,7 +346,7 @@ module MakeElection (G : GROUP) (M : RANDOM) = struct
type factor = elt partial_decryption
let eg_factor x {alpha; beta} =
let eg_factor x {alpha; _} =
let zkp = "decrypt|" ^ G.to_string (g **~ x) ^ "|" in
alpha **~ x,
fs_prove [| g; alpha |] x (hash zkp)
......@@ -404,8 +404,8 @@ module MakeElection (G : GROUP) (M : RANDOM) = struct
let result = Array.mmap log results in
{num_tallied; encrypted_tally; partial_decryptions; result}
let check_result e pks r =
let {encrypted_tally; partial_decryptions; result; num_tallied} = r in
let check_result pks r =
let {encrypted_tally; partial_decryptions; result; _} = r in
check_ciphertext encrypted_tally &&
Array.forall2 (check_factor encrypted_tally) pks partial_decryptions &&
let dummy = Array.mmap (fun _ -> G.one) encrypted_tally in
......@@ -415,7 +415,7 @@ module MakeElection (G : GROUP) (M : RANDOM) = struct
let results = Array.mmap2 (fun {beta; _} f ->
beta / f
) encrypted_tally factors in
Array.fforall2 (fun r1 r2 -> r1 =~ g **~ Z.of_int r2) results r.result
Array.fforall2 (fun r1 r2 -> r1 =~ g **~ Z.of_int r2) results result
let extract_tally r = r.result
end
......@@ -22,7 +22,6 @@
open Platform
open Serializable_j
open Signatures
open Common
(** Generic group parsing *)
......
......@@ -19,7 +19,6 @@
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Platform
open Serializable_builtin_t
(** {1 Serializers for type number} *)
......
......@@ -228,7 +228,7 @@ module type ELECTION = sig
produce the election result. The first argument is the number of
tallied ballots. May raise [Invalid_argument]. *)
val check_result : t -> public_key array -> result -> bool
val check_result : public_key array -> result -> bool
val extract_tally : result -> plaintext
(** Extract the plaintext result of the election. *)
......
......@@ -38,7 +38,7 @@ let sha256_b64 x =
| Some i -> String.sub raw 0 i
| None -> raw
let b64_encode_compact x = assert false
let b64_encode_compact _ = assert false
let remove_dashes x =
let n = String.length x in
......@@ -71,7 +71,7 @@ let sjcl_random = Js.Unsafe.get sjcl "random"
(* PRNG is initialized in random.js *)
let secure_rng () = ()
let pseudo_rng x () = ()
let pseudo_rng _ () = ()
let string_of_hex hex n =
let res = String.create n in
......@@ -127,7 +127,7 @@ module Z = struct
if lt r zero then r + y else r
let probab_prime x n =
meth_call x "isProbablePrime" [| |] |>
meth_call x "isProbablePrime" [| n |> float_of_int |> Js.number_of_float |> inject |] |>
Js.float_of_number |> int_of_float
let z256 = of_int 256
......@@ -143,7 +143,7 @@ end
type datetime
let now () = assert false
let string_of_datetime x = assert false
let datetime_of_string x = assert false
let datetime_compare x y = assert false
let format_datetime fmt x = assert false
let string_of_datetime _ = assert false
let datetime_of_string _ = assert false
let datetime_compare _ _ = assert false
let format_datetime _ _ = assert false
......@@ -365,22 +365,6 @@ module Mkelection : CMDLINER_MODULE = struct
close_out oc
)
let template_c =
(fun fname ->
if Sys.file_exists fname then (
try
let ic = open_in fname in
let ls = Yojson.init_lexer () in
let lb = Lexing.from_channel ic in
let r = read_template ls lb in
close_in ic;
`Ok (fname, r)
with e ->
let e = Printexc.to_string e and s = Printf.sprintf in
`Error (s "could not read template from %s (%s)" fname e)
) else `Error (Printf.sprintf "file %s does not exist" fname)
), (fun fmt (fname, _) -> Format.pp_print_string fmt fname)
let template_t =
let doc = "Read election template from file $(docv)." in
Arg.(value & opt (some file) None & info ["template"] ~docv:"TEMPLATE" ~doc)
......
......@@ -19,9 +19,7 @@
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Printf
open Platform
open Serializable_builtin_j
open Serializable_j
open Signatures
open Common
......@@ -166,7 +164,7 @@ module Make (P : PARSED_PARAMS) : S = struct
let tally = Lazy.force encrypted_tally in
assert (Array.forall2 (E.check_factor tally) pks factors);
let result = E.combine_factors (M.cardinal ()) tally factors in
assert (E.check_result election pks result);
assert (E.check_result pks result);
string_of_result G.write result
let verify () =
......@@ -176,7 +174,7 @@ module Make (P : PARSED_PARAMS) : S = struct
);
(match get_result () with
| Some result ->
assert (E.check_result election pks (result_of_string G.read result))
assert (E.check_result pks (result_of_string G.read result))
| None -> print_msg "W: no result to check"
);
print_msg "I: all checks passed"
......
......@@ -19,8 +19,6 @@
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Platform
open Serializable_j
open Tool_js_common
open Tool_credgen
......
......@@ -19,10 +19,8 @@
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Platform
open Serializable_j
open Tool_js_common
open Tool_credgen
let (>>=) = Js.Opt.bind
let return = Js.Opt.return
......@@ -132,7 +130,7 @@ let createQuestion q =
let x = Dom_html.createDiv document in
let b = Dom_html.createButton document in
let t = document##createTextNode (Js.string "Add an answer") in
let f e =
let f _ =
let x = createAnswer "" in
Dom.appendChild h_answers x
in
......@@ -141,7 +139,7 @@ let createQuestion q =
Dom.appendChild x b;
let b = Dom_html.createButton document in
let t = document##createTextNode (Js.string "Remove last answer") in
let f e =
let f _ =
let answers = h_answers##querySelectorAll (Js.string ".question_answer") in
let last_answer = answers##item (answers##length - 1) in
last_answer >>= fun x ->
......@@ -212,7 +210,7 @@ let createTemplate template =
let x = Dom_html.createDiv document in
let b = Dom_html.createButton document in
let t = document##createTextNode (Js.string "Add a question") in
let f e =
let f _ =
let x = createQuestion {q_question=""; q_min=0; q_max=1; q_answers=[||]} in
Dom.appendChild h_questions_div x
in
......@@ -221,7 +219,7 @@ let createTemplate template =
Dom.appendChild x b;
let b = Dom_html.createButton document in
let t = document##createTextNode (Js.string "Remove last question") in
let f e =
let f _ =
let questions = h_questions_div##querySelectorAll (Js.string ".question_question") in
let last_question = questions##item (questions##length - 1) in
last_question >>= fun x ->
......@@ -241,7 +239,7 @@ let createTemplate template =
let x = Dom_html.createDiv document in
let b = Dom_html.createButton document in
let t = document##createTextNode (Js.string "Submit") in
let f e =
let f _ =
try
let template = extractTemplate () in
set_textarea "questions" (string_of_template template);
......
......@@ -19,8 +19,6 @@
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Platform
open Serializable_j
open Tool_js_common
open Tool_tkeygen
......
......@@ -19,7 +19,6 @@
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Serializable_builtin_j
open Serializable_j
open Signatures
open Common
......
......@@ -20,7 +20,6 @@
(**************************************************************************)
open Platform
open Serializable_builtin_j
open Serializable_j
open Signatures
open Common
......
......@@ -21,30 +21,13 @@
open Lwt
open Platform
open Signatures
open Common
open Serializable_builtin_t
open Serializable_builtin_j
open Serializable_t
open Web_serializable_t
let spool_dir = ref "."
let enforce_single_element s =
let open Lwt_stream in
lwt t = next s in
lwt b = is_empty s in
(assert_lwt b) >>
Lwt.return t
let load_from_file read fname =
let i = open_in fname in
let buf = Lexing.from_channel i in
let lex = Yojson.init_lexer ~fname () in
let result = read lex buf in
close_in i;
result
let make_rng = Lwt_preemptive.detach (fun () ->
pseudo_rng (random_string secure_rng 16)
)
......@@ -150,12 +133,6 @@ let set_rewrite_prefix ~src ~dst =
else x
in rewrite_fun := f
let uuid = Eliom_parameter.user_type
~of_string:(fun x -> match Uuidm.of_string x with
| Some x -> x
| None -> invalid_arg "uuid")
~to_string:Uuidm.to_string
type election_file =
| ESRaw
| ESKeys
......
......@@ -19,7 +19,6 @@
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Serializable_builtin_t
open Serializable_t
open Web_serializable_t
......
......@@ -21,14 +21,12 @@
open Lwt
open Platform
open Serializable_builtin_t
open Serializable_j
open Signatures
open Common
open Web_serializable_t
open Web_signatures
open Web_common
open Web_services
let ( / ) = Filename.concat
......
......@@ -19,10 +19,7 @@
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Serializable_builtin_t
open Serializable_t
open Signatures
open Web_serializable_t
open Web_signatures
module Make (D : WEB_ELECTION_DATA) (M : RANDOM with type 'a t = 'a Lwt.t) : WEB_ELECTION
......@@ -20,8 +20,6 @@
(**************************************************************************)
open Lwt
open Serializable_t
open Signatures
open Common
open Web_serializable_j
open Web_signatures
......@@ -40,7 +38,6 @@ let () = CalendarLib.Time_Zone.(change Local)
let spool_dir = ref None
let import_dirs = ref []
let source_file = ref None
let main_election_uuid = ref None
let auth_instances = ref []
let () =
......@@ -127,7 +124,7 @@ lwt () =
); return ()
| Some w ->
let module W = (val w : REGISTRABLE_ELECTION) in
lwt w = W.register () in
lwt _ = W.register () in
return ()
)
) !import_dirs
......@@ -20,7 +20,6 @@
(**************************************************************************)
open Lwt
open Serializable_builtin_j
open Serializable_j
open Common
open Web_serializable_j
......
......@@ -23,7 +23,6 @@ open Eliom_service
open Eliom_service.Http
open Eliom_parameter
open Web_common
open Web_signatures
let home = service ~path:[""] ~get_params:unit ()
let admin = service ~path:["admin"] ~get_params:unit ()
......
......@@ -19,10 +19,7 @@
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Serializable_builtin_t
open Serializable_t
open Signatures
open Common
open Web_serializable_t
module type AUTH_SERVICES = sig
......
......@@ -103,7 +103,7 @@ let find_election =
let cache = new WCache.cache raw_find_election 100 in
fun x -> cache#find x
let dump_passwords dir table uuid =
let dump_passwords dir table =
Lwt_io.(with_file Output (dir / "passwords.csv") (fun oc ->
Ocsipersist.iter_step (fun voter (salt, hashed) ->
write_line oc (voter ^ "," ^ salt ^ "," ^ hashed)
......@@ -229,7 +229,7 @@ let import_election f =
let table = "password_" ^ underscorize uuid in
let table = Ocsipersist.open_table table in
lwt size = Ocsipersist.length table in
if size > 0 then dump_passwords dir table uuid else return_unit
if size > 0 then dump_passwords dir table else return_unit
) >>
let () = Lwt_mutex.unlock registration_mutex in
return (module W : WEB_ELECTION)
......@@ -558,7 +558,7 @@ let () =
let () =
Any.register
~service:election_regenpwd
(fun (uuid, ()) user ->
(fun (uuid, ()) () ->
T.regenpwd uuid () >>= Html5.send)
let () =
......@@ -581,7 +581,7 @@ let () =
begin try_lwt
lwt _ = Ocsipersist.find table user in
generate_password table title url user >>
dump_passwords W.dir table uuid_s >>
dump_passwords W.dir table >>
T.generic_page ~title:"Success"
("A new password has been mailed to " ^ user ^ ".") ()
>>= Html5.send
......@@ -896,7 +896,7 @@ let () =
(fun token () ->
lwt uuid = Ocsipersist.find election_pktokens token in
lwt se = Ocsipersist.find election_stable uuid in
T.election_setup_trustee token uuid se ()
T.election_setup_trustee token se ()
)
let () =
......@@ -1192,7 +1192,7 @@ let () =
(Eliom_service.preapply
Web_services.election_login
((W.election.e_params.e_uuid, ()), None))
| Some u -> cont ())
| Some _ -> cont ())
let () =
Any.register
......@@ -1415,7 +1415,7 @@ let content_type_of_file = function
| ESRaw | ESKeys | ESBallots | ESETally | ESResult -> "application/json"
| ESCreds | ESRecords | ESVoters -> "text/plain"
let handle_pseudo_file w u f site_user =
let handle_pseudo_file w f site_user =
let module W = (val w : WEB_ELECTION_DATA) in
let confidential =
match f with
......@@ -1440,7 +1440,7 @@ let () =
lwt w = find_election uuid_s in
lwt site_user = Web_auth_state.get_site_user () in
let module W = (val w) in
handle_pseudo_file w () f site_user)
handle_pseudo_file w f site_user)
let () =
Any.register
......
......@@ -19,7 +19,6 @@
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Web_serializable_t
open Web_signatures
val source_file : string ref
......
......@@ -38,7 +38,7 @@ let configure x =
) x
in
Web_persist.set_auth_config "" auth_config |> Lwt_unix.run;
List.iter (fun {auth_system; auth_instance; auth_config} ->
List.iter (fun {auth_system; auth_config; _} ->
match auth_system with
| "password" ->
let table = Ocsipersist.open_table "password_site" in
......@@ -220,7 +220,7 @@ let login_handler service uuid =
| Some u -> preapply election_login ((u, ()), service)
in
match_lwt Eliom_reference.get user with
| Some u ->
| Some _ ->
cont_push (fun () -> Eliom_registration.Redirection.send (myself service)) >>
Web_templates.already_logged_in () >>= Eliom_registration.Html5.send
| None ->
......
open Web_serializable_t
open Web_signatures
val configure : auth_config list -> unit
......@@ -234,8 +234,6 @@ let admin ~elections () =
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
let format_date = Platform.format_datetime "%a, %d %b %Y %T %z"
let make_button ~service contents =
let uri = Eliom_uri.make_string_uri ~service () in
Printf.ksprintf Unsafe.data (* FIXME: unsafe *)
......@@ -505,7 +503,7 @@ let election_setup_trustees uuid se () =
br ();
ol
(List.rev_map
(fun (token, pk) ->
(fun (token, _) ->
li [
a ~service:election_setup_trustee [
pcdata @@ rewrite_prefix @@ Eliom_uri.make_string_uri
......@@ -531,7 +529,7 @@ let election_setup_trustees uuid se () =
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
let election_setup_credential_authority uuid se () =
let election_setup_credential_authority _ se () =
let title = "Credentials for election " ^ se.se_questions.t_name in
let content = [
div [
......@@ -739,7 +737,7 @@ let election_setup_credentials token uuid se () =
let login_box = pcdata "" in
base ~title ~login_box ~content ()
let election_setup_trustee token uuid se () =
let election_setup_trustee token se () =
let title = "Trustee for election " ^ se.se_questions.t_name in
let form =
let value = !(List.assoc token se.se_public_keys) in
......
......@@ -35,7 +35,7 @@ val election_setup_questions : Uuidm.t -> Web_common.setup_election -> unit -> [
val election_setup_credential_authority : Uuidm.t -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_credentials : string -> string -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_trustees : Uuidm.t -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_trustee : string -> string -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_trustee : string -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_home : (module WEB_ELECTION_DATA) -> Web_persist.election_state -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_admin : (module WEB_ELECTION_DATA) -> Web_persist.election_state -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment