Source file conex_verify.ml

open Conex_utils
open Conex_resource

type error = [
  | `UnknownKey of identifier
  | `InvalidBase64Encoding of identifier
  | `InvalidSignature of identifier
  | `InvalidPublicKey of identifier
]

(*BISECT-IGNORE-BEGIN*)
let pp_error ppf = function
  | `UnknownKey id -> Format.fprintf ppf "unknown public key %a" pp_id id
  | `InvalidBase64Encoding id -> Format.fprintf ppf "signature %a: no valid base64 encoding" pp_id id
  | `InvalidSignature id -> Format.fprintf ppf "invalid signature %a" pp_id id
  | `InvalidPublicKey id -> Format.fprintf ppf "invalid public key %a" pp_id id
(*BISECT-IGNORE-END*)

module type S_RSA_BACK = sig
  val verify_rsa_pss : key:string -> data:string -> signature:string -> identifier -> (unit, [> error ]) result

  val sha256 : string -> string
end

module type S = sig
  val raw_digest : string -> Digest.t

  val digest : Wire.t -> Digest.t

  val verify : Wire.t -> Key.t M.t -> Signature.t M.t ->
    identifier Digest_map.t * error list
end

(** Instantiation. *)
module Make (C : S_RSA_BACK) = struct

  let raw_digest data = `SHA256, C.sha256 data

  let digest data = raw_digest (Wire.to_string data)

  let verify_signature data key (id, created, alg, signature) =
    match alg, key with
    | `RSA_PSS_SHA256, (_, _, `RSA, key) ->
      let data = Wire.to_string (to_be_signed data created id alg) in
      C.verify_rsa_pss ~key ~data ~signature id

  (* using a digest map here to uniquify the public keys! *)
  let verify data keys sigs =
    M.fold (fun _ (id, created, alg, s) (ok, err) ->
        match M.find id keys with
        | None -> (ok, `UnknownKey id :: err)
        | Some key ->
          match verify_signature data key (id, created, alg, s) with
          | Ok () ->
            let dgst = Key.keyid raw_digest key in
            (Digest_map.add dgst id ok, err)
          | Error e -> (ok, e :: err))
      sigs (Digest_map.empty, [])
end