test/t_as2.ml

   1 (*
   2  *    _  _   ____                         _
   3  *  _| || |_/ ___|  ___ _ __  _ __   ___ | |
   4  * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| |
   5  * |_      _|___) |  __/ |_) | |_) | (_) |_|
   6  *   |_||_| |____/ \___| .__/| .__/ \___/(_)
   7  *                     |_|   |_|
   8  *
   9  * Personal Social Web.
  10  *
  11  * t_as2.ml
  12  *
  13  * Copyright (C) The #Seppo contributors. All rights reserved.
  14  *
  15  * This program is free software: you can redistribute it and/or modify
  16  * it under the terms of the GNU General Public License as published by
  17  * the Free Software Foundation, either version 3 of the License, or
  18  * (at your option) any later version.
  19  *
  20  * This program is distributed in the hope that it will be useful,
  21  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  22  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23  * GNU General Public License for more details.
  24  *
  25  * You should have received a copy of the GNU General Public License
  26  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  27  *)
  28
  29 open Seppo_lib
  30 open Alcotest
  31
  32 let set_up = "setup", `Quick, (fun () ->
  33     Mirage_crypto_rng_lwt.initialize (module Mirage_crypto_rng.Fortuna);
  34     Unix.chdir "../../../test/"
  35   )
  36
  37 let tc_digest_sha256 = "tc_digest_sha256", `Quick, (fun () ->
  38     Logr.debug (fun m -> m "as2_test.test_digest_sha256");
  39     let (`Hex h) =
  40       "" |> Cstruct.of_string |> Mirage_crypto.Hash.SHA256.digest
  41       |> Hex.of_cstruct
  42     in
  43     (* https://de.wikipedia.org/wiki/SHA-2 *)
  44     h
  45     |> check string __LOC__
  46       "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855";
  47     "" |> Cstruct.of_string |> Mirage_crypto.Hash.SHA256.digest
  48     |> Cstruct.to_string |> Base64.encode_exn
  49     (* printf "%s" "" | openssl dgst -sha256 -binary | base64 *)
  50     |> check string __LOC__
  51       "47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU="
  52   )
  53
  54 let tc_digst = "tc_digst", `Quick, (fun () ->
  55     Logr.debug (fun m -> m "as2_test.test_digst");
  56     "" |> Ap.PubKeyPem.digest_base64
  57     |> check string __LOC__
  58       "SHA-256=47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU=";
  59     assert true
  60   )
  61
  62 let tc_person = "tc_person", `Quick, (fun () ->
  63     Logr.debug (fun m -> m "as2_test.test_person");
  64     let pubdate = Ptime_clock.now ()
  65     and pem = "foo"
  66     and pro = ({
  67         title    = "Sepp"; (* similar atom:subtitle *)
  68         bio      = "sum"; (* similar atom:description *)
  69         language = Rfc4287.Rfc4646 "de";
  70         timezone = Timedesc.Time_zone.utc;
  71         posts_per_page = 50;
  72       } : Cfg.Profile.t)
  73     and uid = "sepp"
  74     and base = Uri.of_string "https://example.com/subb/" in
  75     let Rfc4287.Rfc4646 lang = pro.language in
  76     let lang : string option = Some lang in
  77     let p = Ap.Person.prsn pubdate (pem, (pro, (Auth.Uid uid, base))) in
  78     p |> As2_vocab.Encode.person ~lang ~base
  79     |> Ezjsonm.value_to_string ~minify:false |>
  80     check string
  81       __LOC__ {|{
  82   "@context": [
  83     "https://www.w3.org/ns/activitystreams",
  84     "https://w3id.org/security/v1",
  85     {
  86       "schema": "http://schema.org#",
  87       "PropertyValue": "schema:PropertyValue",
  88       "value": "schema:value",
  89       "@language": "de"
  90     }
  91   ],
  92   "type": "Person",
  93   "id": "https://example.com/subb/activitypub/actor.jsa",
  94   "inbox": "https://example.com/subb/seppo.cgi/activitypub/inbox.jsa",
  95   "outbox": "https://example.com/subb/activitypub/outbox/index.jsa",
  96   "followers": "https://example.com/subb/activitypub/subscribers/index.jsa",
  97   "following": "https://example.com/subb/activitypub/subscribed_to/index.jsa",
  98   "name": "Sepp",
  99   "url": "https://example.com/subb/",
 100   "preferredUsername": "sepp",
 101   "summary": "sum",
 102   "summaryMap": {
 103     "de": "sum"
 104   },
 105   "publicKey": {
 106     "@context": [
 107       {
 108         "@language": null
 109       }
 110     ],
 111     "id": "https://example.com/subb/activitypub/actor.jsa#main-key",
 112     "owner": "https://example.com/subb/activitypub/actor.jsa",
 113     "publicKeyPem": "foo",
 114     "signatureAlgorithm": "https://www.w3.org/2001/04/xmldsig-more#rsa-sha256"
 115   },
 116   "manuallyApprovesFollowers": false,
 117   "discoverable": true,
 118   "generator": {
 119     "type": "Link",
 120     "href": "https://seppo.mro.name",
 121     "name": "Seppo - Personal Social Web"
 122   },
 123   "icon": {
 124     "type": "Image",
 125     "url": "https://example.com/subb/me-avatar.jpg"
 126   },
 127   "image": {
 128     "type": "Image",
 129     "url": "https://example.com/subb/me-banner.jpg"
 130   }
 131 }|};
 132     let _tos0 = Ezxmlm.to_string in
 133     let tos ?(decl = false) ?(indent = None) doc =
 134       let buf = Buffer.create 512 in
 135       let o = Xmlm.make_output ~decl (`Buffer buf) ~nl:true ~indent in
 136       let id x = x in
 137       Xmlm.output_doc_tree id o (None, doc);
 138       Buffer.contents buf
 139     in
 140     p
 141     |> Ap.Person.Rdf.encode
 142       ~token:(Some "foo")
 143       ~is_in_subscribers:(Some As2.No_p_yes.No)
 144       ~am_subscribed_to:(Some As2.No_p_yes.Pending)
 145       ~blocked:(Some As2.No_p_yes.Yes)
 146       ~lang ~base
 147     |> tos
 148     |> check string __LOC__ {|<rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" xmlns:seppo="http://seppo.mro.name/2023/ns#" xml:base="https://example.com/subb/">
 149   <rdf:Description rdf:about="">
 150     <seppo:token>foo</seppo:token>
 151     <seppo:is_subscriber>no</seppo:is_subscriber>
 152     <seppo:am_subscribed_to>pending</seppo:am_subscribed_to>
 153     <seppo:is_blocked>yes</seppo:is_blocked>
 154     </rdf:Description>
 155   <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">
 156     <as:id rdf:resource="https://example.com/subb/activitypub/actor.jsa"/>
 157     <as:preferredUsername>sepp</as:preferredUsername>
 158     <as:manuallyApprovesFollowers rdf:datatype="http://www.w3.org/2001/XMLSchema#boolean">false</as:manuallyApprovesFollowers>
 159     <toot:discoverable rdf:datatype="http://www.w3.org/2001/XMLSchema#boolean">true</toot:discoverable>
 160     <as:generator/>
 161     <as:name>Sepp</as:name>
 162     <as:url rdf:resource="https://example.com/subb/"/>
 163     <as:summary xml:lang="de">sum</as:summary>
 164       <as:summary>sum</as:summary>
 165     <as:icon>
 166       <as:Image>
 167         <as:url rdf:resource="https://example.com/subb/me-avatar.jpg"/></as:Image></as:icon>
 168     <as:image>
 169       <as:Image>
 170         <as:url rdf:resource="https://example.com/subb/me-banner.jpg"/></as:Image></as:image>
 171     <as:following rdf:resource="https://example.com/subb/activitypub/subscribed_to/index.jsa"/>
 172     <as:followers rdf:resource="https://example.com/subb/activitypub/subscribers/index.jsa"/>
 173     <ldp:inbox rdf:resource="https://example.com/subb/seppo.cgi/activitypub/inbox.jsa"/>
 174     <as:outbox rdf:resource="https://example.com/subb/activitypub/outbox/index.jsa"/>
 175     </as:Person></rdf:RDF>
 176 |};
 177     ()
 178   )
 179
 180 let tc_actor = "tc_actor", `Quick, (fun () ->
 181     Logr.debug (fun m -> m "as2_test.test_actor");
 182     Logr.info (fun m -> m "test_actor");
 183     ("data/ap/actor/friendica.0.json"
 184      |> Ap.Person.from_file |> Result.get_ok).inbox
 185     |> Uri.to_string
 186     |> check string __LOC__ "https://pirati.ca/inbox/heluecht";
 187     ("data/ap/actor/mastodon.2.json"
 188      |> Ap.Person.from_file |> Result.get_ok).inbox
 189     |> Uri.to_string
 190     |> check string __LOC__ "https://digitalcourage.social/users/mro/inbox";
 191     ("data/ap/actor/gnusocial.2.json"
 192      |> Ap.Person.from_file |> Result.get_ok).inbox
 193     |> Uri.to_string
 194     |> check string __LOC__ "https://social.hackersatporto.com/user/1/inbox.json";
 195     ("data/ap/actor/pleroma.0.json"
 196      |> Ap.Person.from_file |> Result.get_ok).inbox
 197     |> Uri.to_string
 198     |> check string __LOC__ "https://pleroma.tilde.zone/users/mro/inbox";
 199     assert true
 200   )
 201
 202 let tc_examine_response = "tc_examine_response", `Quick, (fun () ->
 203     {|{"error":"Unable to fetch key JSON at https://example.com/activitypub/#main-key"}|}
 204     |> As2.examine_response
 205     |> Result.get_error
 206     |> check string __LOC__ "Unable to fetch key JSON at https://example.com/activitypub/#main-key";
 207     assert true
 208   )
 209
 210 module Note = struct
 211   let tc_decode = "tc_decode", `Quick, (fun () ->
 212       Logr.info (fun m -> m "%s.%s" "As2_test.Note" "decode");
 213       let j = "data/ap/note/mastodon.json" |> File.in_channel Ezjsonm.from_channel in
 214       let n = j |> As2_vocab.Decode.note |> Result.get_ok in
 215       n.id |> Uri.to_string |> check string __LOC__ "https://digitalcourage.social/users/mro/statuses/111403080326863922";
 216       match n.in_reply_to with
 217       | [u] -> u |> Uri.to_string |> check string __LOC__ "https://chaos.social/users/qyliss/statuses/111403054651938519"
 218       | _ -> failwith "ouch"
 219     )
 220 end
 221
 222 let () =
 223   run
 224     "seppo_suite" [
 225     __FILE__ , [
 226       set_up;
 227       tc_digest_sha256;
 228       tc_digst;
 229       tc_person;
 230       tc_actor;
 231       tc_examine_response;
 232       Note.tc_decode;
 233     ]
 234   ];
 235   assert true