seppo/test/t_storage.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 Seppo_lib
open Storage
open Alcotest

let equals_string = Assrt.equals_string
let equals_int = Assrt.equals_int

module Fifo = struct
  type t        = string * int

  let make size fn : t =
    (fn,size)

  let push (fn,size) byt =
    let sep = '\n' in
    let len = byt |> Bytes.length in
    let keep = size - len |> pred in
    if keep < try (Unix.stat fn).st_size with _ -> 0
    then (* make space and add *)
      let ret = len |> Bytes.create in
      let buf = keep |> Bytes.create in
      fn |> File.in_channel (fun ic ->
          really_input ic ret 0 len;
          let _ = input_char ic in
          really_input ic buf 0 keep );
      let mode = [ Open_creat; Open_binary; Open_excl; Open_trunc; Open_wronly ] in
      fn |> File.out_channel_replace ~mode (fun oc ->
          output_bytes oc buf;
          output_bytes oc byt;
          output_char oc sep
        );
      Some ret
    else (* just add *)
      let mode = [ Open_append; Open_binary; Open_excl; Open_wronly ] in
      (fn |> File.out_channel_append ~mode (fun oc ->
           output_bytes oc byt;
           output_char oc sep
         );
       None)
end

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

let _tc_fifo () =
  let bu = Fifo.make 12 "buffer.fifo" in
  let by = Bytes.make 2 '_' in
  let _ = Fifo.push bu by in
  ()

let tc_dir_of_ix () =
  let a,b = "app/var/db/o/p/23.s" |> Page.of_fn |> Option.get in
  a |> equals_string __LOC__ "o/p";
  b |> equals_int __LOC__ 23;
  let a,_ = "app/var/db/o/t/foo/23.s" |> Page.of_fn |> Option.get in
  a |> equals_string __LOC__ "o/t/foo";
  ()

let tc_tuple () =
  (23,42) |> TwoPad10.to_string |> equals_string __LOC__ "(10:0x0000001710:0x0000002a)";
  (0x3fff_ffff,42) |> TwoPad10.to_string |> equals_string __LOC__ "(10:0x3fffffff10:0x0000002a)";
  let (a,b) = "(10:000000002310:0000000042)"
              |> Csexp.parse_string_many
              |> Result.value ~default:[]
              |> TwoPad10.decode_many
              |> List.hd in
  a |> equals_int __LOC__ 23;
  b |> equals_int __LOC__ 42;
  assert true

(*
let tc_json () =
  let minify = false in
  let base = Uri.of_string "https://example.com/su/" in
  let item = Rfc4287_test.mk_sample () in
  item |> As2.Note.mk_note_json ~base
  |> As2.Note.mk_create_json ~base item
  |> Ezjsonm.to_string ~minify
  |> eq_s __LOC__ {|{
  "type": "Create",
  "id": "https://example.com/su/o/p-12/#23/Create",
  "actor": "https://example.com/su/activitypub/",
  "published": "2023-02-11T11:07:23+01:00",
  "to": [
    "https://www.w3.org/ns/activitystreams#Public"
  ],
  "cc": [
    "https://example.com/su/activitypub/followers/"
  ],
  "object": {
    "type": "Note",
    "id": "o/p-12/#23",
    "actor": "activitypub/",
    "to": [
      "https://www.w3.org/ns/activitystreams#Public"
    ],
    "cc": [
      "activitypub/followers/"
    ],
    "mediaType": "text/plain; charset=utf8",
    "content": "I am happy to announce the premiere release of #Seppo!, Personal #Social #Media under funding of NLnet.nl.\n\nFind it at https://Seppo.Social/downloads/\n\nIt has no notable user facing #ActivityPub features so far, but\n\n- easy setup of instance & account,\n- #webfinger discoverability (from e.g. mastodon search),\n- a welcoming, long-term reliable website.\n\nI 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.\n\nYour comments are very much appreciated.",
    "sensitive": false,
    "summary": "#Announce Seppo.Social v0.1 and Request for Comments.",
    "published": "2023-02-11T10:07:23Z",
    "tags": [
      {
        "type": "Hashtag",
        "href": "o/t/webfinger/",
        "name": "#webfinger"
      },
      {
        "type": "Hashtag",
        "href": "o/t/Social/",
        "name": "#Social"
      },
      {
        "type": "Hashtag",
        "href": "o/t/Seppo/",
        "name": "#Seppo"
      },
      {
        "type": "Hashtag",
        "href": "o/t/permacomputing/",
        "name": "#permacomputing"
      },
      {
        "type": "Hashtag",
        "href": "o/t/Media/",
        "name": "#Media"
      },
      {
        "type": "Hashtag",
        "href": "o/t/Fediverse/",
        "name": "#Fediverse"
      },
      {
        "type": "Hashtag",
        "href": "o/t/Announce/",
        "name": "#Announce"
      },
      {
        "type": "Hashtag",
        "href": "o/t/ActivityPub/",
        "name": "#ActivityPub"
      }
    ]
  }
}|}
*)

let tc_strut () =
  let strut' (p0,p1 as s) =
    let r = s |> TwoPad10.strut |> Csexp.to_string in
    Logr.info (fun m -> m "%s.%s %d %s" "" "" (p1-p0) r);
    r
  in
  (0,6)    |> strut' |> equals_string __LOC__  "(0:0:)";

  (0,7)    |> strut' |> equals_string __LOC__  "(0:1:x)";
  (0,8)    |> strut' |> equals_string __LOC__  "(0:2:xx)";
  (0,9)    |> strut' |> equals_string __LOC__  "(0:3:xxx)";

  (0,14)   |> strut' |> equals_string __LOC__  "(0:8:xxxxxxxx)";
  (0,15)   |> strut' |> equals_string __LOC__  "(0:9:xxxxxxxxx)";
  (0,16)   |> strut' |> equals_string __LOC__  "(1:x9:xxxxxxxxx)";
  (0,17)   |> strut' |> equals_string __LOC__  "(0:10:xxxxxxxxxx)";
  (0,18)   |> strut' |> equals_string __LOC__  "(0:11:xxxxxxxxxxx)";

  (0,106)  |> strut' |> equals_string __LOC__  "(0:99:xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx)";
  (0,107)  |> strut' |> equals_string __LOC__  "(1:x99:xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx)";
  (0,108)  |> strut' |> equals_string __LOC__ "(0:100:xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx)";

  (0,1007) |> strut' |> equals_string __LOC__ "(0:999:xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx)";
  (0,1008) |> strut' |> equals_string __LOC__ "(1:x999:xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx)";
  (0,1009) |> strut' |> equals_string __LOC__ "(0:1000:xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx)";
  assert true

module Page = struct
  let tc_jig () =
    let j = "%-%/index.xml" |> Make.Jig.make in
    let v = "o/p-42/index.xml" |> Make.Jig.cut j |> Option.value ~default:[] in
    (match v with
     | [dir;idx] ->
       dir |> equals_string __LOC__ "o/p";
       idx |> equals_string __LOC__ "42"
     | _ -> failwith __LOC__);
    let dir,idx = "app/var/db/o/p/42.s" |> Storage.Page.of_fn |> Option.get in
    dir |> equals_string __LOC__ "o/p";
    idx |> equals_int __LOC__ 42

  let tc_pred_succ () =
    let v = "app/var/db/o/p/42.s" |> Storage.Page.of_fn |> Option.get in
    let dir,idx = v |> Storage.Page.pred in
    dir |> equals_string __LOC__ "o/p";
    idx |> equals_int __LOC__ 41;
    let dir,idx = v |> Storage.Page.succ in
    dir |> equals_string __LOC__ "o/p";
    idx |> equals_int __LOC__ 43

  let tc_other_feeds () =
    let _e = match
        Rfc4287.Entry.from_text_plain
          ~published:(Rfc3339.T "1970-01-01T00:00:00Z")
          ~author:Rfc4287.Person.empty
          ~lang:(Rfc4287.Rfc4646 "nl")
          ~uri:Uri.empty
          "title" "content" with
    | Ok o -> o
    | Error e -> failwith e
    in
    let s,i = match _e |> Storage.Page.other_feeds with
      | [x] -> x
      | _ -> failwith "ouch" in
    s |> Assrt.equals_string __LOC__ "o/d/1970-01-01";
    i |> Assrt.equals_int __LOC__ (-3)
end

module TwoPad10 = struct
  let tc_id_to_page_i () =
    (match "o/p-12/#35" |> Uri.of_string |> Storage.Id.to_page_i with
     | Ok ((f,j),i) ->
       f |> Assrt.equals_string __LOC__ "o/p";
       j |> Assrt.equals_int __LOC__ 12;
       i |> Assrt.equals_int __LOC__ 35;
     | _ -> failwith __LOC__);
    (* match "https://example.com/sub/o/p-12/#35" |> Uri.of_string |> Storage.TwoPad10.id_to_page_i with
       | Ok ((f,j),i) ->
       f |> Assrt.equals_string __LOC__ "o/p";
       j |> Assrt.equals_int __LOC__ 12;
       i |> Assrt.equals_int __LOC__ 35;
       | _ -> failwith __LOC__ *)
    ()

  let _tc_from_id' () =
    let _a,_b = "o/p-12/#35"
                |> Uri.of_string
                |> Storage.TwoPad10.from_id ~prefix:"data/"
                |> Result.get_ok in
    ()
end

let () =
  run
    "seppo_suite" [
    __FILE__ , [ 
      "set_up",              `Quick, set_up ;
      (* "tc_fifo",          `Quick, tc_fifo ; *)
      "tc_dir_of_ix",        `Quick, tc_dir_of_ix ;
      "tc_tuple",            `Quick, tc_tuple ;
      "tc_strut",            `Quick, tc_strut ;
      (* "tc_json ()",       `Quick, tc_json () ; *)
      "Page.tc_jig",         `Quick, Page.tc_jig ;
      "Page.tc_pred_succ",   `Quick, Page.tc_pred_succ ;
      "Page.tc_other_feeds", `Quick, Page.tc_other_feeds ;
  (*
  TwoPad10.tc_id_to_page_i ();
  TwoPad10.tc_from_id' ();
*)
      "TwoPad10.tc_id_to_page_i", `Quick, TwoPad10.tc_id_to_page_i ;
    ]
  ]