mte/src/crypto.ml

(* TODO key format
   - check what is the exact format in GNUNET
   - endianess issue? *)
module EddsaPublicKey = struct
  (* EdDSA and ECDHE public keys always point on Curve25519
     and represented  using the standard 256 bits Ed25519 compact format,
     converted to Crockford Base32. *)
  open Mirage_crypto_ec.Ed25519

  type t = pub

  let to_octets t = pub_to_octets t

  let of_octets t =
    pub_of_octets t |> function
    | Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e
    | Ok v -> Ok v

  let bin =
    let of_octets o =
      match of_octets o with Error e -> raise (Util.Bin_error e) | Ok v -> v
    in
    Bin.map (Bin.bytes 32) of_octets to_octets

  let of_b32 s =
    let open Syntax in
    let* octets = B32.decode s in
    let* pub = of_octets octets in
    Ok pub

  let to_b32 t = B32.encode (to_octets t)
  let jsont = Jsont.of_of_string ~kind:"EddsaPublicKey" of_b32 ~enc:to_b32

  let caqti =
    Caqti_type.custom
      ~encode:(fun v -> Ok (to_octets v))
      ~decode:(fun v -> of_octets v)
      Caqti_type.octets
end

module EddsaPrivateKey = struct
  (* EdDSA and ECDHE public keys always point on Curve25519
     and represented  using the standard 256 bits Ed25519 compact format,
     converted to Crockford Base32. *)
  open Mirage_crypto_ec.Ed25519

  type t = priv

  let pub_of_priv = pub_of_priv
  let to_octets t = priv_to_octets t

  let of_octets t =
    priv_of_octets t |> function
    | Error err ->
        let err = Fmt.str "%a" Mirage_crypto_ec.pp_error err in
        Error err
    | Ok v -> Ok v

  let bin =
    let of_octets_exn t = of_octets t |> Result.get_ok in
    Bin.map (Bin.bytes 32) of_octets_exn to_octets

  let jsont =
    let of_b32 s =
      let open Syntax in
      let* octets = B32.decode s in
      of_octets octets
    in
    let to_b32 t = B32.encode (to_octets t) in
    Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32
end

module EddsaSignature : sig
  type t

  val sign : key:EddsaPrivateKey.t -> string -> t

  (* Ok () on verification success *)
  val verify : key:EddsaPublicKey.t -> t -> msg:string -> (unit, string) result
  val to_octets : t -> string
  val of_octets : string -> (t, string) result
  val jsont : t Jsont.t
  val bin : t Bin.t
  val caqti : t Caqti_type.t
end = struct
  (* TODO key format
     endianess issue? *)
  (* transmitted as 64-bytes base32
     binary-encoded objects with just the R and S values *)
  type t = string

  (* mirage_crypto: "The result is the concatenation of r and s, as specified in RFC 8032." *)
  let sign ~key s = Mirage_crypto_ec.Ed25519.sign ~key s

  let verify ~key s ~msg =
    let b = Mirage_crypto_ec.Ed25519.verify ~key s ~msg in
    match b with
    | false -> Error "signature verification failure: invalid signature"
    | true -> Ok ()

  let to_octets t = t

  let of_octets v =
    match String.length v = 64 with
    | false ->
        Fmt.error "EddsaSignature.of_octets failure: data is not 64 bytes."
    | true -> Ok v

  let bin =
    let of_octets_exn t = of_octets t |> Result.get_ok in
    Bin.map (Bin.bytes 64) of_octets_exn to_octets

  let check_size t =
    match String.length t = 64 with
    | false -> Error "EddsaSignature: invalid string length"
    | true -> Ok ()

  let jsont =
    let of_b32 s =
      let open Syntax in
      let* t = B32.decode s in
      let+ () = check_size t in
      t
    in
    let to_b32 = B32.encode in
    Jsont.of_of_string ~kind:"EddsaSignature" of_b32 ~enc:to_b32

  let caqti =
    Caqti_type.custom
      ~encode:(fun v -> Ok (to_octets v))
      ~decode:(fun s -> of_octets s)
      Caqti_type.octets
end

module RsaPublicKey = struct
  open Mirage_crypto_pk

  type t = Rsa.pub

  let to_octets = Util.Bin_rsa.pub_to_octets
  let of_octets = Util.Bin_rsa.pub_of_octets

  let jsont =
    let of_b32 s =
      let open Syntax in
      let* s = B32.decode s in
      let+ v = of_octets s in
      v
    in
    let to_b32 t = B32.encode (to_octets t) in
    Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32

  let caqti : t Caqti_type.t =
    Caqti_type.custom
      ~encode:(fun v -> Ok (to_octets v))
      ~decode:(fun v -> of_octets v)
      Caqti_type.octets
end

module RsaPrivateKey = struct
  open Mirage_crypto_pk.Rsa

  type t = priv

  let generate ~bits () =
    let priv = generate ~bits () in
    let pub = pub_of_priv priv in
    (priv, pub)

  let pub_of_priv = pub_of_priv
  let of_octets = Util.Bin_rsa.priv_of_octets
  let to_octets = Util.Bin_rsa.priv_to_octets

  let jsont =
    let of_b32 s =
      let open Syntax in
      let* s = B32.decode s in
      let+ v = of_octets s in
      v
    in
    let to_b32 t = B32.encode (to_octets t) in
    Jsont.of_of_string ~kind:"RsaPrivateKey" of_b32 ~enc:to_b32
end

module RsaSignature : sig
  type t

  val sign : key:Mirage_crypto_pk.Rsa.priv -> string -> t
  val jsont : t Jsont.t
end = struct
  type t = string

  (* TODO rsa sign *)
  let sign ~key s =
    Mirage_crypto_pk.Rsa.decrypt ~crt_hardening:true ~mask:`Yes ~key s

  let jsont =
    let of_b32 s = B32.decode s in
    let to_b32 t = B32.encode t in
    Jsont.of_of_string ~kind:"RsaSignature" of_b32 ~enc:to_b32
end

(* some type aliases, just for prettier .mli *)
type eddsa_priv = EddsaPrivateKey.t
type eddsa_pub = EddsaPublicKey.t
type eddsa_sig = EddsaSignature.t
type rsa_priv = RsaPrivateKey.t
type rsa_pub = RsaPublicKey.t
type rsa_sig = RsaSignature.t
type denomination_hash = Bin_type.DenominationHash.t