Skip to content
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
30 changes: 9 additions & 21 deletions lib/algorithm.ml
Original file line number Diff line number Diff line change
Expand Up @@ -11,20 +11,14 @@ open Asn_grammars
* that handles unsupported algos anyway.
*)

type ec_curve =
[ `SECP256R1 | `SECP384R1 | `SECP521R1 ]

let ec_curve_to_string = function
| `SECP256R1 -> "SECP256R1"
| `SECP384R1 -> "SECP384R1"
| `SECP521R1 -> "SECP521R1"
let ec_curve_to_string = Dsa_curves.get_name

type t =

(* pk algos *)
(* any more? is the universe big enough? ramsey's theorem for pk cyphers? *)
| RSA
| EC_pub of ec_curve
| EC_pub of Dsa_curves.t

(* sig algos *)
| MD5_RSA
Expand Down Expand Up @@ -198,18 +192,12 @@ and of_signature_algorithm public_key_algorithm digest =
Section 2.3.1 specifies rsaEncryption (for RSA public keys) requires null.
*)

let curve_of_oid, curve_to_oid =
let open Registry.ANSI_X9_62 in
(let default oid = Asn.(S.parse_error "Unknown algorithm %a" OID.pp oid) in
case_of_oid ~default [
(secp256r1, `SECP256R1) ;
(secp384r1, `SECP384R1) ;
(secp521r1, `SECP521R1) ;
]),
(function
| `SECP256R1 -> secp256r1
| `SECP384R1 -> secp384r1
| `SECP521R1 -> secp521r1)
let curve_of_oid oid =
match Dsa_curves.find oid with
| Some c -> c
| None -> Asn.(S.parse_error "Unknown algorithm with OID %a" OID.pp oid)

let curve_to_oid = Dsa_curves.get_oid

let identifier =
let open Registry in
Expand Down Expand Up @@ -239,7 +227,7 @@ let identifier =
and octets f = function
| Some (`C4 salt) -> f salt
| _ -> parse_error "Algorithm: expected parameter octet_string"
and default oid = Asn.(S.parse_error "Unknown algorithm %a" OID.pp oid)
and default oid = Asn.(S.parse_error "Unknown algorithm with OID %a" OID.pp oid)
in

case_of_oid_f ~default [
Expand Down
51 changes: 51 additions & 0 deletions lib/dsa_curves.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,51 @@
module type Dsa = Mirage_crypto_ec.Dsa

module OIDs = Registry.ANSI_X9_62

module type S = sig
val name : string
val oid : Asn.oid
module Dsa : Dsa
end

type t = (module S)

let curves, add_curve =
let curves = ref [] in
(fun () -> !curves),
(fun c -> curves := c :: !curves)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

this uses a list, which is ever growing. I wonder what about registration of the same curve multiple times? Since the lookup in the list is done by name, shouldn't we use a map?


let register name oid (module Dsa:Dsa) =
let c = (module struct
let name = String.lowercase_ascii name
let oid = oid
module Dsa = Dsa
end : S) in
add_curve c;
c

let strings () =
List.map (fun (module C : S) ->
(C.name, `ECDSA (module C : S)))
(curves ())

let find oid : t option =
List.find_opt (fun (module C : S) -> C.oid = oid) (curves ())

let get_dsa c =
let (module C : S) = c in
(module C.Dsa : Dsa)

let get_name c =
let (module C : S) = c in
C.name

let get_oid c =
let (module C : S) = c in
C.oid

let of_name name =
List.find_opt (fun (module C : S) -> C.name = name) (curves ())

let names () =
List.map (fun (module C : S) -> C.name) (curves ())
29 changes: 17 additions & 12 deletions lib/key_type.ml
Original file line number Diff line number Diff line change
@@ -1,17 +1,22 @@
type t = [ `RSA | `ED25519 | `P256 | `P384 | `P521 ]
type t = [ `RSA | `ED25519 | `ECDSA of Dsa_curves.t]

let strings =
[ ("rsa", `RSA) ; ("ed25519", `ED25519) ;
("p256", `P256) ; ("p384", `P384) ; ("p521", `P521) ]
let strings () =
("rsa", `RSA) :: ("ed25519", `ED25519) :: (Dsa_curves.strings ())

let to_string kt = fst (List.find (fun (_, k) -> kt = k) strings)
let to_string = function
| `RSA -> "rsa"
| `ED25519 -> "ed25519"
| `ECDSA c -> Dsa_curves.get_name c

let of_string s =
match List.assoc_opt (String.lowercase_ascii s) strings with
| Some kt -> Ok kt
| None ->
Error (`Msg (Fmt.str "unkown key type %s, supported are %a"
s Fmt.(list ~sep:(any ", ") string) (List.map fst strings)))
match String.lowercase_ascii s with
| "rsa" -> Ok `RSA
| "ed25519" -> Ok `ED25519
| s -> match Dsa_curves.of_name s with
| Some c -> Ok (`ECDSA c)
| None ->
Error (`Msg (Fmt.str "unkown key type %s, supported are %a"
s Fmt.(list ~sep:(any ", ") string) (List.map fst (strings ()))))

let pp ppf t = Fmt.string ppf (to_string t)

Expand All @@ -29,7 +34,7 @@ let supports_signature_scheme key_typ scheme =
match key_typ, scheme with
| `RSA, (`RSA_PSS | `RSA_PKCS1) -> true
| `ED25519, `ED25519 -> true
| (`P256 | `P384 | `P521), `ECDSA -> true
| `ECDSA _, `ECDSA -> true
| _ -> false

let opt_signature_scheme ?scheme kt =
Expand All @@ -38,7 +43,7 @@ let opt_signature_scheme ?scheme kt =
| None -> match kt with
| `RSA -> `RSA_PSS
| `ED25519 -> `ED25519
| `P256 | `P384 | `P521 -> `ECDSA
| `ECDSA _ -> `ECDSA

(* the default of RSA keys should be PSS, but most deployed certificates still
use PKCS1 (and this library uses pkcs1 by default as well) *)
Expand Down
81 changes: 43 additions & 38 deletions lib/private_key.ml
Original file line number Diff line number Diff line change
@@ -1,23 +1,22 @@
let ( let* ) = Result.bind

type ecdsa = [
| `P256 of Mirage_crypto_ec.P256.Dsa.priv
| `P384 of Mirage_crypto_ec.P384.Dsa.priv
| `P521 of Mirage_crypto_ec.P521.Dsa.priv
]
type ecdsa = Ecdsa : {
curve : (module Dsa_curves.S with type Dsa.priv = 'priv);
priv : 'priv
} -> ecdsa

type t = [
ecdsa
| `RSA of Mirage_crypto_pk.Rsa.priv
| `ED25519 of Mirage_crypto_ec.Ed25519.priv
| `ECDSA of ecdsa
]

let key_type = function
| `RSA _ -> `RSA
| `ED25519 _ -> `ED25519
| `P256 _ -> `P256
| `P384 _ -> `P384
| `P521 _ -> `P521
| `ECDSA Ecdsa k ->
let (module C) = k.curve in
`ECDSA ((module C) : Dsa_curves.t)

let generate ?seed ?(bits = 4096) typ =
let g = match seed with
Expand All @@ -27,9 +26,12 @@ let generate ?seed ?(bits = 4096) typ =
match typ with
| `RSA -> `RSA (Mirage_crypto_pk.Rsa.generate ?g ~bits ())
| `ED25519 -> `ED25519 (fst (Mirage_crypto_ec.Ed25519.generate ?g ()))
| `P256 -> `P256 (fst (Mirage_crypto_ec.P256.Dsa.generate ?g ()))
| `P384 -> `P384 (fst (Mirage_crypto_ec.P384.Dsa.generate ?g ()))
| `P521 -> `P521 (fst (Mirage_crypto_ec.P521.Dsa.generate ?g ()))
| `ECDSA (module C : Dsa_curves.S) ->
let priv = Ecdsa {
curve = (module C);
priv = (fst (C.Dsa.generate ?g ()))
} in
`ECDSA priv

let of_octets data =
let open Mirage_crypto_ec in
Expand All @@ -43,15 +45,13 @@ let of_octets data =
| `ED25519 ->
let* k = ec_err (Ed25519.priv_of_octets data) in
Ok (`ED25519 k)
| `P256 ->
let* k = ec_err (P256.Dsa.priv_of_octets data) in
Ok (`P256 k)
| `P384 ->
let* k = ec_err (P384.Dsa.priv_of_octets data) in
Ok (`P384 k)
| `P521 ->
let* k = ec_err (P521.Dsa.priv_of_octets data) in
Ok (`P521 k)
| `ECDSA (module C : Dsa_curves.S) ->
let* k = ec_err (C.Dsa.priv_of_octets data) in
let priv = Ecdsa {
curve = (module C);
priv = k
} in
Ok (`ECDSA priv)

let of_string ?seed_or_data ?bits typ data =
match seed_or_data with
Expand All @@ -71,9 +71,13 @@ let of_string ?seed_or_data ?bits typ data =
let public = function
| `RSA priv -> `RSA (Mirage_crypto_pk.Rsa.pub_of_priv priv)
| `ED25519 priv -> `ED25519 (Mirage_crypto_ec.Ed25519.pub_of_priv priv)
| `P256 priv -> `P256 (Mirage_crypto_ec.P256.Dsa.pub_of_priv priv)
| `P384 priv -> `P384 (Mirage_crypto_ec.P384.Dsa.pub_of_priv priv)
| `P521 priv -> `P521 (Mirage_crypto_ec.P521.Dsa.pub_of_priv priv)
| `ECDSA Ecdsa k ->
let (module Curve) = k.curve in
let pub = Public_key.Ecdsa {
curve = (module Curve);
pub = Curve.Dsa.pub_of_priv k.priv
} in
`ECDSA pub

let sign hash ?scheme key data =
let open Mirage_crypto_ec in
Expand All @@ -96,12 +100,11 @@ let sign hash ?scheme key data =
| `Message m -> Ok (Ed25519.sign ~key m)
| `Digest _ -> Error (`Msg "Ed25519 only suitable with raw message")
end
| #ecdsa as key, `ECDSA ->
| `ECDSA (Ecdsa k), `ECDSA ->
let* d = hashed () in
Ok (ecdsa_to_str (match key with
| `P256 key -> P256.Dsa.(sign ~key (Public_key.trunc byte_length d))
| `P384 key -> P384.Dsa.(sign ~key (Public_key.trunc byte_length d))
| `P521 key -> P521.Dsa.(sign ~key (Public_key.trunc byte_length d))))
let (module Curve) = k.curve in
let key = k.priv in
Ok (ecdsa_to_str (Curve.Dsa.(sign ~key (Public_key.trunc byte_length d))))
| _ -> Error (`Msg "invalid key and signature scheme combination")
with
| Mirage_crypto_pk.Rsa.Insufficient_key ->
Expand Down Expand Up @@ -187,12 +190,14 @@ module Asn = struct
let ec_of_str, ec_to_str =
Asn_grammars.project_exn ec_private_key

let reparse_ec_private curve priv =
let open Mirage_crypto_ec in
match curve with
| `SECP256R1 -> let* p = P256.Dsa.priv_of_octets priv in Ok (`P256 p)
| `SECP384R1 -> let* p = P384.Dsa.priv_of_octets priv in Ok (`P384 p)
| `SECP521R1 -> let* p = P521.Dsa.priv_of_octets priv in Ok (`P521 p)
let reparse_ec_private (curve : Dsa_curves.t) priv =
let (module Curve) = curve in
let* p = Curve.Dsa.priv_of_octets priv in
let k = Ecdsa {
curve = (module Curve);
priv = p
} in
Ok (`ECDSA k)

(* external use (result) *)
let ec_priv_of_str =
Expand Down Expand Up @@ -235,9 +240,9 @@ module Asn = struct
match p with
| `RSA pk -> RSA, rsa_priv_to_str pk
| `ED25519 pk -> ED25519, ed25519_to_str (Ed25519.priv_to_octets pk)
| `P256 pk -> EC_pub `SECP256R1, ec_to_str (P256.Dsa.priv_to_octets pk)
| `P384 pk -> EC_pub `SECP384R1, ec_to_str (P384.Dsa.priv_to_octets pk)
| `P521 pk -> EC_pub `SECP521R1, ec_to_str (P521.Dsa.priv_to_octets pk)
| `ECDSA Ecdsa k ->
let (module Curve) = k.curve in
EC_pub (module Curve), ec_to_str (Curve.Dsa.priv_to_octets k.priv)
in
(0, alg, cs)

Expand Down
50 changes: 25 additions & 25 deletions lib/public_key.ml
Original file line number Diff line number Diff line change
@@ -1,15 +1,14 @@
let ( let* ) = Result.bind

type ecdsa = [
| `P256 of Mirage_crypto_ec.P256.Dsa.pub
| `P384 of Mirage_crypto_ec.P384.Dsa.pub
| `P521 of Mirage_crypto_ec.P521.Dsa.pub
]
type ecdsa = Ecdsa : {
curve : (module Dsa_curves.S with type Dsa.pub = 'pub);
pub : 'pub
} -> ecdsa

type t = [
| ecdsa
| `RSA of Mirage_crypto_pk.Rsa.pub
| `ED25519 of Mirage_crypto_ec.Ed25519.pub
| `ECDSA of ecdsa
]

module Asn_oid = Asn.OID
Expand Down Expand Up @@ -49,9 +48,12 @@ module Asn = struct
function
| (RSA , cs) -> `RSA (rsa_pub_of_octets cs)
| (ED25519 , cs) -> `ED25519 (to_err (Ed25519.pub_of_octets cs))
| (EC_pub `SECP256R1, cs) -> `P256 (to_err (P256.Dsa.pub_of_octets cs))
| (EC_pub `SECP384R1, cs) -> `P384 (to_err (P384.Dsa.pub_of_octets cs))
| (EC_pub `SECP521R1, cs) -> `P521 (to_err (P521.Dsa.pub_of_octets cs))
| (EC_pub (module Curve), cs) ->
let pub = Ecdsa {
curve = (module Curve);
pub = to_err (Curve.Dsa.pub_of_octets cs)
} in
`ECDSA pub
| _ -> parse_error "unknown public key algorithm"

let unparse_pk =
Expand All @@ -60,9 +62,9 @@ module Asn = struct
function
| `RSA pk -> (RSA, rsa_pub_to_octets pk)
| `ED25519 pk -> (ED25519, Ed25519.pub_to_octets pk)
| `P256 pk -> (EC_pub `SECP256R1, P256.Dsa.pub_to_octets pk)
| `P384 pk -> (EC_pub `SECP384R1, P384.Dsa.pub_to_octets pk)
| `P521 pk -> (EC_pub `SECP521R1, P521.Dsa.pub_to_octets pk)
| `ECDSA (Ecdsa k) ->
let (module Curve) = k.curve in
(EC_pub (module Curve), Curve.Dsa.pub_to_octets k.pub)

let pk_info_der =
map reparse_pk unparse_pk @@
Expand All @@ -78,9 +80,9 @@ let id k =
let data = match k with
| `RSA p -> Asn.rsa_public_to_octets p
| `ED25519 pk -> Mirage_crypto_ec.Ed25519.pub_to_octets pk
| `P256 pk -> Mirage_crypto_ec.P256.Dsa.pub_to_octets pk
| `P384 pk -> Mirage_crypto_ec.P384.Dsa.pub_to_octets pk
| `P521 pk -> Mirage_crypto_ec.P521.Dsa.pub_to_octets pk
| `ECDSA Ecdsa k ->
let (module Curve) = k.curve in
Curve.Dsa.pub_to_octets k.pub
in
Digestif.(to_raw_string SHA1 (digest_string SHA1 data))

Expand All @@ -91,12 +93,12 @@ let fingerprint ?(hash = `SHA256) pub =
let key_type = function
| `RSA _ -> `RSA
| `ED25519 _ -> `ED25519
| `P256 _ -> `P256
| `P384 _ -> `P384
| `P521 _ -> `P521
| `ECDSA Ecdsa k ->
let (module C) = k.curve in
`ECDSA ((module C) : Dsa_curves.t)

let sig_alg = function
| #ecdsa -> `ECDSA
| `ECDSA _ -> `ECDSA
| `RSA _ -> `RSA
| `ED25519 _ -> `ED25519

Expand Down Expand Up @@ -142,14 +144,12 @@ let verify hash ?scheme ~signature key data =
| `Message msg -> ok_if_true (Ed25519.verify ~key signature ~msg)
| `Digest _ -> Error (`Msg "Ed25519 only suitable with raw message")
end
| #ecdsa as key, `ECDSA ->
| `ECDSA Ecdsa k, `ECDSA ->
let* d = hashed hash data in
let* s = ecdsa_of_str signature in
ok_if_true
(match key with
| `P256 key -> P256.Dsa.verify ~key s (trunc P256.Dsa.byte_length d)
| `P384 key -> P384.Dsa.verify ~key s (trunc P384.Dsa.byte_length d)
| `P521 key -> P521.Dsa.verify ~key s (trunc P521.Dsa.byte_length d))
let (module Curve) = k.curve in
let key = k.pub in
ok_if_true Curve.Dsa.(verify ~key s (trunc byte_length d))
| _ -> Error (`Msg "invalid key and signature scheme combination")

let encode_der = Asn.pub_info_to_octets
Expand Down
Loading