seppo/test/iweb_test.ml

open Seppo_lib

let test_scanf () =
  Scanf.sscanf "37s" "%is" (fun i -> i)
  |> Assrt.equals_int __LOC__ 37

let test_regexp () =
  let rx = Str.regexp {|^[^\n\t ]\([^\n\t]+[^\n\t ]\)?$|} in
  assert (Str.string_match rx "a" 0);
  assert true

let test_markup_xml () =
  [
    `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
  |> Assrt.equals_string __LOC__ "<foo>\n <bar>\n  <baz/>\n </bar>\n</foo>\n"

let test_login () =
  Iweb.MyCookie.name |> Assrt.equals_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
  |> Assrt.equals_int __LOC__ 841

let test_cookie () =
  Iweb.MyCookie.name |> Assrt.equals_string __LOC__ "#session";
  (match "(5:seppi25:2022-10-03T01:02:03+01:00)"
         |> Iweb.MyCookie.decode with
  | Ok (Auth.Uid uid, _t) ->
    uid |> Assrt.equals_string __LOC__ "seppi"
  | Error e -> e |> Assrt.equals_string __LOC__ "");
  (Auth.Uid "seppa", Ptime.epoch)
  |> Iweb.MyCookie.encode
  |> Assrt.equals_string __LOC__ "(5:seppa25:1970-01-01T00:00:00-00:00)";
  (match (Auth.Uid "seppu", Ptime.epoch)
         |> Iweb.MyCookie.encode
         |> Iweb.MyCookie.decode with
  | Ok (Auth.Uid uid, _t) ->
    uid |> Assrt.equals_string __LOC__ "seppu"
  | Error e -> e |> Assrt.equals_string __LOC__ "");
  assert true

let test_csrf_token () =
  let fu () = () in
  let v = "f19a65cecdfa2971afb827bc9413eb7244e469a8" in
  let f = ([("token", [ v ])], ()) in
  match Iweb.check_token fu v f with
  | Ok (t, _) -> Assrt.equals_string __LOC__ v t
  | Error (s,_,_) ->
    s |> Cohttp.Code.code_of_status |> Assrt.equals_int __LOC__ 200

let test_date () =
  let d x = x
            |> Option.value ~default:Iweb.Post.epoch_shaarli
            |> Ptime.to_rfc3339
  in
  "20230927_125036" |> Iweb.Post.s2d |> d |> Assrt.equals_string __LOC__ "2023-09-27T12:50:36-00:00"

let test_bookmarklet () =
  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 |> Assrt.equals_string __LOC__ "yes";
  r.source |> s |> Assrt.equals_string __LOC__ "bookmarklet";
  r.dat    |> d |> Assrt.equals_string __LOC__ "2023-09-27T12:45:42-00:00";
  r.url    |> u |> Assrt.equals_string __LOC__ "https://www.heise.de/";
  r.tit    |> s |> Assrt.equals_string __LOC__ "heise online - IT-News, Nachrichten und Hintergründe";
  r.dsc    |> s |> Assrt.equals_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 |> Assrt.equals_string __LOC__ "heise online, c't, iX, MIT Technology Review, Newsticker, Telepolis, Security, Netze";
  r.pri    |> b |> Assrt.equals_string __LOC__ "no";
  assert (r.sav    |> Option.is_none);
  r.can    |> s |> Assrt.equals_string __LOC__ "";
  r.tok    |> s'|> Assrt.equals_string __LOC__ "";
  r.ret    |> u |> Assrt.equals_string __LOC__ "";
  r.img    |> u |> Assrt.equals_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 |> Assrt.equals_string __LOC__ "no";
  r.source |> s |> Assrt.equals_string __LOC__ "";
  r.dat    |> d |> Assrt.equals_string __LOC__ "2023-09-27T12:45:42-00:00";
  r.url    |> u |> Assrt.equals_string __LOC__ "";
  r.tit    |> s |> Assrt.equals_string __LOC__ "Some #text 🐫";
  r.dsc    |> s |> Assrt.equals_string __LOC__ "";
  r.tag    |> l |> Assrt.equals_string __LOC__ "";
  r.pri    |> b |> Assrt.equals_string __LOC__ "no";
  assert (r.sav    |> Option.is_none);
  r.can    |> s |> Assrt.equals_string __LOC__ "";
  r.tok    |> s'|> Assrt.equals_string __LOC__ "";
  r.ret    |> u |> Assrt.equals_string __LOC__ "";
  r.img    |> u |> Assrt.equals_string __LOC__ ""


let test_post () =
  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 |> Assrt.equals_string __LOC__ "no";
  r.source |> s |> Assrt.equals_string __LOC__ "";
  r.dat    |> d |> Assrt.equals_string __LOC__ "2021-09-13T13:45:42-00:00";
  r.url    |> u |> Assrt.equals_string __LOC__ "http://example.com";
  r.tit    |> s |> Assrt.equals_string __LOC__ "title";
  r.dsc    |> s |> Assrt.equals_string __LOC__ "body #tags";
  r.tag    |> l |> Assrt.equals_string __LOC__ "";
  r.pri    |> b |> Assrt.equals_string __LOC__ "no";
  (match r.sav with | Some Save -> "Save"| _ -> "Fail") |> Assrt.equals_string __LOC__ "Save";
  r.can    |> s |> Assrt.equals_string __LOC__ "";
  r.tok    |> s'|> Assrt.equals_string __LOC__ "f19a65cecdfa2971afb827bc9413eb7244e469a8";
  r.ret    |> u |> Assrt.equals_string __LOC__ "";
  r.img    |> u |> Assrt.equals_string __LOC__ ""

module Actor = struct
  let test_basic () =
    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 |> Http.Form.of_string in
    f |> List.length |> Assrt.equals_int __LOC__ 7;
    f |> List.assoc "token"      |> String.concat "|" |> Assrt.equals_string __LOC__ "68f4cf03-8f2d-491c-a954-bd8118f93c01";
    f |> List.assoc "id"         |> String.concat "|" |> Assrt.equals_string __LOC__ "https://alpaka.social/users/traunstein";
    f |> List.assoc "inbox"      |> String.concat "|" |> Assrt.equals_string __LOC__ "https://alpaka.social/users/traunstein/inbox";
    f |> List.assoc "~notify"    |> String.concat "|" |> Assrt.equals_string __LOC__ "no";
    f |> List.assoc "~subscribe" |> String.concat "|" |> Assrt.equals_string __LOC__ "yes";
    f |> List.assoc "~block"     |> String.concat "|" |> Assrt.equals_string __LOC__ "no";
    f |> List.assoc "notify"     |> String.concat "|" |> Assrt.equals_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 "|"
    |> Assrt.equals_string __LOC__ "subscribe|notify"
end

let () =
  Unix.chdir "../../../test/";
  test_scanf ();
  test_regexp ();
  test_markup_xml ();
  test_login ();
  test_cookie ();
  test_csrf_token ();
  test_date ();
  test_bookmarklet ();
  test_post ();
  Actor.test_basic ();
  assert true