|
|
@@ -198,7 +198,7 @@ let clob_send _ ct clob =
|
|
|
* https://datatracker.ietf.org/doc/html/draft-cavage-http-signatures-12
|
|
|
* see also https://github.com/Gopiandcode/http_sig_ocaml/blob/254d464c16025e189ceb20190710fe50e9bd8d2b/http_sig.ml#L50
|
|
|
*
|
|
|
- * Another list of k-v-pairs but in diiosyncratic encoding. Different from Cookie.
|
|
|
+ * Another list of k-v-pairs but in idiosyncratic encoding. Different from Cookie.
|
|
|
*)
|
|
|
module Signature = struct
|
|
|
(* https://datatracker.ietf.org/doc/html/rfc7230#section-3.2.6 *)
|
|
|
@@ -279,29 +279,34 @@ module Signature = struct
|
|
|
let decode = Tyre.exec P.list_auth_param'
|
|
|
|
|
|
(** the header value without escaping e.g. = or "" *)
|
|
|
- let encode = Tyre.eval P.list_auth_param
|
|
|
+ let encode =
|
|
|
+ (*
|
|
|
+ |> List.fold_left (fun init (k,v) -> Printf.sprintf {|%s="%s"|} k v :: init) []
|
|
|
+ |> Astring.String.concat ~sep:"," in
|
|
|
+ *)
|
|
|
+ Tyre.eval P.list_auth_param
|
|
|
|
|
|
- let to_sign_string ~request h =
|
|
|
+ let to_sign_string0 ~request h : string =
|
|
|
let h = h |> Cohttp.Header.to_frames in
|
|
|
(match request with
|
|
|
+ | None -> h
|
|
|
| Some (meth,uri) ->
|
|
|
let s = Printf.sprintf "(request-target): %s %s"
|
|
|
(meth |> Cohttp.Code.string_of_method |> String.lowercase_ascii)
|
|
|
(uri |> Uri.path_and_query) in
|
|
|
- s :: h
|
|
|
- | _ -> h)
|
|
|
+ s :: h)
|
|
|
|> Astring.String.concat ~sep:"\n"
|
|
|
|
|
|
- (**
|
|
|
+ (**
|
|
|
- key_id
|
|
|
- - signing function
|
|
|
+ - pk
|
|
|
- now *)
|
|
|
- type t_key = Uri.t * (Cstruct.t-> string * Cstruct.t) * Ptime.t
|
|
|
+ type t_key = Uri.t * X509.Private_key.t * Ptime.t
|
|
|
|
|
|
- let mkey id fu t : t_key = (id,fu,t)
|
|
|
+ let mkey id pk t : t_key = (id,pk,t)
|
|
|
|
|
|
(** build the string to sign *)
|
|
|
- let to_sign_string2
|
|
|
+ let to_sign_string'
|
|
|
(meth : Cohttp.Code.meth)
|
|
|
(targ : Uri.t)
|
|
|
(hdrs : (string * string) list) =
|
|
|
@@ -318,6 +323,36 @@ module Signature = struct
|
|
|
:: s in
|
|
|
n,s
|
|
|
|
|
|
+ let to_sign_string meth targ hdrs =
|
|
|
+ let n,l = to_sign_string' meth targ hdrs in
|
|
|
+ n |> Astring.String.concat ~sep:" "
|
|
|
+ ,
|
|
|
+ l |> Cohttp.Header.of_list
|
|
|
+ |> Cohttp.Header.to_frames
|
|
|
+ |> Astring.String.concat ~sep:"\n"
|
|
|
+
|
|
|
+ (**
|
|
|
+ HTTP signature according https://tools.ietf.org/id/draft-cavage-http-signatures-12.html#rfc.appendix.C
|
|
|
+ *)
|
|
|
+ module RSA_SHA256 = struct
|
|
|
+ let hash = `SHA256
|
|
|
+ and scheme = `RSA_PKCS1
|
|
|
+ let name = "rsa-sha256"
|
|
|
+ and sign = X509.Private_key.sign hash ~scheme
|
|
|
+ and verify = X509.Public_key.verify hash ~scheme
|
|
|
+ end
|
|
|
+
|
|
|
+ (**
|
|
|
+ HTTP signature according https://tools.ietf.org/id/draft-cavage-http-signatures-12.html#rfc.appendix.C
|
|
|
+ *)
|
|
|
+ module HS2019 = struct
|
|
|
+ let hash = `SHA512
|
|
|
+ and scheme = `RSA_PSS
|
|
|
+ let name = "hs2019"
|
|
|
+ and sign = X509.Private_key.sign hash ~scheme
|
|
|
+ and verify = X509.Public_key.verify hash ~scheme
|
|
|
+ end
|
|
|
+
|
|
|
let add
|
|
|
(priv : X509.Private_key.t)
|
|
|
(meth : Cohttp.Code.meth)
|
|
|
@@ -327,20 +362,17 @@ module Signature = struct
|
|
|
assert (targ |> Uri.host |> Option.is_some);
|
|
|
assert (hdrs |> List.assoc_opt "host" |> Option.is_some);
|
|
|
assert (hdrs |> List.assoc "host" |> Astring.String.equal (targ |> Uri.host_with_default ~default:""));
|
|
|
- let n,s = to_sign_string2 meth targ hdrs in
|
|
|
- let s = s |> Cohttp.Header.of_list |> Cohttp.Header.to_frames |> Astring.String.concat ~sep:"\n" in
|
|
|
- let n = n |> Astring.String.concat ~sep:" " in
|
|
|
+ let n,s = to_sign_string meth targ hdrs in
|
|
|
(* build the signature header value *)
|
|
|
- match `Message (s |> Cstruct.of_string) |> X509.Private_key.sign `SHA256 ~scheme:`RSA_PKCS1 priv with
|
|
|
- | Error _ as e -> e
|
|
|
- | Ok s ->
|
|
|
+ match RSA_SHA256.(name,(sign priv (`Message (s |> Cstruct.of_string) ))) with
|
|
|
+ | _,(Error _ as e) -> e
|
|
|
+ | alg,Ok si ->
|
|
|
let v = [
|
|
|
- "signature", s |> Cstruct.to_string |> Base64.encode_string;
|
|
|
+ "algorithm",alg;
|
|
|
"headers" ,n;
|
|
|
- "algorithm","rsa-sha256";
|
|
|
+ "signature", si |> Cstruct.to_string |> Base64.encode_string;
|
|
|
]
|
|
|
- |> List.fold_left (fun init (k,v) -> Printf.sprintf {|%s="%s"|} k v :: init) []
|
|
|
- |> Astring.String.concat ~sep:"," in
|
|
|
+ |> encode in
|
|
|
Ok ( hdrs @ ["signature",v] )
|
|
|
end
|
|
|
|
|
|
@@ -360,7 +392,7 @@ end
|
|
|
|
|
|
NOT: https://datatracker.ietf.org/doc/draft-ietf-httpbis-message-signatures/
|
|
|
*)
|
|
|
-let signed_headers (key_id,fkt_sign,date : Signature.t_key) dige uri =
|
|
|
+let signed_headers (key_id,pk,date : Signature.t_key) dige uri =
|
|
|
let open Cohttp in
|
|
|
let hdr = (
|
|
|
("host", uri |> Uri.host |> Option.value ~default:"-") ::
|
|
|
@@ -378,17 +410,21 @@ let signed_headers (key_id,fkt_sign,date : Signature.t_key) dige uri =
|
|
|
let tx_ = tx_ |> Cohttp.Header.of_list |> Cohttp.Header.to_frames |> Astring.String.concat ~sep:"\n" in
|
|
|
assert (tx_ |> String.equal tx');
|
|
|
*)
|
|
|
- let request = Some (meth,uri) in
|
|
|
- let tx' = hdr
|
|
|
- |> Header.of_list
|
|
|
- |> Signature.to_sign_string ~request in
|
|
|
- let algo,sgna = tx'
|
|
|
- |> Cstruct.of_string
|
|
|
- |> fkt_sign in
|
|
|
+ let tx = hdr
|
|
|
+ |> Cohttp.Header.of_list
|
|
|
+ |> Signature.to_sign_string0 ~request:(Some (meth,uri)) in
|
|
|
+ let sgna =
|
|
|
+ Signature.RSA_SHA256.sign
|
|
|
+ pk
|
|
|
+ (`Message (Cstruct.of_string tx))
|
|
|
+ |> Result.get_ok
|
|
|
+ |> Cstruct.to_string
|
|
|
+ |> Base64.encode_exn
|
|
|
+ in
|
|
|
["keyId", key_id |> Uri.to_string ;
|
|
|
- "algorithm", algo ;
|
|
|
+ "algorithm", Signature.RSA_SHA256.name ;
|
|
|
"headers", "(request-target) host date" ^ lst ;
|
|
|
- "signature", sgna |> Cstruct.to_string |> Base64.encode_exn ;
|
|
|
+ "signature", sgna ;
|
|
|
]
|
|
|
|> Signature.encode
|
|
|
(*
|
Marcus Rohrmoser