test/t_storage.ml

   1 (*
   2  *    _  _   ____                         _
   3  *  _| || |_/ ___|  ___ _ __  _ __   ___ | |
   4  * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| |
   5  * |_      _|___) |  __/ |_) | |_) | (_) |_|
   6  *   |_||_| |____/ \___| .__/| .__/ \___/(_)
   7  *                     |_|   |_|
   8  *
   9  * Personal Social Web.
  10  *
  11  * Copyright (C) The #Seppo contributors. All rights reserved.
  12  *
  13  * This program is free software: you can redistribute it and/or modify
  14  * it under the terms of the GNU General Public License as published by
  15  * the Free Software Foundation, either version 3 of the License, or
  16  * (at your option) any later version.
  17  *
  18  * This program is distributed in the hope that it will be useful,
  19  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  20  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21  * GNU General Public License for more details.
  22  *
  23  * You should have received a copy of the GNU General Public License
  24  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  25  *)
  26
  27 open Seppo_lib
  28 open Storage
  29 open Alcotest
  30
  31 let equals_string = Assrt.equals_string
  32 let equals_int = Assrt.equals_int
  33
  34 module Fifo = struct
  35   type t        = string * int
  36
  37   let make size fn : t =
  38     (fn,size)
  39
  40   let push (fn,size) byt =
  41     let sep = '\n' in
  42     let len = byt |> Bytes.length in
  43     let keep = size - len |> pred in
  44     if keep < try (Unix.stat fn).st_size with _ -> 0
  45     then (* make space and add *)
  46       let ret = len |> Bytes.create in
  47       let buf = keep |> Bytes.create in
  48       fn |> File.in_channel (fun ic ->
  49           really_input ic ret 0 len;
  50           let _ = input_char ic in
  51           really_input ic buf 0 keep );
  52       let mode = [ Open_creat; Open_binary; Open_excl; Open_trunc; Open_wronly ] in
  53       fn |> File.out_channel_replace ~mode (fun oc ->
  54           output_bytes oc buf;
  55           output_bytes oc byt;
  56           output_char oc sep
  57         );
  58       Some ret
  59     else (* just add *)
  60       let mode = [ Open_append; Open_binary; Open_excl; Open_wronly ] in
  61       (fn |> File.out_channel_append ~mode (fun oc ->
  62            output_bytes oc byt;
  63            output_char oc sep
  64          );
  65        None)
  66 end
  67
  68 let set_up () =
  69   Mirage_crypto_rng_lwt.initialize (module Mirage_crypto_rng.Fortuna);
  70   Unix.chdir "../../../test/"
  71
  72 let _tc_fifo () =
  73   let bu = Fifo.make 12 "buffer.fifo" in
  74   let by = Bytes.make 2 '_' in
  75   let _ = Fifo.push bu by in
  76   ()
  77
  78 let tc_dir_of_ix () =
  79   let a,b = "app/var/db/o/p/23.s" |> Page.of_fn |> Option.get in
  80   a |> equals_string __LOC__ "o/p";
  81   b |> equals_int __LOC__ 23;
  82   let a,_ = "app/var/db/o/t/foo/23.s" |> Page.of_fn |> Option.get in
  83   a |> equals_string __LOC__ "o/t/foo";
  84   ()
  85
  86 let tc_tuple () =
  87   (23,42) |> TwoPad10.to_string |> equals_string __LOC__ "(10:0x0000001710:0x0000002a)";
  88   (0x3fff_ffff,42) |> TwoPad10.to_string |> equals_string __LOC__ "(10:0x3fffffff10:0x0000002a)";
  89   let (a,b) = "(10:000000002310:0000000042)"
  90               |> Csexp.parse_string_many
  91               |> Result.value ~default:[]
  92               |> TwoPad10.decode_many
  93               |> List.hd in
  94   a |> equals_int __LOC__ 23;
  95   b |> equals_int __LOC__ 42;
  96   assert true
  97
  98 (*
  99 let tc_json () =
 100   let minify = false in
 101   let base = Uri.of_string "https://example.com/su/" in
 102   let item = Rfc4287_test.mk_sample () in
 103   item |> As2.Note.mk_note_json ~base
 104   |> As2.Note.mk_create_json ~base item
 105   |> Ezjsonm.to_string ~minify
 106   |> eq_s __LOC__ {|{
 107   "type": "Create",
 108   "id": "https://example.com/su/o/p-12/#23/Create",
 109   "actor": "https://example.com/su/activitypub/",
 110   "published": "2023-02-11T11:07:23+01:00",
 111   "to": [
 112     "https://www.w3.org/ns/activitystreams#Public"
 113   ],
 114   "cc": [
 115     "https://example.com/su/activitypub/followers/"
 116   ],
 117   "object": {
 118     "type": "Note",
 119     "id": "o/p-12/#23",
 120     "actor": "activitypub/",
 121     "to": [
 122       "https://www.w3.org/ns/activitystreams#Public"
 123     ],
 124     "cc": [
 125       "activitypub/followers/"
 126     ],
 127     "mediaType": "text/plain; charset=utf8",
 128     "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.",
 129     "sensitive": false,
 130     "summary": "#Announce Seppo.Social v0.1 and Request for Comments.",
 131     "published": "2023-02-11T10:07:23Z",
 132     "tags": [
 133       {
 134         "type": "Hashtag",
 135         "href": "o/t/webfinger/",
 136         "name": "#webfinger"
 137       },
 138       {
 139         "type": "Hashtag",
 140         "href": "o/t/Social/",
 141         "name": "#Social"
 142       },
 143       {
 144         "type": "Hashtag",
 145         "href": "o/t/Seppo/",
 146         "name": "#Seppo"
 147       },
 148       {
 149         "type": "Hashtag",
 150         "href": "o/t/permacomputing/",
 151         "name": "#permacomputing"
 152       },
 153       {
 154         "type": "Hashtag",
 155         "href": "o/t/Media/",
 156         "name": "#Media"
 157       },
 158       {
 159         "type": "Hashtag",
 160         "href": "o/t/Fediverse/",
 161         "name": "#Fediverse"
 162       },
 163       {
 164         "type": "Hashtag",
 165         "href": "o/t/Announce/",
 166         "name": "#Announce"
 167       },
 168       {
 169         "type": "Hashtag",
 170         "href": "o/t/ActivityPub/",
 171         "name": "#ActivityPub"
 172       }
 173     ]
 174   }
 175 }|}
 176 *)
 177
 178 let tc_strut () =
 179   let strut' (p0,p1 as s) =
 180     let r = s |> TwoPad10.strut |> Csexp.to_string in
 181     Logr.info (fun m -> m "%s.%s %d %s" "" "" (p1-p0) r);
 182     r
 183   in
 184   (0,6)    |> strut' |> equals_string __LOC__  "(0:0:)";
 185
 186   (0,7)    |> strut' |> equals_string __LOC__  "(0:1:x)";
 187   (0,8)    |> strut' |> equals_string __LOC__  "(0:2:xx)";
 188   (0,9)    |> strut' |> equals_string __LOC__  "(0:3:xxx)";
 189
 190   (0,14)   |> strut' |> equals_string __LOC__  "(0:8:xxxxxxxx)";
 191   (0,15)   |> strut' |> equals_string __LOC__  "(0:9:xxxxxxxxx)";
 192   (0,16)   |> strut' |> equals_string __LOC__  "(1:x9:xxxxxxxxx)";
 193   (0,17)   |> strut' |> equals_string __LOC__  "(0:10:xxxxxxxxxx)";
 194   (0,18)   |> strut' |> equals_string __LOC__  "(0:11:xxxxxxxxxxx)";
 195
 196   (0,106)  |> strut' |> equals_string __LOC__  "(0:99:xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx)";
 197   (0,107)  |> strut' |> equals_string __LOC__  "(1:x99:xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx)";
 198   (0,108)  |> strut' |> equals_string __LOC__ "(0:100:xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx)";
 199
 200   (0,1007) |> strut' |> equals_string __LOC__ "(0:999:xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx)";
 201   (0,1008) |> strut' |> equals_string __LOC__ "(1:x999:xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx)";
 202   (0,1009) |> strut' |> equals_string __LOC__ "(0:1000:xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx)";
 203   assert true
 204
 205 module Page = struct
 206   let tc_jig () =
 207     let j = "%-%/index.xml" |> Make.Jig.make in
 208     let v = "o/p-42/index.xml" |> Make.Jig.cut j |> Option.value ~default:[] in
 209     (match v with
 210      | [dir;idx] ->
 211        dir |> equals_string __LOC__ "o/p";
 212        idx |> equals_string __LOC__ "42"
 213      | _ -> failwith __LOC__);
 214     let dir,idx = "app/var/db/o/p/42.s" |> Storage.Page.of_fn |> Option.get in
 215     dir |> equals_string __LOC__ "o/p";
 216     idx |> equals_int __LOC__ 42
 217
 218   let tc_pred_succ () =
 219     let v = "app/var/db/o/p/42.s" |> Storage.Page.of_fn |> Option.get in
 220     let dir,idx = v |> Storage.Page.pred in
 221     dir |> equals_string __LOC__ "o/p";
 222     idx |> equals_int __LOC__ 41;
 223     let dir,idx = v |> Storage.Page.succ in
 224     dir |> equals_string __LOC__ "o/p";
 225     idx |> equals_int __LOC__ 43
 226
 227   let tc_other_feeds () =
 228     let _e = match
 229         Rfc4287.Entry.from_text_plain
 230           ~published:(Rfc3339.T "1970-01-01T00:00:00Z")
 231           ~author:Rfc4287.Person.empty
 232           ~lang:(Rfc4287.Rfc4646 "nl")
 233           ~uri:Uri.empty
 234           "title" "content" with
 235     | Ok o -> o
 236     | Error e -> failwith e
 237     in
 238     let s,i = match _e |> Storage.Page.other_feeds with
 239       | [x] -> x
 240       | _ -> failwith "ouch" in
 241     s |> Assrt.equals_string __LOC__ "o/d/1970-01-01";
 242     i |> Assrt.equals_int __LOC__ (-3)
 243 end
 244
 245 module TwoPad10 = struct
 246   let tc_id_to_page_i () =
 247     (match "o/p-12/#35" |> Uri.of_string |> Storage.Id.to_page_i with
 248      | Ok ((f,j),i) ->
 249        f |> Assrt.equals_string __LOC__ "o/p";
 250        j |> Assrt.equals_int __LOC__ 12;
 251        i |> Assrt.equals_int __LOC__ 35;
 252      | _ -> failwith __LOC__);
 253     (* match "https://example.com/sub/o/p-12/#35" |> Uri.of_string |> Storage.TwoPad10.id_to_page_i with
 254        | Ok ((f,j),i) ->
 255        f |> Assrt.equals_string __LOC__ "o/p";
 256        j |> Assrt.equals_int __LOC__ 12;
 257        i |> Assrt.equals_int __LOC__ 35;
 258        | _ -> failwith __LOC__ *)
 259     ()
 260
 261   let _tc_from_id' () =
 262     let _a,_b = "o/p-12/#35"
 263                 |> Uri.of_string
 264                 |> Storage.TwoPad10.from_id ~prefix:"data/"
 265                 |> Result.get_ok in
 266     ()
 267 end
 268
 269 let () =
 270   run
 271     "seppo_suite" [
 272     __FILE__ , [
 273       "set_up",              `Quick, set_up ;
 274       (* "tc_fifo",          `Quick, tc_fifo ; *)
 275       "tc_dir_of_ix",        `Quick, tc_dir_of_ix ;
 276       "tc_tuple",            `Quick, tc_tuple ;
 277       "tc_strut",            `Quick, tc_strut ;
 278       (* "tc_json ()",       `Quick, tc_json () ; *)
 279       "Page.tc_jig",         `Quick, Page.tc_jig ;
 280       "Page.tc_pred_succ",   `Quick, Page.tc_pred_succ ;
 281       "Page.tc_other_feeds", `Quick, Page.tc_other_feeds ;
 282   (*
 283   TwoPad10.tc_id_to_page_i ();
 284   TwoPad10.tc_from_id' ();
 285 *)
 286       "TwoPad10.tc_id_to_page_i", `Quick, TwoPad10.tc_id_to_page_i ;
 287     ]
 288   ]