seppo/test/t_rfc4287.ml

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

let set_up () =
  Mirage_crypto_rng_lwt.initialize (module Mirage_crypto_rng.Fortuna);
  Unix.chdir "../../../test/"


let mk_sample () =
  let tag path = Category.((Label (Single path)), (Term (Single path)), tagu) in
  let e = {Rfc4287.Entry.empty with
           id         = "o/p-12/#23" |> Uri.of_string;
           in_reply_to= [Uri.empty |> Inreplyto.make];
           lang       = Rfc4646 "en";
           author     = {Rfc4287.Person.empty with
                         name = "fediverse";
                         uri = Some (Uri.of_string "https://fediverse@mro.name");
                         (* Uri.make ~userinfo:"fediverse" ~host:"mro.name" () *)};
           title      = "#Announce Seppo.Social v0.1 and Request for Comments.";
           published  = Rfc3339.T "2023-02-11T11:07:23+01:00";
           updated    = Rfc3339.T "2023-02-11T11:07:23+01:00";
           links      = [ "https://seppo.social/en/downloads/seppo-Linux-x86_64-0.1/" |> Uri.of_string  |> Link.make ];
           categories = [
             tag "ActivityPub";
             tag "Announce";
             tag "Fediverse";
             tag "Media";
             tag "permacomputing";
             tag "Seppo";
             tag "Social";
             tag "webfinger";
           ];
           content    = {|I am happy to announce the premiere release of #Seppo!, Personal #Social #Media under funding of NLnet.nl.

Find it at https://Seppo.Social/downloads/

It has no notable user facing #ActivityPub features so far, but

- easy setup of instance & account,
- #webfinger discoverability (from e.g. mastodon search),
- a welcoming, long-term reliable website.

I made this embarrassingly limited release to build awareness for low-barrier-entry internet services in general and especially in the field of personal communication as well as letting the #fediverse and #permacomputing communities know.

Your comments are very much appreciated.|};
          } in
  e

let tail x =
  Assrt.equals_string __LOC__ "ok" (if x |> Result.is_ok then "ok" else "no")

let tc_compute_links () =
  let base = "https://example.com/sub/" |> Uri.of_string in
  let self,first,last,prev,next = ("o/p",2) |> Rfc4287.Feed.compute_links ~max:7 ~base in
  self  |> Uri.to_string |> Assrt.equals_string __LOC__ "https://example.com/sub/o/p-2/";
  first |> Uri.to_string |> Assrt.equals_string __LOC__ "https://example.com/sub/o/p/";
  last  |> Uri.to_string |> Assrt.equals_string __LOC__ "https://example.com/sub/o/p-0/";
  prev  |> Option.get |> Uri.to_string |> Assrt.equals_string __LOC__ "https://example.com/sub/o/p-3/";
  next  |> Option.get |> Uri.to_string |> Assrt.equals_string __LOC__ "https://example.com/sub/o/p-1/";
  assert true

let tc_encode () =
  Logr.info (fun m -> m "rfc4287_test.test_encode");
  let _ = match {|(6:author(4:name9:fediverse3:uri26:https://fediverse@mro.name))|} |> Csexp.parse_string with
    | Ok (List [ Atom "author"; List [
        Atom "name"; Atom "fediverse";
        Atom "uri"; Atom _uri;
      ] ]) -> ()
    | _ -> failwith __LOC__
  in
  let e = mk_sample () in
  e
  |> Entry.encode
  |> Csexp.to_string
  |> Assrt.equals_string __LOC__ {|(2:id10:o/p-12/#2311:in-reply-to((3:ref0:))4:lang2:en5:title53:#Announce Seppo.Social v0.1 and Request for Comments.6:author(4:name9:fediverse3:uri26:https://fediverse@mro.name)9:published25:2023-02-11T11:07:23+01:007:updated25:2023-02-11T11:07:23+01:005:links((4:href57:https://seppo.social/en/downloads/seppo-Linux-x86_64-0.1/))10:categories((5:label11:ActivityPub4:term11:ActivityPub6:scheme4:o/t/)(5:label8:Announce4:term8:Announce6:scheme4:o/t/)(5:label9:Fediverse4:term9:Fediverse6:scheme4:o/t/)(5:label5:Media4:term5:Media6:scheme4:o/t/)(5:label14:permacomputing4:term14:permacomputing6:scheme4:o/t/)(5:label5:Seppo4:term5:Seppo6:scheme4:o/t/)(5:label6:Social4:term6:Social6:scheme4:o/t/)(5:label9:webfinger4:term9:webfinger6:scheme4:o/t/))7:content635:I am happy to announce the premiere release of #Seppo!, Personal #Social #Media under funding of NLnet.nl.

Find it at https://Seppo.Social/downloads/

It has no notable user facing #ActivityPub features so far, but

- easy setup of instance & account,
- #webfinger discoverability (from e.g. mastodon search),
- a welcoming, long-term reliable website.

I made this embarrassingly limited release to build awareness for low-barrier-entry internet services in general and especially in the field of personal communication as well as letting the #fediverse and #permacomputing communities know.

Your comments are very much appreciated.)|};
  e |> Entry.encode |> Csexp.to_string |> String.length |> Assrt.equals_int __LOC__ 1396;
  match e
        |> Entry.encode
        |> Entry.decode with
  | Error e -> e |> Assrt.equals_string __LOC__ {||}
  | Ok e ->
    let Rfc4646 lang = e.lang
    and titl = e.title
    and Rfc3339.T publ = e.published
    and Rfc3339.T upda = e.updated
    and cont = e.content
    and li_a, li_b = match e.links with
      | [ {href; rel=None; title=None; rfc7565=None} ] -> (href,"")
      | _ -> (Uri.make (), "ouch 301")
    and ca_a, ca_b, ca_c = match e.categories  with
      | (Label (Single a), Term (Single b), c) :: _ -> (a,b,c)
      | _ -> ("ouch 302", "", Uri.make ())
    in
    lang |> Assrt.equals_string __LOC__ "en";
    titl |> Assrt.equals_string __LOC__ "#Announce Seppo.Social v0.1 and Request for Comments.";
    publ |> Assrt.equals_string __LOC__ "2023-02-11T11:07:23+01:00";
    upda |> Assrt.equals_string __LOC__ "2023-02-11T11:07:23+01:00";
    e.links |> List.length |> Assrt.equals_int __LOC__ 1;
    li_a |> Uri.to_string |> Assrt.equals_string __LOC__ "https://seppo.social/en/downloads/seppo-Linux-x86_64-0.1/";
    li_b |> Assrt.equals_string __LOC__ "";
    e.categories |> List.length |> Assrt.equals_int __LOC__ 8;
    ca_a |> Assrt.equals_string __LOC__ "webfinger";
    ca_b |> Assrt.equals_string __LOC__ "webfinger";
    ca_c |> Uri.to_string |> Assrt.equals_string __LOC__ "o/t/";
    cont |> Assrt.equals_string __LOC__ {|I am happy to announce the premiere release of #Seppo!, Personal #Social #Media under funding of NLnet.nl.

Find it at https://Seppo.Social/downloads/

It has no notable user facing #ActivityPub features so far, but

- easy setup of instance & account,
- #webfinger discoverability (from e.g. mastodon search),
- a welcoming, long-term reliable website.

I made this embarrassingly limited release to build awareness for low-barrier-entry internet services in general and especially in the field of personal communication as well as letting the #fediverse and #permacomputing communities know.

Your comments are very much appreciated.|};
    e |> Storage.feed_urls
    |> List.map Uri.to_string |> String.concat " ; "
    |> Assrt.equals_string __LOC__ "o/p/ ; activitypub/outbox/ ; o/d/2023-02-11/ ; o/t/webfinger/ ; o/t/Social/ ; o/t/Seppo/ ; o/t/permacomputing/ ; o/t/Media/ ; o/t/Fediverse/ ; o/t/Announce/ ; o/t/ActivityPub/";
    assert true

let tc_decode_2023 () =
  let e : Rfc4287.Entry.t =
    {|(2:id10:o/p-12/#2311:in-reply-to((3:ref0:))4:lang2:en5:title53:#Announce Seppo.Social v0.1 and Request for Comments.6:author20://fediverse@mro.name9:published25:2023-02-11T11:07:23+01:007:updated25:2023-02-11T11:07:23+01:005:links((4:href57:https://seppo.social/en/downloads/seppo-Linux-x86_64-0.1/))10:categories((5:label11:ActivityPub4:term11:ActivityPub6:scheme4:o/t/)(5:label8:Announce4:term8:Announce6:scheme4:o/t/)(5:label9:Fediverse4:term9:Fediverse6:scheme4:o/t/)(5:label5:Media4:term5:Media6:scheme4:o/t/)(5:label14:permacomputing4:term14:permacomputing6:scheme4:o/t/)(5:label5:Seppo4:term5:Seppo6:scheme4:o/t/)(5:label6:Social4:term6:Social6:scheme4:o/t/)(5:label9:webfinger4:term9:webfinger6:scheme4:o/t/))7:content635:I am happy to announce the premiere release of #Seppo!, Personal #Social #Media under funding of NLnet.nl.

Find it at https://Seppo.Social/downloads/

It has no notable user facing #ActivityPub features so far, but

- easy setup of instance & account,
- #webfinger discoverability (from e.g. mastodon search),
- a welcoming, long-term reliable website.

I made this embarrassingly limited release to build awareness for low-barrier-entry internet services in general and especially in the field of personal communication as well as letting the #fediverse and #permacomputing communities know.

Your comments are very much appreciated.)|}
    |> Csexp.parse_string
    |> Result.get_ok
    |> Rfc4287.Entry.decode
    |> Result.get_ok in
  e.title |> Assrt.equals_string __LOC__ {|#Announce Seppo.Social v0.1 and Request for Comments.|};
  e.author.name  |> Assrt.equals_string __LOC__ {|fediverse|};
  e.author.uri |> Option.get |> Uri.to_string |> Assrt.equals_string __LOC__ {|//fediverse@mro.name|};
  ()

let tc_decode_2024 () =
  let e : Rfc4287.Entry.t =
    {|(2:id10:o/p-12/#2311:in-reply-to((3:ref0:))4:lang2:en5:title53:#Announce Seppo.Social v0.1 and Request for Comments.6:author(4:name9:fediverse3:uri26:https://fediverse@mro.name)9:published25:2023-02-11T11:07:23+01:007:updated25:2023-02-11T11:07:23+01:005:links((4:href57:https://seppo.social/en/downloads/seppo-Linux-x86_64-0.1/))10:categories((5:label11:ActivityPub4:term11:ActivityPub6:scheme4:o/t/)(5:label8:Announce4:term8:Announce6:scheme4:o/t/)(5:label9:Fediverse4:term9:Fediverse6:scheme4:o/t/)(5:label5:Media4:term5:Media6:scheme4:o/t/)(5:label14:permacomputing4:term14:permacomputing6:scheme4:o/t/)(5:label5:Seppo4:term5:Seppo6:scheme4:o/t/)(5:label6:Social4:term6:Social6:scheme4:o/t/)(5:label9:webfinger4:term9:webfinger6:scheme4:o/t/))7:content635:I am happy to announce the premiere release of #Seppo!, Personal #Social #Media under funding of NLnet.nl.

Find it at https://Seppo.Social/downloads/

It has no notable user facing #ActivityPub features so far, but

- easy setup of instance & account,
- #webfinger discoverability (from e.g. mastodon search),
- a welcoming, long-term reliable website.

I made this embarrassingly limited release to build awareness for low-barrier-entry internet services in general and especially in the field of personal communication as well as letting the #fediverse and #permacomputing communities know.

Your comments are very much appreciated.)|}
    |> Csexp.parse_string
    |> Result.get_ok
    |> Rfc4287.Entry.decode
    |> Result.get_ok in
  e.title |> Assrt.equals_string __LOC__ {|#Announce Seppo.Social v0.1 and Request for Comments.|};
  e.author.name  |> Assrt.equals_string __LOC__ {|fediverse|};
  e.author.uri |> Option.get |> Uri.to_string |> Assrt.equals_string __LOC__ {|https://fediverse@mro.name|};
  ()

let tc_from_plain_text () =
  Logr.info (fun m -> m "rfc4287_test.test_from_plain_text");
  let published = Rfc3339.T "2023-02-14T01:23:45+01:00" in
  let author     = {Rfc4287.Person.empty with
                    name = "fediverse";
                    uri = Some (Uri.of_string "https://fediverse@mro.name");
                    (* Uri.make ~userinfo:"fediverse" ~host:"mro.name" () *)} in
  let lang = Rfc4646 "nl" in
  let uri = Uri.of_string "https://nlnet.nl/projects/Seppo/" in
  (let* n = Entry.from_text_plain ~published ~author ~lang ~uri "Hello, world!" "a new Note." in
   let ti = n.title in
   let co = n.content in
   ti |> Assrt.equals_string __LOC__ "Hello, world!";
   n.links |> List.length |> Assrt.equals_int __LOC__ 1;
   n.categories |> List.length |> Assrt.equals_int __LOC__ 0;
   co |> Assrt.equals_string __LOC__ "a new Note.";
   n |> Entry.encode
   |> Csexp.to_string
   |> Assrt.equals_string __LOC__ {|(2:id7:aseggdb11:in-reply-to()4:lang2:nl5:title13:Hello, world!6:author(4:name9:fediverse3:uri26:https://fediverse@mro.name)9:published25:2023-02-14T01:23:45+01:007:updated25:2023-02-14T01:23:45+01:005:links((4:href32:https://nlnet.nl/projects/Seppo/))10:categories()7:content11:a new Note.)|};
   Ok n)
  |> tail

(**
 * inspired by https://code.mro.name/mro/ShaarliGo/src/cb798ebfae17431732e37a94ee80b29bd3b78911/atom.go#L302
 * https://opam.ocaml.org/packages/base32/
 * https://opam.ocaml.org/packages/base64/
*)
let tc_id_make () =
  Logr.info (fun m -> m "rfc4287_test.test_id_make");
  let assrt l id iso =
    match iso |> Ptime.of_rfc3339 with
    | Ok (t,_,_) ->
      let f = Entry.id_make t |> Uri.to_string in
      Assrt.equals_string l id f
    | _ -> "" |> Assrt.equals_string "" "-"
  in
  "1970-01-01T00:00:00+00:00" |> assrt "rfc4287_test.test_id_make 0" "2222222";
  "2023-01-01T00:00:00+00:00" |> assrt "rfc4287_test.test_id_make 1" "as35e22";
  "2081-01-01T00:00:00+00:00" |> assrt "rfc4287_test.test_id_make 2" "s9y3s22";
  "2120-01-01T00:00:00+00:00" |> assrt "rfc4287_test.test_id_make 4" "2sd6e22";
  assert true

let tc_entry_atom () =
  Logr.info (fun m -> m "rfc4287_test.test_entry_atom");
  let base = Uri.of_string "https://example.com/sub/" in
  let published = Rfc3339.T "2023-02-14T01:23:45+01:00" in
  let author     = {Rfc4287.Person.empty with
                    name = "fediverse";
                    uri = Some (Uri.of_string "https://fediverse@mro.name");
                    (* Uri.make ~userinfo:"fediverse" ~host:"mro.name" () *)} in
  let lang = Rfc4646 "nl" in
  let uri = Uri.of_string "https://nlnet.nl/projects/Seppo/" in
  let e0 = Entry.from_text_plain ~published ~author ~lang ~uri "Hello, world!" "a new Note."
           |> Result.get_ok  in
  let buf = Buffer.create 1024 in
  let attr = [
    ((Xmlm.ns_xmlns,"xmlns"), Xml.ns_a);
    ((Xmlm.ns_xmlns,"wf"), Xml.ns_rfc7033);
    ((Xmlm.ns_xmlns,"as"), Xml.ns_as);
  ] in
  let e = Entry.to_atom ~attr ~base e0 in
  Xml.to_buf e buf;
  buf |> Buffer.to_bytes |> Bytes.to_string
  |> Assrt.equals_string __LOC__ {|<?xml version="1.0"?>
<entry xml:lang="nl" xmlns="http://www.w3.org/2005/Atom" xmlns:wf="urn:ietf:rfc:7033" xmlns:as="https://www.w3.org/ns/activitystreams">
    <id>https://example.com/sub/aseggdb</id>
    <title type="text">Hello, world!</title>
    <updated>2023-02-14T01:23:45+01:00</updated>
    <published>2023-02-14T01:23:45+01:00</published>
    <as:sensitive>false</as:sensitive>
    <author>
      <name>fediverse</name>
      <wf:uri>acct:fediverse@mro.name</wf:uri>
      <uri>https://fediverse@mro.name</uri></author>
    <link rel="self" href="https://example.com/sub/aseggdb"/>
    <link href="https://nlnet.nl/projects/Seppo/"/>
    <content type="text">a new Note.</content>
  </entry>|}

let tc_feed_atom () =
  Logr.info (fun m -> m "rfc4287_test.test_feed_atom");

  let published = Rfc3339.T "2023-02-14T01:23:45+01:00" in
  let author     = {Rfc4287.Person.empty with
                    name = "fediverse";
                    uri = Some (Uri.of_string "https://fediverse@mro.name");
                    (* Uri.make ~userinfo:"fediverse" ~host:"mro.name" () *)} in
  let lang = Rfc4646 "nl" in
  let uri = Uri.of_string "https://nlnet.nl/projects/Seppo/" in
  let e0 = Entry.from_text_plain ~published ~author ~lang ~uri "Hello, world!" "a new Note."
           |> Result.get_ok  in
  let fe = Feed.to_atom
      ~author:{author with name = "sepp"}
      ~base:(Uri.make ~scheme:"https" ~host:"example.com" ~path:"/sub/" ())
      ~lang:(Rfc4646 "nl")
      ~self:(Uri.make ~path:"o/p-11/" ())
      ~prev:(Some (Uri.make ~path:"o/p-10/" ()))
      ~next:None
      ~first:(Uri.make ~path:"o/p/" ())
      ~last:(Uri.make ~path:"o/p-0/" ())
      ~title:"My fancy #Seppo!"
      ~updated:(Rfc3339.T "2023-02-27T12:34:56+01:00")
      [e0] in
  let buf = Buffer.create 1024 in
  Xml.to_buf fe buf;
  buf |> Buffer.to_bytes |> Bytes.to_string
  |> Assrt.equals_string __LOC__ {|<?xml version="1.0"?>
<feed xmlns="http://www.w3.org/2005/Atom" xmlns:thr="http://purl.org/syndication/thread/1.0" xmlns:wf="urn:ietf:rfc:7033" xmlns:as="https://www.w3.org/ns/activitystreams" xml:lang="nl" xml:base="https://example.com/sub/">
  <id>https://example.com/sub/o/p-11/</id>
  <title type="text">My fancy #Seppo!</title>
  <updated>2023-02-27T12:34:56+01:00</updated>
  <generator uri="Seppo.Social">Seppo - Personal Social Web</generator>
  <link rel="self" href="o/p-11/" title="12"/>
  <link rel="first" href="o/p/" title="last"/>
  <link rel="last" href="o/p-0/" title="1"/>
  <link rel="previous" href="o/p-10/" title="11"/>
  <entry xml:lang="nl">
    <id>https://example.com/sub/aseggdb</id>
    <title type="text">Hello, world!</title>
    <updated>2023-02-14T01:23:45+01:00</updated>
    <published>2023-02-14T01:23:45+01:00</published>
    <as:sensitive>false</as:sensitive>
    <author>
      <name>fediverse</name>
      <wf:uri>acct:fediverse@mro.name</wf:uri>
      <uri>https://fediverse@mro.name</uri></author>
    <link rel="self" href="https://example.com/sub/aseggdb"/>
    <link href="https://nlnet.nl/projects/Seppo/"/>
    <content type="text">a new Note.</content>
  </entry>
  </feed>|}

let tc_xsl () =
  "o/p-1/index.xml"
  |> Rfc4287.xsl "posts.xsl"
  |> Option.value ~default:"?"
  |> Assrt.equals_string __LOC__ "../../themes/current/posts.xsl"

let () =
  run
    "seppo_suite" [
    __FILE__ , [
      "set_up",              `Quick, set_up;
      "tc_compute_links ",   `Quick, tc_compute_links ;
      "tc_encode ",          `Quick, tc_encode ;
      "tc_decode_2023 ",     `Quick, tc_decode_2023 ;
      "tc_decode_2024 ",     `Quick, tc_decode_2024 ;
      "tc_from_plain_text ", `Quick, tc_from_plain_text ;
      "tc_id_make ",         `Quick, tc_id_make ;
      "tc_entry_atom ",      `Quick, tc_entry_atom ;
      "tc_feed_atom ",       `Quick, tc_feed_atom ;
      "tc_xsl ",             `Quick, tc_xsl ;
    ]
  ]