seppo/test/t_as2.ml

(*
 *    _  _   ____                         _  
 *  _| || |_/ ___|  ___ _ __  _ __   ___ | | 
 * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| | 
 * |_      _|___) |  __/ |_) | |_) | (_) |_| 
 *   |_||_| |____/ \___| .__/| .__/ \___/(_) 
 *                     |_|   |_|             
 *
 * Personal Social Web.
 *
 * t_as2.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
open Alcotest

let set_up = "setup", `Quick, (fun () ->
    Mirage_crypto_rng_lwt.initialize (module Mirage_crypto_rng.Fortuna);
    Unix.chdir "../../../test/"
  )

let tc_digest_sha256 = "tc_digest_sha256", `Quick, (fun () ->
    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
    |> check string __LOC__
      "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855";
    "" |> Cstruct.of_string |> Mirage_crypto.Hash.SHA256.digest
    |> Cstruct.to_string |> Base64.encode_exn
    (* printf "%s" "" | openssl dgst -sha256 -binary | base64 *)
    |> check string __LOC__
      "47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU="
  )

let tc_digst = "tc_digst", `Quick, (fun () ->
    Logr.debug (fun m -> m "as2_test.test_digst");
    "" |> Ap.PubKeyPem.digest_base64
    |> check string __LOC__
      "SHA-256=47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU=";
    assert true
  )

let tc_person = "tc_person", `Quick, (fun () ->
    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 lang = pro.language in
    let lang : string option = Some lang in
    let p = Ap.Person.prsn pubdate (pem, (pro, (Auth.Uid uid, base))) in
    p |> As2_vocab.Encode.person ~lang ~base
    |> Ezjsonm.value_to_string ~minify:false |>
    check 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/subscribers/index.jsa",
  "following": "https://example.com/subb/activitypub/subscribed_to/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"
  },
  "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")
      ~is_in_subscribers:(Some As2.No_p_yes.No)
      ~am_subscribed_to:(Some As2.No_p_yes.Pending)
      ~blocked:(Some As2.No_p_yes.Yes)
      ~lang ~base
    |> tos
    |> check string __LOC__ {|<rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" xmlns:seppo="http://seppo.social/2023/ns#" xml:base="https://example.com/subb/">
  <rdf:Description rdf:about="">
    <seppo:token>foo</seppo:token>
    <seppo:is_subscriber>no</seppo:is_subscriber>
    <seppo:am_subscribed_to>pending</seppo:am_subscribed_to>
    <seppo:is_blocked>yes</seppo:is_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_to/index.jsa"/>
    <as:followers rdf:resource="https://example.com/subb/activitypub/subscribers/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 tc_actor = "tc_actor", `Quick, (fun () ->
    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
    |> check string __LOC__ "https://pirati.ca/inbox/heluecht";
    ("data/ap/actor/mastodon.2.json"
     |> Ap.Person.from_file |> Result.get_ok).inbox
    |> Uri.to_string
    |> check 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
    |> check 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
    |> check string __LOC__ "https://pleroma.tilde.zone/users/mro/inbox";
    assert true
  )

let tc_examine_response = "tc_examine_response", `Quick, (fun () ->
    {|{"error":"Unable to fetch key JSON at https://example.com/activitypub/#main-key"}|}
    |> As2.examine_response
    |> Result.get_error
    |> check string __LOC__ "Unable to fetch key JSON at https://example.com/activitypub/#main-key";
    assert true
  )

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

let () =
  run
    "seppo_suite" [
    __FILE__ , [
      set_up;
      tc_digest_sha256;
      tc_digst;
      tc_person;
      tc_actor;
      tc_examine_response;
      Note.tc_decode;
    ]
  ];
  assert true