test/t_iweb.ml

   1 open Seppo_lib
   2 open Alcotest
   3
   4 let set_up = "setup", `Quick, (fun () ->
   5     Mirage_crypto_rng_lwt.initialize (module Mirage_crypto_rng.Fortuna);
   6     Unix.chdir "../../../test/"
   7   )
   8
   9 let tc_scanf = "tc_scanf", `Quick, (fun () ->
  10     Scanf.sscanf "37s" "%is" (fun i -> i)
  11     |> check int __LOC__ 37
  12   )
  13
  14 let tc_regexp = "tc_regexp", `Quick, (fun () ->
  15     let rx = Str.regexp {|^[^\n\t ]\([^\n\t]+[^\n\t ]\)?$|} in
  16     assert (Str.string_match rx "a" 0);
  17     assert true
  18   )
  19
  20 let tc_markup_xml = "tc_markup_xml", `Quick, (fun () ->
  21     [
  22       `Start_element (("", "foo"), []);
  23       `Start_element (("", "bar"), []);
  24       `Start_element (("", "baz"), []);
  25       `End_element;
  26       `End_element;
  27       `End_element;
  28     ]
  29     |> Markup.of_list |> Markup.pretty_print |> Markup.write_xml
  30     |> Markup.to_string
  31     |> check string __LOC__ "<foo>\n <bar>\n  <baz/>\n </bar>\n</foo>\n"
  32   )
  33
  34 let tc_redir_if_cgi_bin = "tc_redir_if_cgi_bin", `Quick, (fun () ->
  35     let r : Cgi.Request.t = {
  36       content_type   = "text/plain";
  37       content_length = None;
  38       host           = "example.com";
  39       http_cookie    = "";
  40       path_info      = "/shaarli";
  41       query_string   = "post=uhu";
  42       request_method = "GET";
  43       remote_addr    = "127.0.0.1";
  44       scheme         = "https";
  45       script_name    = "seppo.cgi";
  46       server_port    = "443";
  47       raw_string     = Sys.getenv_opt
  48     } in
  49     let assrt_redir request_uri exp =
  50       match exp , r |> Iweb.redir_if_cgi_bin ~request_uri with
  51       | Some exp, Error (`Found, h,_) -> h |> List.assoc "Location" |> check string __LOC__ exp
  52       | None, Ok _ -> ()
  53       | _ -> failwith __LOC__
  54     in
  55     assrt_redir "/cgi-bin/seppo.cgi"     (Some "/seppo.cgi");
  56     assrt_redir "/cgi-bin/sub/seppo.cgi" (Some "/sub/seppo.cgi");
  57     assrt_redir "/seppo.cgi"             None;
  58     assrt_redir "/sub/seppo.cgi"         None;
  59     ()
  60   )
  61
  62 let tc_login = "tc_login", `Quick, (fun () ->
  63     Iweb.ClientCookie.name |> check string __LOC__ "#session";
  64     let tit = {|> U " h & ' u <|}
  65     and tok = "ff13e7eaf9541ca2ba30fd44e864c3ff014d2bc9"
  66     and ret = "retu"
  67     and att n v = (("", n), v)
  68     and elm name atts = `Start_element (("", name), atts) in
  69     [
  70       `Xml
  71         {
  72           Markup.version = "1.0";
  73           encoding = Some "utf-8";
  74           standalone = Some false;
  75         };
  76       `PI
  77         ("xml-stylesheet", "type='text/xsl' href='./themes/current/do=login.xsl'");
  78       `Comment
  79         "\n\
  80         \  must be compatible with \
  81          https://code.mro.name/mro/Shaarli-API-test/src/master/tests/test-post.sh\n\
  82         \  \
  83          https://code.mro.name/mro/ShaarliOS/src/1d124e012933d1209d64071a90237dc5ec6372fc/ios/ShaarliOS/API/ShaarliCmd.m#L386\n";
  84       elm "html" [ att "xmlns" "http://www.w3.org/1999/xhtml" ];
  85       elm "head" [];
  86       elm "title" [];
  87       `Text [ tit ];
  88       `End_element;
  89       `End_element;
  90       elm "body" [];
  91       elm "form" [ att "method" "post" ];
  92       elm "input" [ att "name" "login"; att "type" "text" ];
  93       `End_element;
  94       elm "input" [ att "name" "password"; att "type" "password" ];
  95       `End_element;
  96       elm "input" [ att "name" "longlastingsession"; att "type" "checkbox" ];
  97       `End_element;
  98       elm "input" [ att "name" "token"; att "type" "hidden"; att "value" tok ];
  99       `End_element;
 100       elm "input" [ att "name" "returnurl"; att "type" "hidden"; att "value" ret ];
 101       `End_element;
 102       elm "input" [ att "value" "Login"; att "type" "submit" ];
 103       `End_element;
 104       `End_element;
 105       `End_element;
 106     ]
 107     |> Markup.of_list |> Markup.pretty_print |> Markup.write_xml
 108     |> Markup.to_string |> String.length
 109     |> check int __LOC__ 841
 110   )
 111
 112 module ClientCookie = struct
 113   let tc_cookie = "tc_cookie", `Quick, (fun () ->
 114       Iweb.ClientCookie.name |> check string __LOC__ "#session";
 115       (match "5:seppi"
 116              |> Iweb.ClientCookie.decode with
 117       | Ok (Auth.Uid uid) ->
 118         uid |> check string __LOC__ "seppi"
 119       | Error e -> e |> check string __LOC__ "");
 120       Auth.Uid "seppa"
 121       |> Iweb.ClientCookie.encode
 122       |> check string __LOC__ "5:seppa";
 123       (match Auth.Uid "seppu"
 124              |> Iweb.ClientCookie.encode
 125              |> Iweb.ClientCookie.decode with
 126       | Ok Auth.Uid uid ->
 127         uid |> check string __LOC__ "seppu"
 128       | Error e -> e |> check string __LOC__ "");
 129       assert true
 130     )
 131 end
 132
 133 module Form = struct
 134   let tc_of_string = "tc_frm", `Quick, (fun () ->
 135       let frm = {|token=237054ce-4c9c-4155-8c6b-7b79bdb1d139&id=https%3A%2F%2Fsocial.nlnet.nl%2Fusers%2Fgerben&inbox=https%3A%2F%2Fsocial.nlnet.nl%2Fusers%2Fgerben%2Finbox&%7Eis_subscriber=no&%7Eam_subscribed_to=pending&%7Eis_blocked=no|}
 136                 |> Html.Form.of_string in
 137       frm |> List.length |> check int __LOC__ 6;
 138       frm |> List.assoc "token"       |> List.hd |> check string __LOC__ "237054ce-4c9c-4155-8c6b-7b79bdb1d139";
 139       frm |> List.assoc "id"          |> List.hd |> check string __LOC__ {|https://social.nlnet.nl/users/gerben|};
 140       frm |> List.assoc "inbox"       |> List.hd |> check string __LOC__ {|https://social.nlnet.nl/users/gerben/inbox|};
 141       frm |> List.assoc "~is_subscriber"     |> List.hd |> check string __LOC__ {|no|};
 142       frm |> List.assoc "~am_subscribed_to" |> List.hd |> check string __LOC__ {|pending|};
 143       frm |> List.assoc "~is_blocked"    |> List.hd |> check string __LOC__ {|no|};
 144       ();
 145       let frm = {|token=65fed285-a489-4e3f-9f2a-4a896e4f14ce&id=https%3A%2F%2Fbewegung.social%2Fusers%2Fmro&inbox=https%3A%2F%2Fbewegung.social%2Fusers%2Fmro%2Finbox&%7Eis_subscriber=yes&%7Eam_subscribed_to=no&%7Eis_blocked=no&am_subscribed_to=on&is_subscriber=on|}
 146                 |> Html.Form.of_string in
 147       frm |> List.length |> check int __LOC__ 8;
 148       frm |> List.assoc "token"       |> List.hd |> check string __LOC__ "65fed285-a489-4e3f-9f2a-4a896e4f14ce";
 149       frm |> List.assoc "id"          |> List.hd |> check string __LOC__ {|https://bewegung.social/users/mro|};
 150       frm |> List.assoc "inbox"       |> List.hd |> check string __LOC__ {|https://bewegung.social/users/mro/inbox|};
 151       frm |> List.assoc "~is_subscriber"     |> List.hd |> check string __LOC__ {|yes|};
 152       frm |> List.assoc "~am_subscribed_to" |> List.hd |> check string __LOC__ {|no|};
 153       frm |> List.assoc "~is_blocked"    |> List.hd |> check string __LOC__ {|no|};
 154       frm |> List.assoc "is_subscriber"     |> List.hd |> check string __LOC__ {|on|};
 155       frm |> List.assoc "am_subscribed_to" |> List.hd |> check string __LOC__ {|on|};
 156       ()
 157     )
 158 end
 159
 160 let tc_date = "tc_date", `Quick, (fun () ->
 161     let d x = x
 162               |> Option.value ~default:Iweb.Post.epoch_shaarli
 163               |> Ptime.to_rfc3339
 164     in
 165     "20230927_125036" |> Iweb.Post.s2d |> d |> check string __LOC__ "2023-09-27T12:50:36-00:00"
 166   )
 167
 168 let tc_bookmarklet = "tc_bookmarklet", `Quick, (fun () ->
 169     let s = Option.value ~default:"" in
 170     let b s = if s then "yes" else "no" in
 171     let d s = s |> Option.value ~default:Ptime.min |> Ptime.to_rfc3339 in
 172     let u x = x |> Option.value ~default:Uri.empty |> Uri.to_string in
 173     let s' x= x in
 174     let l = String.concat " " in
 175     let now = ((2023,9,27),((14,45,42),2*60*60))
 176               |> Ptime.of_date_time in
 177     let emp = Iweb.Post.empty in
 178     let emp = {emp with dat = now} in
 179     let x = {|post=https%3A%2F%2Fwww.heise.de%2F&source=bookmarklet&scrape=no&title=heise+online+-+IT-News%2C+Nachrichten+und+Hintergr%C3%BCnde&tags=heise+online%2C+c%27t%2C+iX%2C+MIT+Technology+Review%2C+Newsticker%2C+Telepolis%2C+Security%2C+Netze&image=https%3A%2F%2Fheise.cloudimg.io%2Fbound%2F1200x1200%2Fq85.png-lossy-85.webp-lossy-85.foil1%2F_www-heise-de_%2Ficons%2Fho%2Fopengraph%2Fopengraph.png&description=News+und+Foren+zu+Computer%2C+IT%2C+Wissenschaft%2C+Medien+und+Politik.+Preisvergleich+von+Hardware+und+Software+sowie+Downloads+bei+Heise+Medien.|} in
 180     let r : Iweb.Post.t = x
 181                           |> Uri.query_of_encoded
 182                           |> List.fold_left Iweb.Post.sift_bookmarklet_get emp in
 183     r.scrape |> b |> check string __LOC__ "yes";
 184     r.source |> s |> check string __LOC__ "bookmarklet";
 185     r.dat    |> d |> check string __LOC__ "2023-09-27T12:45:42-00:00";
 186     r.url    |> u |> check string __LOC__ "https://www.heise.de/";
 187     r.tit    |> s |> check string __LOC__ "heise online - IT-News, Nachrichten und Hintergründe";
 188     r.dsc    |> s |> check string __LOC__ "News und Foren zu Computer, IT, Wissenschaft, Medien und Politik. Preisvergleich von Hardware und Software sowie Downloads bei Heise Medien.";
 189     r.tag    |> l |> check string __LOC__ "heise online, c't, iX, MIT Technology Review, Newsticker, Telepolis, Security, Netze";
 190     r.pri    |> b |> check string __LOC__ "no";
 191     assert (r.sav    |> Option.is_none);
 192     r.can    |> s |> check string __LOC__ "";
 193     r.tok    |> s'|> check string __LOC__ "";
 194     r.ret    |> u |> check string __LOC__ "";
 195     r.img    |> u |> check string __LOC__ "https://heise.cloudimg.io/bound/1200x1200/q85.png-lossy-85.webp-lossy-85.foil1/_www-heise-de_/icons/ho/opengraph/opengraph.png";
 196     let x = {|post=Some #text 🐫|} in
 197     let r : Iweb.Post.t = x
 198                           |> Uri.query_of_encoded
 199                           |> List.fold_left Iweb.Post.sift_bookmarklet_get emp in
 200     r.scrape |> b |> check string __LOC__ "no";
 201     r.source |> s |> check string __LOC__ "";
 202     r.dat    |> d |> check string __LOC__ "2023-09-27T12:45:42-00:00";
 203     r.url    |> u |> check string __LOC__ "";
 204     r.tit    |> s |> check string __LOC__ "Some #text 🐫";
 205     r.dsc    |> s |> check string __LOC__ "";
 206     r.tag    |> l |> check string __LOC__ "";
 207     r.pri    |> b |> check string __LOC__ "no";
 208     assert (r.sav    |> Option.is_none);
 209     r.can    |> s |> check string __LOC__ "";
 210     r.tok    |> s'|> check string __LOC__ "";
 211     r.ret    |> u |> check string __LOC__ "";
 212     r.img    |> u |> check string __LOC__ ""
 213   )
 214
 215 let tc_post = "tc_post", `Quick, (fun () ->
 216     let x = "?lf_linkdate=20210913_134542&token=f19a65cecdfa2971afb827bc9413eb7244e469a8&returnurl=&lf_image=&lf_url=http://example.com&lf_title=title&lf_description=body%20%23tags&save_edit=Save" in
 217     let s = Option.value ~default:"" in
 218     let b s = if s then "yes" else "no" in
 219     let d s = s |> Option.value ~default:Iweb.Post.epoch_shaarli |> Ptime.to_rfc3339 in
 220     let u x = x |> Option.value ~default:Uri.empty |> Uri.to_string in
 221     let l = String.concat " " in
 222     let s' x = x in
 223
 224     let r : Iweb.Post.t = x
 225                           |> Uri.of_string
 226                           |> Uri.query
 227                           |> List.fold_left Iweb.Post.sift_post Iweb.Post.empty in
 228     r.scrape |> b |> check string __LOC__ "no";
 229     r.source |> s |> check string __LOC__ "";
 230     r.dat    |> d |> check string __LOC__ "2021-09-13T13:45:42-00:00";
 231     r.url    |> u |> check string __LOC__ "http://example.com";
 232     r.tit    |> s |> check string __LOC__ "title";
 233     r.dsc    |> s |> check string __LOC__ "body #tags";
 234     r.tag    |> l |> check string __LOC__ "";
 235     r.pri    |> b |> check string __LOC__ "no";
 236     (match r.sav with | Some Save -> "Save"| _ -> "Fail") |> check string __LOC__ "Save";
 237     r.can    |> s |> check string __LOC__ "";
 238     r.tok    |> s'|> check string __LOC__ "f19a65cecdfa2971afb827bc9413eb7244e469a8";
 239     r.ret    |> u |> check string __LOC__ "";
 240     r.img    |> u |> check string __LOC__ ""
 241   )
 242
 243 module Actor = struct
 244   let tc_basic = "tc_basic", `Quick, (fun () ->
 245       Logr.info (fun m -> m "%s.%s" "Iweb.Actor" "basic");
 246       let s = {|token=68f4cf03-8f2d-491c-a954-bd8118f93c01&id=https%3A%2F%2Falpaka.social%2Fusers%2Ftraunstein&inbox=https%3A%2F%2Falpaka.social%2Fusers%2Ftraunstein%2Finbox&~notify=no&~subscribe=yes&~block=no&notify=on|} in
 247       let f = s |> Html.Form.of_string in
 248       f |> List.length |> check int __LOC__ 7;
 249       f |> List.assoc "token"      |> String.concat "|" |> check string __LOC__ "68f4cf03-8f2d-491c-a954-bd8118f93c01";
 250       f |> List.assoc "id"         |> String.concat "|" |> check string __LOC__ "https://alpaka.social/users/traunstein";
 251       f |> List.assoc "inbox"      |> String.concat "|" |> check string __LOC__ "https://alpaka.social/users/traunstein/inbox";
 252       f |> List.assoc "~notify"    |> String.concat "|" |> check string __LOC__ "no";
 253       f |> List.assoc "~subscribe" |> String.concat "|" |> check string __LOC__ "yes";
 254       f |> List.assoc "~block"     |> String.concat "|" |> check string __LOC__ "no";
 255       f |> List.assoc "notify"     |> String.concat "|" |> check string __LOC__ "on";
 256       let switch k v' v =
 257         if v' = v
 258         then None
 259         else (
 260           Logr.debug (fun m -> m "field %s: %s" k (v |> As2.No_p_yes.to_string));
 261           Some k) in
 262       let form_switch_folder k_of_old f_switch form init (k_old,v_old) =
 263         match k_old |> k_of_old with
 264         | None   -> init
 265         | Some k ->
 266           let v = match form |> List.assoc_opt k with
 267             | None
 268             | Some ["no"] -> As2.No_p_yes.No
 269             | _           -> As2.No_p_yes.Yes in
 270           let v_old = match v_old with
 271             | ["no"] -> As2.No_p_yes.No
 272             | _      -> As2.No_p_yes.Yes in
 273           match f_switch k v_old v with
 274           | None -> init
 275           | Some x -> x :: init in
 276       f
 277       |> List.fold_left (form_switch_folder (St.after ~prefix:"~") switch f) []
 278       |> String.concat "|"
 279       |> check string __LOC__ "subscribe|notify"
 280     )
 281
 282   let tc_command = "tc_command", `Quick, (fun () ->
 283       let uuid = Uuidm.v4_gen (Random.State.make_self_init ()) () in
 284       (match
 285          {|token=b346c8f4-c734-4504-922c-4a597cf3e7d3&id=https%3A%2F%2Fsocial.nlnet.nl%2Fusers%2Fgerben&inbox=https%3A%2F%2Fsocial.nlnet.nl%2Fusers%2Fgerben%2Finbox&%7Enotify=no&%7Esubscribed=pending&%7Eblocked=no|}
 286          |> Html.Form.of_string |> Iweb.Actor.command uuid with
 287       | `Unsubscribe -> ()
 288       | _ -> failwith __LOC__);
 289       (match
 290          {|token=65fed285-a489-4e3f-9f2a-4a896e4f14ce&id=https%3A%2F%2Fbewegung.social%2Fusers%2Fmro&inbox=https%3A%2F%2Fbewegung.social%2Fusers%2Fmro%2Finbox&%7Eis_subscriber=yes&%7Eam_subscribed_to=no&%7Eis_blocked=no&am_subscribed_to=on&is_subscriber=on|}
 291          |> Html.Form.of_string |> Iweb.Actor.command uuid with
 292       | `Subscribe -> ()
 293       | _ -> failwith __LOC__)
 294     )
 295 end
 296
 297 let tc_xhtml = "tc_xhtml", `Quick, (fun () ->
 298     let i_uid : Html.Form.input = ("setlogin", "text", [
 299         ("required","required");
 300         ("autofocus","autofocus");
 301         ("maxlength","50");
 302         ("minlength","1");
 303         ("pattern", {|^[a-zA-Z0-9_.\-]+$|});
 304         ("placeholder","Your local name as 'alice' in @alice@example.com");
 305       ]) in
 306     let x = Iweb.(xhtmlform ~clz:"clz" "a" "b" [i_uid] ["setlogin","strange"] [ n i_uid "uid" ]) in
 307     let b = Buffer.create 1024 in
 308     Xml.to_buf x b;
 309     b
 310     |> Buffer.contents
 311     |> check string __LOC__ {|<?xml version="1.0"?>
 312 <html xml:base="../" xmlns="http://www.w3.org/1999/xhtml">
 313 <head>
 314   <link rel="icon" type="image/jpg" href="../me-avatar.jpg"/>
 315   <meta name="generator" content="Seppo.mro.name"/>
 316   <title>a</title></head>
 317 <body>
 318   <form method="post" name="b" id="b" class="clz">
 319     <input name="setlogin" type="text" value="uid" placeholder="Your local name as 'alice' in @alice@example.com" pattern="^[a-zA-Z0-9_.\-]+$" minlength="1" maxlength="50" autofocus="autofocus" required="required" class="is-invalid"/>
 320     <div role="alert" data-for="setlogin">strange</div></form>
 321 </body>
 322 </html>|};
 323     ();
 324     match Html.Form.string_opt i_uid [ Iweb.n i_uid "u d" ] with
 325     | Error (f,v) ->
 326       f |> check string __LOC__ "setlogin";
 327       v |> check string __LOC__ "pattern mismatch"
 328     | Ok _ -> failwith __LOC__
 329   )
 330
 331 let () =
 332   run
 333     "seppo_suite" [
 334     __FILE__ , [
 335       set_up;
 336       tc_scanf;
 337       tc_regexp;
 338       tc_markup_xml;
 339       tc_redir_if_cgi_bin;
 340       tc_login;
 341       ClientCookie.tc_cookie;
 342       Form.tc_of_string;
 343       tc_date;
 344       tc_bookmarklet;
 345       tc_post;
 346       Actor.tc_basic;
 347       Actor.tc_command;
 348       tc_xhtml;
 349     ]
 350   ]