seppo/test/t_iweb.ml

open Seppo_lib
open Alcotest

let set_up = "setup", `Quick, (fun () ->
    Mirage_crypto_rng_lwt.initialize (module Mirage_crypto_rng.Fortuna);
    Unix.chdir "../../../test/"
  )

let tc_scanf = "tc_scanf", `Quick, (fun () ->
    Scanf.sscanf "37s" "%is" (fun i -> i)
    |> check int __LOC__ 37
  )

let tc_regexp = "tc_regexp", `Quick, (fun () ->
    let rx = Str.regexp {|^[^\n\t ]\([^\n\t]+[^\n\t ]\)?$|} in
    assert (Str.string_match rx "a" 0);
    assert true
  )

let tc_markup_xml = "tc_markup_xml", `Quick, (fun () ->
    [
      `Start_element (("", "foo"), []);
      `Start_element (("", "bar"), []);
      `Start_element (("", "baz"), []);
      `End_element;
      `End_element;
      `End_element;
    ]
    |> Markup.of_list |> Markup.pretty_print |> Markup.write_xml
    |> Markup.to_string
    |> check string __LOC__ "<foo>\n <bar>\n  <baz/>\n </bar>\n</foo>\n"
  )

let tc_redir_if_cgi_bin = "tc_redir_if_cgi_bin", `Quick, (fun () ->
    let r : Cgi.Request.t = {
      content_type   = "text/plain";
      content_length = None;
      host           = "example.com";
      http_cookie    = "";
      path_info      = "/shaarli";
      query_string   = "post=uhu";
      request_method = "GET";
      remote_addr    = "127.0.0.1";
      scheme         = "https";
      script_name    = "seppo.cgi";
      server_port    = "443";
      raw_string     = Sys.getenv_opt
    } in
    let assrt_redir request_uri exp =
      match exp , r |> Iweb.redir_if_cgi_bin ~request_uri with
      | Some exp, Error (`Found, h,_) -> h |> List.assoc "Location" |> check string __LOC__ exp
      | None, Ok _ -> ()
      | _ -> failwith __LOC__
    in
    assrt_redir "/cgi-bin/seppo.cgi"     (Some "/seppo.cgi");
    assrt_redir "/cgi-bin/sub/seppo.cgi" (Some "/sub/seppo.cgi");
    assrt_redir "/seppo.cgi"             None;
    assrt_redir "/sub/seppo.cgi"         None;
    ()
  )

let tc_login = "tc_login", `Quick, (fun () ->
    Iweb.ClientCookie.name |> check string __LOC__ "#session";
    let tit = {|> U " h & ' u <|}
    and tok = "ff13e7eaf9541ca2ba30fd44e864c3ff014d2bc9"
    and ret = "retu"
    and att n v = (("", n), v)
    and elm name atts = `Start_element (("", name), atts) in
    [
      `Xml
        {
          Markup.version = "1.0";
          encoding = Some "utf-8";
          standalone = Some false;
        };
      `PI
        ("xml-stylesheet", "type='text/xsl' href='./themes/current/do=login.xsl'");
      `Comment
        "\n\
        \  must be compatible with \
         https://code.mro.name/mro/Shaarli-API-test/src/master/tests/test-post.sh\n\
        \  \
         https://code.mro.name/mro/ShaarliOS/src/1d124e012933d1209d64071a90237dc5ec6372fc/ios/ShaarliOS/API/ShaarliCmd.m#L386\n";
      elm "html" [ att "xmlns" "http://www.w3.org/1999/xhtml" ];
      elm "head" [];
      elm "title" [];
      `Text [ tit ];
      `End_element;
      `End_element;
      elm "body" [];
      elm "form" [ att "method" "post" ];
      elm "input" [ att "name" "login"; att "type" "text" ];
      `End_element;
      elm "input" [ att "name" "password"; att "type" "password" ];
      `End_element;
      elm "input" [ att "name" "longlastingsession"; att "type" "checkbox" ];
      `End_element;
      elm "input" [ att "name" "token"; att "type" "hidden"; att "value" tok ];
      `End_element;
      elm "input" [ att "name" "returnurl"; att "type" "hidden"; att "value" ret ];
      `End_element;
      elm "input" [ att "value" "Login"; att "type" "submit" ];
      `End_element;
      `End_element;
      `End_element;
    ]
    |> Markup.of_list |> Markup.pretty_print |> Markup.write_xml
    |> Markup.to_string |> String.length
    |> check int __LOC__ 841
  )

module ClientCookie = struct
  let tc_cookie = "tc_cookie", `Quick, (fun () ->
      Iweb.ClientCookie.name |> check string __LOC__ "#session";
      (match "5:seppi"
             |> Iweb.ClientCookie.decode with
      | Ok (Auth.Uid uid) ->
        uid |> check string __LOC__ "seppi"
      | Error e -> e |> check string __LOC__ "");
      Auth.Uid "seppa"
      |> Iweb.ClientCookie.encode
      |> check string __LOC__ "5:seppa";
      (match Auth.Uid "seppu"
             |> Iweb.ClientCookie.encode
             |> Iweb.ClientCookie.decode with
      | Ok Auth.Uid uid ->
        uid |> check string __LOC__ "seppu"
      | Error e -> e |> check string __LOC__ "");
      assert true
    )
end

module Form = struct
  let tc_of_string = "tc_frm", `Quick, (fun () ->
      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|}
                |> Html.Form.of_string in
      frm |> List.length |> check int __LOC__ 6;
      frm |> List.assoc "token"       |> List.hd |> check string __LOC__ "237054ce-4c9c-4155-8c6b-7b79bdb1d139";
      frm |> List.assoc "id"          |> List.hd |> check string __LOC__ {|https://social.nlnet.nl/users/gerben|};
      frm |> List.assoc "inbox"       |> List.hd |> check string __LOC__ {|https://social.nlnet.nl/users/gerben/inbox|};
      frm |> List.assoc "~is_subscriber"     |> List.hd |> check string __LOC__ {|no|};
      frm |> List.assoc "~am_subscribed_to" |> List.hd |> check string __LOC__ {|pending|};
      frm |> List.assoc "~is_blocked"    |> List.hd |> check string __LOC__ {|no|};
      ();
      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|}
                |> Html.Form.of_string in
      frm |> List.length |> check int __LOC__ 8;
      frm |> List.assoc "token"       |> List.hd |> check string __LOC__ "65fed285-a489-4e3f-9f2a-4a896e4f14ce";
      frm |> List.assoc "id"          |> List.hd |> check string __LOC__ {|https://bewegung.social/users/mro|};
      frm |> List.assoc "inbox"       |> List.hd |> check string __LOC__ {|https://bewegung.social/users/mro/inbox|};
      frm |> List.assoc "~is_subscriber"     |> List.hd |> check string __LOC__ {|yes|};
      frm |> List.assoc "~am_subscribed_to" |> List.hd |> check string __LOC__ {|no|};
      frm |> List.assoc "~is_blocked"    |> List.hd |> check string __LOC__ {|no|};
      frm |> List.assoc "is_subscriber"     |> List.hd |> check string __LOC__ {|on|};
      frm |> List.assoc "am_subscribed_to" |> List.hd |> check string __LOC__ {|on|};
      ()
    )
end

let tc_date = "tc_date", `Quick, (fun () ->
    let d x = x
              |> Option.value ~default:Iweb.Post.epoch_shaarli
              |> Ptime.to_rfc3339
    in
    "20230927_125036" |> Iweb.Post.s2d |> d |> check string __LOC__ "2023-09-27T12:50:36-00:00"
  )

let tc_bookmarklet = "tc_bookmarklet", `Quick, (fun () ->
    let s = Option.value ~default:"" in
    let b s = if s then "yes" else "no" in
    let d s = s |> Option.value ~default:Ptime.min |> Ptime.to_rfc3339 in
    let u x = x |> Option.value ~default:Uri.empty |> Uri.to_string in
    let s' x= x in
    let l = String.concat " " in
    let now = ((2023,9,27),((14,45,42),2*60*60))
              |> Ptime.of_date_time in
    let emp = Iweb.Post.empty in
    let emp = {emp with dat = now} in
    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
    let r : Iweb.Post.t = x
                          |> Uri.query_of_encoded
                          |> List.fold_left Iweb.Post.sift_bookmarklet_get emp in
    r.scrape |> b |> check string __LOC__ "yes";
    r.source |> s |> check string __LOC__ "bookmarklet";
    r.dat    |> d |> check string __LOC__ "2023-09-27T12:45:42-00:00";
    r.url    |> u |> check string __LOC__ "https://www.heise.de/";
    r.tit    |> s |> check string __LOC__ "heise online - IT-News, Nachrichten und Hintergründe";
    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.";
    r.tag    |> l |> check string __LOC__ "heise online, c't, iX, MIT Technology Review, Newsticker, Telepolis, Security, Netze";
    r.pri    |> b |> check string __LOC__ "no";
    assert (r.sav    |> Option.is_none);
    r.can    |> s |> check string __LOC__ "";
    r.tok    |> s'|> check string __LOC__ "";
    r.ret    |> u |> check string __LOC__ "";
    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";
    let x = {|post=Some #text 🐫|} in
    let r : Iweb.Post.t = x
                          |> Uri.query_of_encoded
                          |> List.fold_left Iweb.Post.sift_bookmarklet_get emp in
    r.scrape |> b |> check string __LOC__ "no";
    r.source |> s |> check string __LOC__ "";
    r.dat    |> d |> check string __LOC__ "2023-09-27T12:45:42-00:00";
    r.url    |> u |> check string __LOC__ "";
    r.tit    |> s |> check string __LOC__ "Some #text 🐫";
    r.dsc    |> s |> check string __LOC__ "";
    r.tag    |> l |> check string __LOC__ "";
    r.pri    |> b |> check string __LOC__ "no";
    assert (r.sav    |> Option.is_none);
    r.can    |> s |> check string __LOC__ "";
    r.tok    |> s'|> check string __LOC__ "";
    r.ret    |> u |> check string __LOC__ "";
    r.img    |> u |> check string __LOC__ ""
  )

let tc_post = "tc_post", `Quick, (fun () ->
    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
    let s = Option.value ~default:"" in
    let b s = if s then "yes" else "no" in
    let d s = s |> Option.value ~default:Iweb.Post.epoch_shaarli |> Ptime.to_rfc3339 in
    let u x = x |> Option.value ~default:Uri.empty |> Uri.to_string in
    let l = String.concat " " in
    let s' x = x in

    let r : Iweb.Post.t = x
                          |> Uri.of_string
                          |> Uri.query
                          |> List.fold_left Iweb.Post.sift_post Iweb.Post.empty in
    r.scrape |> b |> check string __LOC__ "no";
    r.source |> s |> check string __LOC__ "";
    r.dat    |> d |> check string __LOC__ "2021-09-13T13:45:42-00:00";
    r.url    |> u |> check string __LOC__ "http://example.com";
    r.tit    |> s |> check string __LOC__ "title";
    r.dsc    |> s |> check string __LOC__ "body #tags";
    r.tag    |> l |> check string __LOC__ "";
    r.pri    |> b |> check string __LOC__ "no";
    (match r.sav with | Some Save -> "Save"| _ -> "Fail") |> check string __LOC__ "Save";
    r.can    |> s |> check string __LOC__ "";
    r.tok    |> s'|> check string __LOC__ "f19a65cecdfa2971afb827bc9413eb7244e469a8";
    r.ret    |> u |> check string __LOC__ "";
    r.img    |> u |> check string __LOC__ ""
  )

module Actor = struct
  let tc_basic = "tc_basic", `Quick, (fun () ->
      Logr.info (fun m -> m "%s.%s" "Iweb.Actor" "basic");
      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
      let f = s |> Html.Form.of_string in
      f |> List.length |> check int __LOC__ 7;
      f |> List.assoc "token"      |> String.concat "|" |> check string __LOC__ "68f4cf03-8f2d-491c-a954-bd8118f93c01";
      f |> List.assoc "id"         |> String.concat "|" |> check string __LOC__ "https://alpaka.social/users/traunstein";
      f |> List.assoc "inbox"      |> String.concat "|" |> check string __LOC__ "https://alpaka.social/users/traunstein/inbox";
      f |> List.assoc "~notify"    |> String.concat "|" |> check string __LOC__ "no";
      f |> List.assoc "~subscribe" |> String.concat "|" |> check string __LOC__ "yes";
      f |> List.assoc "~block"     |> String.concat "|" |> check string __LOC__ "no";
      f |> List.assoc "notify"     |> String.concat "|" |> check string __LOC__ "on";
      let switch k v' v =
        if v' = v
        then None
        else (
          Logr.debug (fun m -> m "field %s: %s" k (v |> As2.No_p_yes.to_string));
          Some k) in
      let form_switch_folder k_of_old f_switch form init (k_old,v_old) =
        match k_old |> k_of_old with
        | None   -> init
        | Some k ->
          let v = match form |> List.assoc_opt k with
            | None
            | Some ["no"] -> As2.No_p_yes.No
            | _           -> As2.No_p_yes.Yes in
          let v_old = match v_old with
            | ["no"] -> As2.No_p_yes.No
            | _      -> As2.No_p_yes.Yes in
          match f_switch k v_old v with
          | None -> init
          | Some x -> x :: init in
      f
      |> List.fold_left (form_switch_folder (St.after ~prefix:"~") switch f) []
      |> String.concat "|"
      |> check string __LOC__ "subscribe|notify"
    )

  let tc_command = "tc_command", `Quick, (fun () ->
      let uuid = Uuidm.v `V4 in
      (match
         {|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|}
         |> Html.Form.of_string |> Iweb.Actor.command uuid with
      | `Unsubscribe -> ()
      | _ -> failwith __LOC__);
      (match
         {|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|}
         |> Html.Form.of_string |> Iweb.Actor.command uuid with
      | `Subscribe -> ()
      | _ -> failwith __LOC__)
    )
end

let tc_xhtml = "tc_xhtml", `Quick, (fun () ->
    let i_uid : Html.Form.input = ("setlogin", "text", [
        ("required","required");
        ("autofocus","autofocus");
        ("maxlength","50");
        ("minlength","1");
        ("pattern", {|^[a-zA-Z0-9_.\-]+$|});
        ("placeholder","Your local name as 'alice' in @alice@example.com");
      ]) in
    let x = Iweb.(xhtmlform ~clz:"clz" "a" "b" [i_uid] ["setlogin","strange"] [ n i_uid "uid" ]) in
    let b = Buffer.create 1024 in
    Xml.to_buf x b;
    b
    |> Buffer.contents
    |> check string __LOC__ {|<?xml version="1.0"?>
<html xml:base="../" xmlns="http://www.w3.org/1999/xhtml">
<head>
  <link rel="icon" type="image/jpg" href="../me-avatar.jpg"/>
  <meta name="generator" content="Seppo.Social"/>
  <title>a</title></head>
<body>
  <form method="post" name="b" id="b" class="clz">
    <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"/>
    <div role="alert" data-for="setlogin">strange</div></form>
</body>
</html>|};
    ();
    match Html.Form.string_opt i_uid [ Iweb.n i_uid "u d" ] with
    | Error (f,v) ->
      f |> check string __LOC__ "setlogin";
      v |> check string __LOC__ "pattern mismatch"
    | Ok _ -> failwith __LOC__
  )

let () =
  run
    "seppo_suite" [
    __FILE__ , [
      set_up;
      tc_scanf;
      tc_regexp;
      tc_markup_xml;
      tc_redir_if_cgi_bin;
      tc_login;
      ClientCookie.tc_cookie;
      Form.tc_of_string;
      tc_date;
      tc_bookmarklet;
      tc_post;
      Actor.tc_basic;
      Actor.tc_command;
      tc_xhtml;
    ]
  ]