common.ml 6.13 KB
Newer Older
Stephane Glondu's avatar
Stephane Glondu committed
1 2 3
(**************************************************************************)
(*                                BELENIOS                                *)
(*                                                                        *)
Stephane Glondu's avatar
Stephane Glondu committed
4
(*  Copyright © 2012-2018 Inria                                           *)
Stephane Glondu's avatar
Stephane Glondu committed
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
(*                                                                        *)
(*  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/>.                                       *)
(**************************************************************************)

22 23
open Platform

24 25 26
module Array = struct
  include Array

27 28 29 30 31 32 33
  let exists f a =
    let n = Array.length a in
    (let rec check i =
       if i >= 0 then f a.(i) || check (pred i)
       else false
     in check (pred n))

34 35 36 37 38 39 40
  let forall f a =
    let n = Array.length a in
    (let rec check i =
       if i >= 0 then f a.(i) && check (pred i)
       else true
     in check (pred n))

41 42 43 44 45 46 47 48
  let forall2 f a b =
    let n = Array.length a in
    n = Array.length b &&
    (let rec check i =
       if i >= 0 then f a.(i) b.(i) && check (pred i)
       else true
     in check (pred n))

Stephane Glondu's avatar
Stephane Glondu committed
49 50 51 52 53 54 55
  let fforall f xs =
    let rec loop_outer i =
      if i >= 0 then
        let x = xs.(i) in
        let n = Array.length x in
        let rec loop_inner j =
          if j >= 0 then f x.(j) && loop_inner (pred j)
Stephane Glondu's avatar
Stephane Glondu committed
56
          else loop_outer (pred i)
Stephane Glondu's avatar
Stephane Glondu committed
57 58 59 60 61 62 63 64 65 66 67 68 69 70
        in loop_inner (pred n)
      else true
    in
    let n = Array.length xs in
    loop_outer (pred n)

  let fforall2 f xs ys =
    let rec loop_outer i =
      if i >= 0 then
        let x = xs.(i) and y = ys.(i) in
        let n = Array.length x in
        n = Array.length y &&
        let rec loop_inner j =
          if j >= 0 then f x.(j) y.(j) && loop_inner (pred j)
71
          else loop_outer (pred i)
Stephane Glondu's avatar
Stephane Glondu committed
72 73 74 75 76 77 78
        in loop_inner (pred n)
      else true
    in
    let n = Array.length xs in
    n = Array.length ys &&
    loop_outer (pred n)

79 80 81 82 83 84 85 86 87
  let fforall3 f xs ys zs =
    let rec loop_outer i =
      if i >= 0 then
        let x = xs.(i) and y = ys.(i) and z = zs.(i) in
        let n = Array.length x in
        n = Array.length y &&
        n = Array.length z &&
        let rec loop_inner j =
          if j >= 0 then f x.(j) y.(j) z.(j) && loop_inner (pred j)
88
          else loop_outer (pred i)
89 90 91 92 93 94 95 96
        in loop_inner (pred n)
      else true
    in
    let n = Array.length xs in
    n = Array.length ys &&
    n = Array.length zs &&
    loop_outer (pred n)

Stephane Glondu's avatar
Stephane Glondu committed
97 98 99
  let map2 f a b =
    Array.mapi (fun i ai -> f ai b.(i)) a

100 101 102 103 104 105 106 107 108
  let map3 f a b c =
    Array.mapi (fun i ai -> f ai b.(i) c.(i)) a

  let mmap f a =
    Array.map (fun ai ->
      Array.map f ai
    ) a

  let mmap2 f a b =
Stephane Glondu's avatar
Stephane Glondu committed
109 110 111 112 113 114 115
    Array.mapi (fun i ai ->
      let bi = b.(i) in
      Array.mapi (fun j aj ->
        f aj bi.(j)
      ) ai
    ) a

116 117 118 119 120 121 122 123 124 125
  let mmap3 f a b c =
    Array.mapi (fun i ai ->
      let bi = b.(i) and ci = c.(i) in
      Array.mapi (fun j aj ->
        f aj bi.(j) ci.(j)
      ) ai
    ) a

  let ssplit a =
    mmap fst a, mmap snd a
126 127 128 129 130 131 132 133 134 135 136

  let findi f a =
    let n = Array.length a in
    let rec loop i =
      if i < n then
        match f i a.(i) with
        | None -> loop (i+1)
        | Some _ as x -> x
      else None
    in loop 0

137 138
end

139 140 141
module String = struct
  include String

Stephane Glondu's avatar
Stephane Glondu committed
142 143 144
  let startswith x s =
    let xn = String.length x and sn = String.length s in
    xn >= sn && String.sub x 0 sn = s
145
end
146

147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164
module List = struct
  include List

  let rec join sep = function
    | [] -> []
    | [x] -> [x]
    | x :: xs -> x :: sep :: join sep xs

  let rec filter_map f = function
    | [] -> []
    | x :: xs ->
       let ys = filter_map f xs in
       match f x with
       | None -> ys
       | Some y -> y :: ys
end

module Option = struct
165 166 167 168
  let iter f = function
    | None -> ()
    | Some x -> f x

169 170 171 172 173 174 175 176
  let get x default_value = match x with
    | None -> default_value
    | Some x -> x

  let map f = function
    | Some x -> Some (f x)
    | None -> None
end
177

178 179 180 181 182 183 184
let save_to filename writer x =
  let oc = open_out filename in
  let ob = Bi_outbuf.create_channel_writer oc in
  writer ob x;
  Bi_outbuf.add_char ob '\n';
  Bi_outbuf.flush_channel_writer ob;
  close_out oc;;
185

186 187 188 189
let b64_order = "+/0123456789aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ"

let compare_b64 a b =
  let na = String.length a and nb = String.length b in
190 191 192 193 194
  let value_of c =
    match String.index_opt b64_order c with
    | Some i -> i
    | None -> -1
  in
195 196 197 198 199 200 201 202 203 204
  let rec loop i =
    match (i < na), (i < nb) with
    | true, true ->
       let diff = value_of a.[i] - value_of b.[i] in
       if diff = 0 then loop (i+1) else diff
    | true, false -> 1
    | false, true -> -1
    | false, false -> 0
  in loop 0

205
module SSet = Set.Make(String)
206
module SMap = Map.Make(String)
207 208 209

(** Direct random monad *)

210 211 212 213 214 215
let bytes_to_sample q =
  (* we take 128 additional bits of random before the mod q, so that
     the statistical distance with a uniform distribution in [0,q[ is
     negligible *)
  Z.bit_length q / 8 + 17

216 217 218 219 220 221 222 223 224
module DirectRandom = struct
  type 'a t = 'a
  let return x = x
  let bind x f = f x
  let fail e = raise e

  let prng = lazy (pseudo_rng (random_string secure_rng 16))

  let random q =
225
    let size = bytes_to_sample q in
226 227 228
    let r = random_string (Lazy.force prng) size in
    Z.(of_bits r mod q)
end