Algebra.ml

(** Useful algebraic structures *)

(* Copyright Xavier Leroy.
   License: LGPL 2.1 or later with OCaml LGPL Linking Exception *)

(* Modular arithmetic over integers *)

module type MODARITH = sig
  type t
  val zero : t
  val one : t
  val of_int : int -> t
  val of_Z : Z.t -> t
  val add : t -> t -> t
  val sub : t -> t -> t
  val neg : t -> t
  val mul : t -> t -> t
  val inv : t -> t
  val div : t -> t -> t
  val pow : t -> Z.t -> t
  val powi : t -> int -> t
  val to_string : t -> string
  val to_Z : t -> Z.t
  val to_int : t -> int
  val order : Z.t
  val to_bytes : t -> string
  val of_bytes : string -> t
  val random : rng:Cryptokit.Random.rng -> t
  val random_not_0 : rng:Cryptokit.Random.rng -> t
  val ( + ) : t -> t -> t
  val ( - ) : t -> t -> t
  val ( -~ ) : t -> t
  val ( * ) : t -> t -> t
  val ( / ) : t -> t -> t
  val ( ** ) : t -> Z.t -> t
  val ( **$ ) : t -> int -> t
end

(* Trim leading null characters from a string *)

let trim s =
  let rec trim i =
    if i >= String.length s || s.[i] <> '\000'
    then String.sub s i (String.length s - i)
    else trim (i + 1)
  in trim 0

(* Big integers modulo p. *)

module Z_p (M: sig val p: Z.t end) : MODARITH with type t = Z.t = struct
  let m = M.p
  type t = Z.t
  let zero = Z.zero
  let one = Z.one
  let of_int n = Z.(erem (of_int n) m)
  let of_Z n = Z.(erem n m)
  let add x y = Z.(erem (x + y) m)
  let sub x y = Z.(erem (x - y) m)
  let neg x = Z.(erem (m - x) m)
  let mul x y = Z.(erem (mul x y) m)
  let inv x = Z.invert x m
  let div x y = mul x (inv y)
  let pow x n = Z.powm x n m
  let powi x n = Z.(powm x (of_int n) m)
  let to_string = Z.to_string
  let to_Z x = x
  let to_int = Z.to_int
  let order = Z.pred m
  let to_bytes n = trim (CryptokitBignum.to_bytes ~numbits:(Z.numbits m) n)
  let of_bytes b = of_Z (CryptokitBignum.of_bytes b)
  let random ~rng =
    Z.random_int_gen ~fill:rng#random_bytes m
  let random_not_0 ~rng =
    Z.succ (Z.random_int_gen ~fill:rng#random_bytes (Z.pred m))
  let ( + ) = add
  let ( - ) = sub
  let ( -~ ) = neg
  let ( * ) = mul
  let ( / ) = div
  let ( ** ) = pow
  let ( **$ ) = powi
end

(* Small integers modulo p. *)

module Int_p (M: sig val p: int end) : MODARITH with type t = int = struct
  let m = M.p
  type t = int
  let zero = 0
  let one = 1
  let of_int n =
    let r = n mod m in
    if r < 0 then r + m else r
  let of_Z n =
    Z.(to_int (erem n (of_int m)))
  let add x y = of_int (x + y)
  let sub x y = of_int (x - y)
  let neg x = of_int (-x)
  let mul x y =
    Z.(to_int (erem (mul (of_int x) (of_int y)) (of_int m)))
  let inv x =
    Z.(to_int (invert (of_int x) (of_int m)))
  let div x y =
    mul x (inv y)
  let pow x n =
    Z.(to_int (powm (of_int x) n (of_int m)))
  let powi x n =
    Z.(to_int (powm (of_int x) (of_int n) (of_int m)))
  let to_string = string_of_int
  let to_Z x = Z.of_int x
  let to_int x = x
  let order = Z.of_int (m - 1)
  let to_bytes n =
    CryptokitBignum.to_bytes ~numbits:Z.(numbits (of_int m)) (Z.of_int n)
  let of_bytes b =
    of_Z (CryptokitBignum.of_bytes b)
  let random ~rng =
    Z.(to_int (random_int_gen ~fill:rng#random_bytes (Z.of_int m)))
  let random_not_0 ~rng =
    Z.(to_int (succ (Z.random_int_gen ~fill:rng#random_bytes (Z.of_int Stdlib.(m - 1)))))
  let ( + ) = add
  let ( - ) = sub
  let ( -~ ) = neg
  let ( * ) = mul
  let ( / ) = div
  let ( ** ) = pow
  let ( **$ ) = powi
end

(* Multiplicative finite group *)

module type GROUP = sig
  type t
  val one: t
  val mul: t -> t -> t
  val ( * ): t -> t -> t
  val inv: t -> t
  val div: t -> t -> t
  val ( / ): t -> t -> t
  val pow: t -> Z.t -> t
  val ( ** ): t -> Z.t -> t
  val powi: t -> int -> t
  val ( **$ ): t -> int -> t
  val generator: t
  val order: Z.t
  val to_bytes: t -> string
end

(* Elliptic curve as a multiplicative group *)

module type ELLIPTIC_CURVE =
  sig
    include GROUP
    val field : Z.t
    val bitsize : int
  end

module Curve (C: Cryptokit.ELLIPTIC_CURVE)
       : ELLIPTIC_CURVE with type t = C.point
       = struct
  type t = C.point
  let one = C.zero
  let generator = C.generator
  let mul = C.add
  let inv = C.neg
  let div x y = mul x (inv y)
  let pow x n = C.mul n x
  let powi x n = C.mul (Z.of_int n) x
  let order = C.Params.order
  let field = C.Params.p
  let bitsize = C.Params.size
  let to_bytes x = C.encode_point ~compressed:true x
  let ( * ) = mul
  let ( / ) = div
  let ( ** ) = pow
  let ( **$ ) = powi
end

(* Some NIST curves *)

module P256 = Curve(Cryptokit.P256)
module P384 = Curve(Cryptokit.P384)

(* Z/pZ as a multiplicative group, for good values of p. *)

(* 1536-bit MODP "group 5" from RFC 3526 *)

module Group5 =
struct
  include Z_p(struct let p = Z.of_string "0x\
FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD1\
29024E088A67CC74020BBEA63B139B22514A08798E3404DD\
EF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245\
E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7ED\
EE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3D\
C2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F\
83655D23DCA3AD961C62F356208552BB9ED529077096966D\
670C354E4ABC9804F1746C08CA237327FFFFFFFFFFFFFFFF" end)
  let generator = Z.of_int 2
end

(* 2048-bit MODP "group 14" from RFC 3526 *)

module Group14 =
struct
  include Z_p(struct let p = Z.of_string "0x\
FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD1\
29024E088A67CC74020BBEA63B139B22514A08798E3404DD\
EF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245\
E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7ED\
EE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3D\
C2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F\
83655D23DCA3AD961C62F356208552BB9ED529077096966D\
670C354E4ABC9804F1746C08CA18217C32905E462E36CE3B\
E39E772C180E86039B2783A2EC07A28FB5C55DF06F4C52C9\
DE2BCBF6955817183995497CEA956AE515D2261898FA0510\
15728E5A8AACAA68FFFFFFFFFFFFFFFF" end)
  let generator = Z.of_int 2
end

(* Rings *)

module type RING = sig
  type t
  val zero: t
  val one: t
  val add: t -> t -> t
  val ( + ): t -> t -> t
  val neg: t -> t
  val ( -~ ): t -> t
  val sub: t -> t -> t
  val ( - ): t -> t -> t
  val mul: t -> t -> t
  val ( * ): t -> t -> t
end

(* Polynomials *)

module Polynomials (M: RING) = struct

  type t = M.t list   (* least degrees first *)

  let zero = []
  let one = [M.one]
  let const n = [n]
  let _X = [M.zero; M.one]

  let degree p =
    let rec deg d i = function
      | [] -> d
      | x :: p -> deg (if x = M.zero then d else i) (i + 1) p
    in deg 0 0 p

  let constant = function
    | [] -> M.zero
    | x :: p -> x

  let eval p x =
    List.fold_left
      (fun acc c -> M.add (M.mul acc x) c)
      M.zero
      (List.rev p)

  let rec add p q =
    match p, q with
    | [], _ -> q
    | _, [] -> p
    | x :: p, y :: q -> M.add x y :: add p q

  let rec sub p q =
    match p, q with
    | [], _ -> q
    | _, [] -> p
    | x :: p, y :: q -> M.sub x y :: add p q

  let rec scale s p =
    match p with
    | [] -> []
    | x :: p -> M.mul s x :: scale s p

  let rec mul p q =
    match p with
    | [] -> []
    | x :: p -> add (scale x q) (M.zero :: mul p q)

end