Move some platform-specific functions to a new module

Add module Platform: single interface to functions that depend on the
runtime. For now, the native (existing one), and a dummy one that
constitutes a skeleton for the js one.

All calls to Cryptokit, Z, Calendar (which depends on Unix) in the
command-line tool now go through this module.

myocamlbuild.ml

@@ -19,6 +19,26 @@ let atdgen_action opts env build =
 let js_of_ocaml env build =
   Cmd (S [A"js_of_ocaml"; P (env "%.byte")])
 
+let ( / ) = Filename.concat
+
+let platform_rules kind =
+  let lib = "src" / "lib" in
+  let platform = "src" / "platform" / kind / "platform" in
+  let ml = platform ^ ".ml" in
+  let mli = platform ^ ".mli" in
+  dep ["file:" ^ ml] [mli];
+  copy_rule mli (lib / "platform.mli") mli
+
+let tool_rules platform =
+  let platform = "src" / "platform" / platform / "platform" in
+  let lib = "src" / "lib" / "serializable_builtin_t" in
+  let lib_native = lib ^ ".cmx" in
+  let lib_byte = lib ^ ".cmo" in
+  let cmo = platform ^ ".cmo" in
+  let cmx = platform ^ ".cmx" in
+  dep ["file:" ^ lib_native] [cmx];
+  dep ["file:" ^ lib_byte] [cmo]
+
 let () = dispatch & function
 
   | Before_options ->
@@ -51,6 +71,10 @@ let () = dispatch & function
         Cmd (S [A"markdown"; P (env "%.md"); Sh">"; P (env "%.html")])
       );
 
+    platform_rules "native";
+    platform_rules "js";
+    tool_rules "native";
+
     copy_rule "belenios-tool" ("src/tool/tool_main" ^ exe_suffix) "belenios-tool";
 
   | _ -> ()

src/lib/common.ml

@@ -20,7 +20,6 @@
 (**************************************************************************)
 
 let ( |> ) x f = f x
-let ( =% ) = Z.equal
 
 module Array = struct
   include Array
@@ -138,56 +137,10 @@ let rec list_join sep = function
   | [x] -> [x]
   | x :: xs -> x :: sep :: list_join sep xs
 
-let sha256_hex x = Cryptokit.(x |>
-  hash_string (Hash.sha256 ()) |>
-  transform_string (Hexa.encode ())
-)
-
-let sha256_b64 x = Cryptokit.(x |>
-  hash_string (Hash.sha256 ()) |>
-  transform_string (Base64.encode_compact ())
-)
-
 let option_map f = function
   | Some x -> Some (f x)
   | None -> None
 
-let int_msb i =
-  let result = String.create 4 in
-  result.[0] <- char_of_int (i lsr 24);
-  result.[1] <- char_of_int ((i lsr 16) land 0xff);
-  result.[2] <- char_of_int ((i lsr 8) land 0xff);
-  result.[3] <- char_of_int (i land 0xff);
-  result
-
-let xor a b =
-  let n = String.length a in
-  assert (n = String.length b);
-  let result = String.create n in
-  for i = 0 to n-1 do
-    result.[i] <- char_of_int (int_of_char a.[i] lxor int_of_char b.[i])
-  done;
-  result
-
-let pbkdf2 ~prf ~salt ~iterations ~size password =
-  let c = iterations - 1 in
-  let hLen = (prf password)#hash_size in
-  let result = String.create (hLen * size) in
-  let one_iteration i =
-    let u = Cryptokit.hash_string (prf password) (salt ^ int_msb i) in
-    let rec loop c u accu =
-      if c > 0 then
-        let u' = Cryptokit.hash_string (prf password) u in
-        loop (c-1) u' (xor accu u')
-      else accu
-    in loop c u u
-  in
-  for i = 1 to size do
-    let offset = (i-1) * hLen in
-    String.blit (one_iteration i) 0 result offset hLen;
-  done;
-  result
-
 let save_to filename writer x =
   let oc = open_out filename in
   let ob = Bi_outbuf.create_channel_writer oc in

src/lib/common.mli

@@ -20,7 +20,6 @@
 (**************************************************************************)
 
 val ( |> ) : 'a -> ('a -> 'b) -> 'b
-val ( =% ) : Z.t -> Z.t -> bool
 
 module Array : sig
   include module type of Array
@@ -50,17 +49,8 @@ end
 
 val list_join : 'a -> 'a list -> 'a list
 
-val sha256_hex : string -> string
-val sha256_b64 : string -> string
-
 val option_map : ('a -> 'b) -> 'a option -> 'b option
 
-val pbkdf2 :
-  prf:(string -> Cryptokit.hash) ->
-  salt:string ->
-  iterations:int -> size:int ->
-  string -> string
-
 val save_to : string -> (Bi_outbuf.t -> 'a -> unit) -> 'a -> unit
 
 module SMap : Map.S with type key = string

src/lib/election.ml

@@ -19,6 +19,7 @@
 (*  <http://www.gnu.org/licenses/>.                                       *)
 (**************************************************************************)
 
+open Platform
 open Serializable_t
 open Signatures
 open Common
@@ -39,7 +40,7 @@ let check_election_public_key (type t) g e =
 
 (** Simple monad *)
 
-let prng = lazy (Cryptokit.Random.(pseudo_rng (string secure_rng 16)))
+let prng = lazy (pseudo_rng (random_string secure_rng 16))
 
 module MakeSimpleMonad (G : GROUP) = struct
   type 'a t = unit -> 'a
@@ -51,7 +52,7 @@ module MakeSimpleMonad (G : GROUP) = struct
   let random q =
     let size = Z.size q * Sys.word_size / 8 in
     fun () ->
-      let r = Cryptokit.Random.string (Lazy.force prng) size in
+      let r = random_string (Lazy.force prng) size in
       Z.(of_bits r mod q)
 
   type elt = G.t ballot
@@ -93,7 +94,7 @@ module MakeSimpleDistKeyGen (G : GROUP) (M : RANDOM) = struct
     check_modulo q response &&
     let commitment = g **~ response / (y **~ challenge) in
     let zkp = "pok|" ^ G.to_string y ^ "|" in
-    challenge =% G.hash zkp [| commitment |]
+    Z.(challenge =% G.hash zkp [| commitment |])
 
   let combine pks =
     Array.fold_left (fun y {trustee_public_key; _} ->
@@ -226,7 +227,7 @@ module MakeElection (G : GROUP) (M : RANDOM) = struct
       let prefix = Printf.sprintf "prove|%s|%s,%s|"
         zkp (G.to_string alpha) (G.to_string beta)
       in
-      hash prefix commitments =% !total_challenges
+      Z.(hash prefix commitments =% !total_challenges)
     with Exit -> false
 
   (** Ballot creation *)
@@ -345,7 +346,7 @@ module MakeElection (G : GROUP) (M : RANDOM) = struct
           let commitment = g **~ s_response *~ y **~ s_challenge in
           let prefix = make_sig_prefix zkp commitment in
           let contents = make_sig_contents b.answers in
-          s_challenge =% G.hash prefix contents
+          Z.(s_challenge =% G.hash prefix contents)
         in ok, zkp
       | None -> true, ""
     in ok &&
@@ -383,7 +384,7 @@ module MakeElection (G : GROUP) (M : RANDOM) = struct
           g **~ response / (y **~ challenge);
           alpha **~ response / (f **~ challenge);
         |]
-      in hash zkp commitments =% challenge
+      in Z.(hash zkp commitments =% challenge)
     ) c f.decryption_factors f.decryption_proofs
 
   type result = elt Serializable_t.result

src/lib/election.mli

@@ -21,6 +21,7 @@
 
 (** Election primitives *)
 
+open Platform
 open Serializable_t
 open Signatures
 

src/lib/group.ml

@@ -19,6 +19,7 @@
 (*  <http://www.gnu.org/licenses/>.                                       *)
 (**************************************************************************)
 
+open Platform
 open Serializable_j
 open Signatures
 open Common

src/lib/group_field.ml

@@ -19,6 +19,7 @@
 (*  <http://www.gnu.org/licenses/>.                                       *)
 (**************************************************************************)
 
+open Platform
 open Serializable_j
 open Common
 
@@ -61,7 +62,7 @@ let unsafe_make group =
     let ( *~ ) a b = a * b mod p
     let ( **~ ) a b = powm a b p
     let invert x = Z.invert x p
-    let ( =~ ) = Z.equal
+    let ( =~ ) = Z.( =% )
     let check x = check_modulo p x && x **~ q =~ one
     let to_string = Z.to_string
     let of_string = Z.of_string

src/lib/group_field.mli

@@ -21,6 +21,7 @@
 
 (** Finite field arithmetic *)
 
+open Platform
 open Serializable_t
 
 module type GROUP = Signatures.GROUP

src/lib/lib.mllib

@@ -1,3 +1,4 @@
+src/platform/native/Platform
 Serializable_builtin_t
 Serializable_builtin_j
 Serializable_t

src/lib/platform.mli

@@ -0,0 +1,64 @@
+(**************************************************************************)
+(*                                BELENIOS                                *)
+(*                                                                        *)
+(*  Copyright © 2012-2014 Inria                                           *)
+(*                                                                        *)
+(*  This program 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, with the additional   *)
+(*  exemption that compiling, linking, and/or using OpenSSL is allowed.   *)
+(*                                                                        *)
+(*  This program 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 this program.  If not, see                         *)
+(*  <http://www.gnu.org/licenses/>.                                       *)
+(**************************************************************************)
+
+val sha256_hex : string -> string
+val sha256_b64 : string -> string
+
+val b64_encode_compact : string -> string
+
+val derive_cred : Uuidm.t -> string -> string
+
+type rng
+val secure_rng : rng
+val pseudo_rng : string -> rng
+val random_string : rng -> int -> string
+
+module Z : sig
+  type t
+  val zero : t
+  val one : t
+  val of_int : int -> t
+  val of_string : string -> t
+  val of_string_base : int -> string -> t
+  val ( + ) : t -> t -> t
+  val ( - ) : t -> t -> t
+  val ( * ) : t -> t -> t
+  val ( mod ) : t -> t -> t
+  val erem : t -> t -> t
+  val to_int : t -> int
+  val to_string : t -> string
+  val compare : t -> t -> int
+  val ( =% ) : t -> t -> bool
+  val geq : t -> t -> bool
+  val lt : t -> t -> bool
+  val powm : t -> t -> t -> t
+  val invert : t -> t -> t
+  val probab_prime : t -> int -> int
+  val size : t -> int
+  val of_bits : string -> t
+end
+
+type datetime
+val now : unit -> datetime
+val string_of_datetime : datetime -> string
+val datetime_of_string : string -> datetime
+val datetime_compare : datetime -> datetime -> int
+val format_datetime : string -> datetime -> string

src/lib/serializable_builtin_j.ml

@@ -19,6 +19,7 @@
 (*  <http://www.gnu.org/licenses/>.                                       *)
 (**************************************************************************)
 
+open Platform
 open Serializable_builtin_t
 
 (** {1 Helpers for interacting with atd-generated stuff} *)
@@ -72,20 +73,9 @@ let uuid_of_string x =
 
 (** {1 Serializers for type datetime} *)
 
-open CalendarLib
-let datetime_format = "%Y-%m-%d %H:%M:%S"
-
-let write_datetime buf (n, s) =
+let write_datetime buf n =
   Bi_outbuf.add_char buf '"';
-  (match s with
-     | Some s -> Bi_outbuf.add_string buf s
-     | None ->
-       let n = Fcalendar.Precise.to_gmt n in
-       Bi_outbuf.add_string buf (Printer.Precise_Fcalendar.sprint datetime_format n);
-       let ts = Printf.sprintf "%.6f" (Fcalendar.Precise.to_unixfloat n) in
-       let i = String.index ts '.' in
-       Bi_outbuf.add_substring buf ts i (String.length ts - i);
-  );
+  Bi_outbuf.add_string buf (Platform.string_of_datetime n);
   Bi_outbuf.add_char buf '"'
 
 let string_of_datetime ?(len=28) n =
@@ -94,12 +84,7 @@ let string_of_datetime ?(len=28) n =
   Bi_outbuf.contents buf
 
 let datetime_of_json = function
-  | `String s ->
-    let i = String.index s '.' in
-    let l = Printer.Precise_Fcalendar.from_fstring datetime_format (String.sub s 0 i) in
-    let l = Fcalendar.Precise.from_gmt l in
-    let r = float_of_string ("0" ^ String.sub s i (String.length s-i)) in
-    (Fcalendar.Precise.add l (Fcalendar.Precise.Period.second r), Some s)
+  | `String s -> Platform.datetime_of_string s
   | _ -> assert false
 
 let read_datetime state buf =

src/lib/serializable_builtin_j.mli

@@ -19,6 +19,7 @@
 (*  <http://www.gnu.org/licenses/>.                                       *)
 (**************************************************************************)
 
+open Platform
 open Serializable_builtin_t
 
 (** {1 Serializers for type number} *)

src/lib/serializable_builtin_t.ml

@@ -19,9 +19,11 @@
 (*  <http://www.gnu.org/licenses/>.                                       *)
 (**************************************************************************)
 
+open Platform
+
 type number = Z.t
 type uuid = Uuidm.t
-type datetime = CalendarLib.Fcalendar.Precise.t * string option
+type datetime = Platform.datetime
 type int_or_null = int option
 
 module SSet = Set.Make(String)

src/lib/serializable_builtin_t.mli

@@ -19,9 +19,11 @@
 (*  <http://www.gnu.org/licenses/>.                                       *)
 (**************************************************************************)
 
+open Platform
+
 type number = Z.t
 type uuid = Uuidm.t
-type datetime = CalendarLib.Fcalendar.Precise.t * string option
+type datetime = Platform.datetime
 type int_or_null = int option
 
 module SSet : Set.S with type elt = string

src/lib/signatures.mli

@@ -21,6 +21,7 @@
 
 (** Signatures *)
 
+open Platform
 open Serializable_t
 
 (** Helpers for interacting with atd stuff *)