|
@@ -154,37 +154,28 @@ module PubKeyPem = struct
|
|
* https://discuss.ocaml.org/t/tls-signature-with-opam-tls/9399/9?u=mro
|
|
* https://discuss.ocaml.org/t/tls-signature-with-opam-tls/9399/9?u=mro
|
|
* https://mirleft.github.io/ocaml-x509/doc/x509/X509/Private_key/#cryptographic-sign-operation
|
|
* https://mirleft.github.io/ocaml-x509/doc/x509/X509/Private_key/#cryptographic-sign-operation
|
|
*)
|
|
*)
|
|
- ("rsa-sha256",
|
|
|
|
- X509.Private_key.sign
|
|
|
|
- `SHA256
|
|
|
|
- ~scheme:`RSA_PKCS1
|
|
|
|
- pk
|
|
|
|
- (`Message data)
|
|
|
|
- |> Result.get_ok)
|
|
|
|
|
|
+ (Http.Signature.RSA_SHA256.name, Http.Signature.RSA_SHA256.sign pk (`Message data)
|
|
|
|
+ |> Result.get_ok)
|
|
|
|
|
|
(** https://datatracker.ietf.org/doc/html/draft-cavage-http-signatures-12#autoid-38
|
|
(** https://datatracker.ietf.org/doc/html/draft-cavage-http-signatures-12#autoid-38
|
|
*)
|
|
*)
|
|
- let verify ~algo ~inbox ~(key : X509.Public_key.t) ~signature data =
|
|
|
|
- let data = `Message data
|
|
|
|
|
|
+ let verify ~algo ~inbox ~key ~signature data =
|
|
|
|
+ let data = `Message data
|
|
and _ = inbox in
|
|
and _ = inbox in
|
|
match algo with
|
|
match algo with
|
|
| "hs2019" -> (* https://datatracker.ietf.org/doc/html/draft-cavage-http-signatures-12#autoid-38 *)
|
|
| "hs2019" -> (* https://datatracker.ietf.org/doc/html/draft-cavage-http-signatures-12#autoid-38 *)
|
|
- (match X509.Public_key.verify
|
|
|
|
- `SHA512
|
|
|
|
- ~scheme:`RSA_PSS
|
|
|
|
|
|
+ (match Http.Signature.HS2019.verify
|
|
~signature
|
|
~signature
|
|
key
|
|
key
|
|
data with
|
|
data with
|
|
| Error (`Msg "bad signature") ->
|
|
| Error (`Msg "bad signature") ->
|
|
(* gotosocial and unnamed other AP implementations seem to use `SHA256 and `RSA_PKCS1
|
|
(* gotosocial and unnamed other AP implementations seem to use `SHA256 and `RSA_PKCS1
|
|
- while
|
|
|
|
|
|
+ while
|
|
https://datatracker.ietf.org/doc/html/draft-cavage-http-signatures-12#autoid-38
|
|
https://datatracker.ietf.org/doc/html/draft-cavage-http-signatures-12#autoid-38
|
|
and
|
|
and
|
|
https://datatracker.ietf.org/doc/id/draft-richanna-http-message-signatures-00.html#name-hs2019
|
|
https://datatracker.ietf.org/doc/id/draft-richanna-http-message-signatures-00.html#name-hs2019
|
|
as I understand them recommend `SHA512 and `RSA_PSS. *)
|
|
as I understand them recommend `SHA512 and `RSA_PSS. *)
|
|
- (match X509.Public_key.verify
|
|
|
|
- `SHA256
|
|
|
|
- ~scheme:`RSA_PKCS1
|
|
|
|
|
|
+ (match Http.Signature.RSA_SHA256.verify
|
|
~signature
|
|
~signature
|
|
key
|
|
key
|
|
data with
|
|
data with
|
|
@@ -194,9 +185,7 @@ module PubKeyPem = struct
|
|
| x -> x)
|
|
| x -> x)
|
|
| x -> x)
|
|
| x -> x)
|
|
| "rsa-sha256" ->
|
|
| "rsa-sha256" ->
|
|
- X509.Public_key.verify
|
|
|
|
- `SHA256
|
|
|
|
- ~scheme:`RSA_PKCS1
|
|
|
|
|
|
+ Http.Signature.RSA_SHA256.verify
|
|
~signature
|
|
~signature
|
|
key
|
|
key
|
|
data
|
|
data
|
|
@@ -591,7 +580,7 @@ module Activity = struct
|
|
let body = make_like sndr act_type date post_uri rcpt
|
|
let body = make_like sndr act_type date post_uri rcpt
|
|
|> As2_vocab.Encode.like ~base
|
|
|> As2_vocab.Encode.like ~base
|
|
|> Ezjsonm.value_to_string in
|
|
|> Ezjsonm.value_to_string in
|
|
- let headers = Http.signed_headers (key,PubKeyPem.sign pk,date) (digest_base64' body) inbx in
|
|
|
|
|
|
+ let headers = Http.signed_headers (key,pk,date) (digest_base64' body) inbx in
|
|
let headers = Http.H.add' headers Http.H.ct_json in
|
|
let headers = Http.H.add' headers Http.H.ct_json in
|
|
let headers = Http.H.add' headers Http.H.acc_app_jlda in
|
|
let headers = Http.H.add' headers Http.H.acc_app_jlda in
|
|
Logr.info (fun m -> m "-> http POST %a" Uri.pp inbx);
|
|
Logr.info (fun m -> m "-> http POST %a" Uri.pp inbx);
|
|
@@ -1292,14 +1281,12 @@ module Note = struct
|
|
agent = None;
|
|
agent = None;
|
|
attachment = [];
|
|
attachment = [];
|
|
cc = [];
|
|
cc = [];
|
|
- content = "";
|
|
|
|
content_map = [];
|
|
content_map = [];
|
|
in_reply_to = [];
|
|
in_reply_to = [];
|
|
media_type = (Some Http.Mime.text_html); (* https://www.w3.org/TR/activitystreams-vocabulary/#dfn-mediatype *)
|
|
media_type = (Some Http.Mime.text_html); (* https://www.w3.org/TR/activitystreams-vocabulary/#dfn-mediatype *)
|
|
published = None;
|
|
published = None;
|
|
sensitive = false;
|
|
sensitive = false;
|
|
source = None;
|
|
source = None;
|
|
- summary = None;
|
|
|
|
summary_map = [];
|
|
summary_map = [];
|
|
tags = [];
|
|
tags = [];
|
|
to_ = [];
|
|
to_ = [];
|
|
@@ -1336,25 +1323,24 @@ module Note = struct
|
|
| _ -> None in
|
|
| _ -> None in
|
|
(* let Rfc4287.Rfc3066 lang = e.lang in *)
|
|
(* let Rfc4287.Rfc3066 lang = e.lang in *)
|
|
let tags = e.categories |> List.fold_left tag [] in
|
|
let tags = e.categories |> List.fold_left tag [] in
|
|
- let summary,content = match e.title,e.content with
|
|
|
|
- | "","" -> None,"." (* empty is forbidden *)
|
|
|
|
- | t,"" -> None,t
|
|
|
|
- | t,c -> Some t,c in
|
|
|
|
|
|
+ let Rfc4287.Rfc4646 lang = e.lang in
|
|
|
|
+ let summary_map = [lang,e.title] in
|
|
|
|
+ let content_map = [lang,e.content] in
|
|
let url = e.links |> List.fold_left (
|
|
let url = e.links |> List.fold_left (
|
|
(* sift those without a rel *)
|
|
(* sift those without a rel *)
|
|
fun i (l : Rfc4287.Link.t) ->
|
|
fun i (l : Rfc4287.Link.t) ->
|
|
match l.rel with
|
|
match l.rel with
|
|
| None -> l.href :: i
|
|
| None -> l.href :: i
|
|
| Some _ -> i) [] in
|
|
| Some _ -> i) [] in
|
|
- assert (not (content |> String.equal ""));
|
|
|
|
|
|
+ assert (content_map |> List.length > 0);
|
|
{empty with
|
|
{empty with
|
|
id;
|
|
id;
|
|
actor;
|
|
actor;
|
|
|
|
+ content_map;
|
|
cc;
|
|
cc;
|
|
- content;
|
|
|
|
media_type = Some Http.Mime.text_plain;
|
|
media_type = Some Http.Mime.text_plain;
|
|
published;
|
|
published;
|
|
- summary;
|
|
|
|
|
|
+ summary_map;
|
|
tags;
|
|
tags;
|
|
to_;
|
|
to_;
|
|
url;
|
|
url;
|
|
@@ -1371,12 +1357,17 @@ module Note = struct
|
|
| Some u -> u );
|
|
| Some u -> u );
|
|
uri = Some n.actor} in
|
|
uri = Some n.actor} in
|
|
let a (s,_,_) = s in
|
|
let a (s,_,_) = s in
|
|
|
|
+ let (lang,cont) = n.content_map |> List.hd in
|
|
|
|
+ let sum = try let _,s = n.summary_map |> List.hd in
|
|
|
|
+ Some s
|
|
|
|
+ with Failure _ -> None
|
|
|
|
+ in
|
|
{Rfc4287.Entry.empty with
|
|
{Rfc4287.Entry.empty with
|
|
id = n.id;
|
|
id = n.id;
|
|
author;
|
|
author;
|
|
- (* @TODO lang *)
|
|
|
|
- title = n.summary |> Option.value ~default:"" |> Html.to_plain |> a;
|
|
|
|
- content = n.content |> Html.to_plain |> a;
|
|
|
|
|
|
+ lang = Rfc4287.Rfc4646 lang;
|
|
|
|
+ title = sum |> Option.value ~default:"" |> Html.to_plain |> a;
|
|
|
|
+ content = cont |> Html.to_plain |> a;
|
|
published;
|
|
published;
|
|
updated = published;
|
|
updated = published;
|
|
in_reply_to = n.in_reply_to |> List.map Rfc4287.Inreplyto.make;
|
|
in_reply_to = n.in_reply_to |> List.map Rfc4287.Inreplyto.make;
|
|
@@ -1394,22 +1385,32 @@ module Note = struct
|
|
let html_to_plain _s =
|
|
let html_to_plain _s =
|
|
failwith "not implemented yet."
|
|
failwith "not implemented yet."
|
|
|
|
|
|
|
|
+ let has_content_warning _sum =
|
|
|
|
+ if true
|
|
|
|
+ then true
|
|
|
|
+ else false
|
|
|
|
+
|
|
(* Mastodon uses the summary as content warning. That's not what the summary intends.
|
|
(* Mastodon uses the summary as content warning. That's not what the summary intends.
|
|
formerly know as pleistocenify *)
|
|
formerly know as pleistocenify *)
|
|
let diluviate (n : As2_vocab.Types.note) =
|
|
let diluviate (n : As2_vocab.Types.note) =
|
|
- let c = match n.summary with
|
|
|
|
- | None -> ""
|
|
|
|
- | Some t -> (t |> plain_to_html) ^ "<br/>\n" in
|
|
|
|
|
|
+ let _ = if has_content_warning n.summary_map
|
|
|
|
+ then ()
|
|
|
|
+ else ()
|
|
|
|
+ in
|
|
|
|
+ let c = match n.summary_map with
|
|
|
|
+ | [] -> ""
|
|
|
|
+ | (_,su) :: _ -> (su |> plain_to_html) ^ "<br/>\n" in
|
|
let c = n.url |> List.fold_left (fun i u ->
|
|
let c = n.url |> List.fold_left (fun i u ->
|
|
let s = u |> Uri.to_string in
|
|
let s = u |> Uri.to_string in
|
|
Printf.sprintf "%s<a href='%s'>%s</a><br/>\n" i s s) c in
|
|
Printf.sprintf "%s<a href='%s'>%s</a><br/>\n" i s s) c in
|
|
let c = if c |> String.equal ""
|
|
let c = if c |> String.equal ""
|
|
then c
|
|
then c
|
|
- else (* add an emoty line *) c ^ "<br/>\n" in
|
|
|
|
- let c = c ^ (n.content |> plain_to_html) in
|
|
|
|
|
|
+ else c ^ "<br/>\n" in
|
|
|
|
+ let la,c' = n.content_map |> List.hd in
|
|
|
|
+ let c = c ^ (c' |> plain_to_html) in
|
|
{n with
|
|
{n with
|
|
- summary = None;
|
|
|
|
- content = c;
|
|
|
|
|
|
+ summary_map = [];
|
|
|
|
+ content_map = [la,c];
|
|
url = [n.id] }
|
|
url = [n.id] }
|
|
|
|
|
|
module Create = struct
|
|
module Create = struct
|
|
@@ -1427,14 +1428,15 @@ module Note = struct
|
|
obj = obj;
|
|
obj = obj;
|
|
}
|
|
}
|
|
|
|
|
|
|
|
+ (** turn an Atom entry into an ActivityPub (Mastodon) Create Note activity. *)
|
|
let to_json ~base n =
|
|
let to_json ~base n =
|
|
|
|
+ let context = As2_vocab.Constants.ActivityStreams.und in
|
|
n
|
|
n
|
|
|> of_rfc4287
|
|
|> of_rfc4287
|
|
|> diluviate
|
|
|> diluviate
|
|
(* let c = {c with to_ = [id]} in *)
|
|
(* let c = {c with to_ = [id]} in *)
|
|
|> make
|
|
|> make
|
|
- |> As2_vocab.Encode.(create ~base ~context:As2_vocab.Constants.ActivityStreams.und
|
|
|
|
- (note ~base))
|
|
|
|
|
|
+ |> As2_vocab.Encode.(create ~base ~context (note ~base))
|
|
end
|
|
end
|
|
|
|
|
|
module Delete = struct
|
|
module Delete = struct
|