seppo/test/as2_test.ml

(*
 *    _  _   ____                         _  
 *  _| || |_/ ___|  ___ _ __  _ __   ___ | | 
 * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| | 
 * |_      _|___) |  __/ |_) | |_) | (_) |_| 
 *   |_||_| |____/ \___| .__/| .__/ \___/(_) 
 *                     |_|   |_|             
 *
 * Personal Social Web.
 *
 * as2_test.ml
 *
 * Copyright (C) The #Seppo contributors. All rights reserved.
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 *)

open Seppo_lib

let test_digest_sha256 () =
  Logr.debug (fun m -> m "as2_test.test_digest_sha256");
  let (`Hex h) =
    "" |> Cstruct.of_string |> Mirage_crypto.Hash.SHA256.digest
    |> Hex.of_cstruct
  in
  (* https://de.wikipedia.org/wiki/SHA-2 *)
  h
  |> Assrt.equals_string __LOC__
    "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855";
  "" |> Cstruct.of_string |> Mirage_crypto.Hash.SHA256.digest
  |> Cstruct.to_string |> Base64.encode_exn
  (* printf "%s" "" | openssl dgst -sha256 -binary | base64 *)
  |> Assrt.equals_string __LOC__
    "47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU="

let test_digst () =
  Logr.debug (fun m -> m "as2_test.test_digst");
  "" |> Ap.Activity.digest_base64
  |> Assrt.equals_string __LOC__
    "SHA-256=47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU=";
  assert true

let test_person () =
  Logr.debug (fun m -> m "as2_test.test_person");
  let pubdate = Ptime_clock.now ()
  and pem = "foo"
  and pro = ({
      title    = "Sepp"; (* similar atom:subtitle *)
      bio      = "sum"; (* similar atom:description *)
      language = Rfc4287.Rfc4646 "de";
      timezone = Timedesc.Time_zone.utc;
      posts_per_page = 50;
    } : Cfg.Profile.t)
  and uid = "sepp"
  and base = Uri.of_string "https://example.com/subb/" in
  let Rfc4287.Rfc4646 context = pro.language in
  let context = Some context in
  let p = Ap.Person.prsn pubdate (pem, (pro, (Auth.Uid uid, base))) in
  p |> As2_vocab.Encode.person ~context ~base
  |> Ezjsonm.value_to_string ~minify:false
  |> Assrt.equals_string __LOC__ {|{
  "@context": [
    "https://www.w3.org/ns/activitystreams",
    "https://w3id.org/security/v1",
    {
      "schema": "http://schema.org#",
      "PropertyValue": "schema:PropertyValue",
      "value": "schema:value",
      "@language": "de"
    }
  ],
  "type": "Person",
  "id": "https://example.com/subb/activitypub/actor.jsa",
  "inbox": "https://example.com/subb/seppo.cgi/activitypub/inbox.jsa",
  "outbox": "https://example.com/subb/activitypub/outbox/index.jsa",
  "followers": "https://example.com/subb/activitypub/notify/index.jsa",
  "following": "https://example.com/subb/activitypub/subscribed/index.jsa",
  "name": "Sepp",
  "url": [
    "https://example.com/subb/"
  ],
  "preferredUsername": "sepp",
  "summary": "sum",
  "summaryMap": {
    "de": "sum"
  },
  "publicKey": {
    "@context": [
      {
        "@language": null
      }
    ],
    "id": "https://example.com/subb/activitypub/actor.jsa#main-key",
    "owner": "https://example.com/subb/activitypub/actor.jsa",
    "publicKeyPem": "foo",
    "signatureAlgorithm": "https://www.w3.org/2001/04/xmldsig-more#rsa-sha256"
  },
  "manuallyApprovesFollowers": false,
  "discoverable": true,
  "generator": {
    "type": "Link",
    "href": "https://seppo.social",
    "name": "Seppo - Personal Social Web"
  },
  "attachment": [],
  "icon": {
    "type": "Image",
    "url": "https://example.com/subb/me-avatar.jpg"
  },
  "image": {
    "type": "Image",
    "url": "https://example.com/subb/me-banner.jpg"
  }
}|};
  let _tos0 = Ezxmlm.to_string in
  let tos ?(decl = false) ?(indent = None) doc =
    let buf = Buffer.create 512 in
    let o = Xmlm.make_output ~decl (`Buffer buf) ~nl:true ~indent in
    let id x = x in
    Xmlm.output_doc_tree id o (None, doc);
    Buffer.contents buf
  in
  p
  |> Ap.Person.Rdf.encode
    ~token:(Some "foo")
    ~notify:(Some As2.No_p_yes.No)
    ~subscribed:(Some As2.No_p_yes.Pending)
    ~blocked:(Some As2.No_p_yes.Yes)
    ~context ~base
  |> tos
  |> Assrt.equals_string __LOC__ {|<rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" xml:base="https://example.com/subb/">
  <rdf:Description xmlns:seppo="http://seppo.social/2023/ns#" rdf:about="">
    <seppo:token>foo</seppo:token>
    <seppo:notify>no</seppo:notify>
    <seppo:subscribed>pending</seppo:subscribed>
    <seppo:blocked>yes</seppo:blocked>
    </rdf:Description>
  <as:Person xmlns:as="https://www.w3.org/ns/activitystreams#" xmlns:ldp="http://www.w3.org/ns/ldp#" xmlns:schema="http://schema.org#" xmlns:toot="http://joinmastodon.org/ns#" rdf:about="" xml:lang="de">
    <as:id rdf:resource="https://example.com/subb/activitypub/actor.jsa"/>
    <as:preferredUsername>sepp</as:preferredUsername>
    <as:manuallyApprovesFollowers rdf:datatype="http://www.w3.org/2001/XMLSchema#boolean">false</as:manuallyApprovesFollowers>
    <toot:discoverable rdf:datatype="http://www.w3.org/2001/XMLSchema#boolean">true</toot:discoverable>
    <as:generator/>
    <as:name>Sepp</as:name>
    <as:url rdf:resource="https://example.com/subb/"/>
    <as:summary xml:lang="de">sum</as:summary>
      <as:summary>sum</as:summary>
    <as:icon>
      <as:Image>
        <as:url rdf:resource="https://example.com/subb/me-avatar.jpg"/></as:Image></as:icon>
    <as:image>
      <as:Image>
        <as:url rdf:resource="https://example.com/subb/me-banner.jpg"/></as:Image></as:image>
    <as:following rdf:resource="https://example.com/subb/activitypub/subscribed/index.jsa"/>
    <as:followers rdf:resource="https://example.com/subb/activitypub/notify/index.jsa"/>
    <ldp:inbox rdf:resource="https://example.com/subb/seppo.cgi/activitypub/inbox.jsa"/>
    <as:outbox rdf:resource="https://example.com/subb/activitypub/outbox/index.jsa"/>
    </as:Person></rdf:RDF>
|};
  ()

let test_actor () =
  Logr.debug (fun m -> m "as2_test.test_actor");
  Logr.info (fun m -> m "test_actor");
  ("data/ap/actor/friendica.0.json"
   |> Ap.Person.from_file |> Result.get_ok).inbox
  |> Uri.to_string
  |> Assrt.equals_string __LOC__ "https://pirati.ca/inbox/heluecht";
  ("data/ap/actor/mastodon.2.json"
   |> Ap.Person.from_file |> Result.get_ok).inbox
  |> Uri.to_string
  |> Assrt.equals_string __LOC__ "https://digitalcourage.social/users/mro/inbox";
  ("data/ap/actor/gnusocial.2.json"
   |> Ap.Person.from_file |> Result.get_ok).inbox
  |> Uri.to_string
  |> Assrt.equals_string __LOC__ "https://social.hackersatporto.com/user/1/inbox.json";
  ("data/ap/actor/pleroma.0.json"
   |> Ap.Person.from_file |> Result.get_ok).inbox
  |> Uri.to_string
  |> Assrt.equals_string __LOC__ "https://pleroma.tilde.zone/users/mro/inbox";
  assert true

let test_examine_response () =
  {|{"error":"Unable to fetch key JSON at https://example.com/activitypub/#main-key"}|}
  |> As2.examine_response
  |> Result.get_error
  |> Assrt.equals_string __LOC__ "Unable to fetch key JSON at https://example.com/activitypub/#main-key";
  assert true

module Note = struct
  let test_decode () =
    Logr.info (fun m -> m "%s.%s" "As2_test.Note" "decode");
    let j = File.in_channel "data/ap/note/mastodon.json" Ezjsonm.from_channel in
    let n = j |> As2_vocab.Decode.note |> Result.get_ok in
    n.id |> Uri.to_string |> Assrt.equals_string __LOC__ "https://digitalcourage.social/users/mro/statuses/111403080326863922";
    match n.in_reply_to with
    | [u] -> u |> Uri.to_string |> Assrt.equals_string __LOC__ "https://chaos.social/users/qyliss/statuses/111403054651938519"
    | _ -> failwith "ouch"

  let test_of_rfc4287 () =
    let open Rfc4287 in
    let e : Entry.t = {
      id         = "" |> Uri.of_string;
      in_reply_to = [];
      lang       = Rfc4646 "nl";
      author     = Uri.empty;
      title      = "Title";
      published  = Rfc3339.T "2023-10-24T11:12:13+02:00";
      updated    = Rfc3339.T "2023-10-24T11:12:13+02:00";
      links      = [Link.make ("https://Seppo.Social/demo" |> Uri.of_string) ];
      categories = [];
      content    = "string";
    } in
    e.title |> Assrt.equals_string __LOC__ "Title";
    let n = e |> Ap.Note.of_rfc4287 in
    n.summary |> Option.value ~default:"-" |> Assrt.equals_string __LOC__ "Title";
    n.url |> List.hd |> Uri.to_string |> Assrt.equals_string __LOC__ "https://seppo.social/demo"

  let test_diluviate () =
    let n : As2_vocab.Types.note = {
      id         = Uri.empty;
      actor      = Uri.empty;
      attachment = [];
      cc         = [];
      in_reply_to= [];
      media_type = None; (* https://www.w3.org/TR/activitystreams-vocabulary/#dfn-mediatype *)
      content    = "Content";
      content_map= ["de","Inhalt"];
      published  = None;
      sensitive  = false;
      source     = None;
      summary    = Some "Summary";
      summary_map= [];
      tags       = [];
      to_        = [];
      url        = ["https://Seppo.Social/demo" |> Uri.of_string];
      (*raw: jsonm;*)
    } in
    let base = Uri.empty in
    let minify = false in
    n
    |> Ap.Note.diluviate
    |> As2_vocab.Encode.note ~base |> Ezjsonm.value_to_string ~minify |> Assrt.equals_string __LOC__ {|{
  "type": "Note",
  "id": "",
  "actor": "",
  "to": [],
  "cc": [],
  "content": "Summary<br/>\n<a href='https://seppo.social/demo'>https://seppo.social/demo</a><br/>\n<br/>\nContent",
  "contentMap": {
    "de": "Inhalt"
  },
  "sensitive": false,
  "tags": [],
  "url": [
    ""
  ]
}|};
    assert true
end

let () =
  Unix.chdir "../../../test/";
  test_digest_sha256 ();
  test_digst ();
  test_person ();
  test_actor ();
  test_examine_response ();
  Note.test_decode ();
  Note.test_of_rfc4287 ();
  Note.test_diluviate ();
  assert true