geochan/test/test.ml

open Alcotest
open Types
open Syntax
open Util

module Test_comment = struct
  let f () =
    let open Comment in
    let result = Alcotest.result string string in
    let bool_result = Alcotest.result bool string in
    let check_id s =
      (check result) "to_string(of_string(s))=id" (Ok s)
        (match of_string s with Ok v -> Ok (to_string v) | Error e -> Error e)
    in
    let check_eq expected s =
      (check bool_result) "eq" (Ok true)
        (match of_string s with Error e -> Error e | Ok v -> Ok (expected = v))
    in
    let l =
      [ ("cc sava?", [ Line [ Txt "cc sava?" ] ])
      ; ("cc\n\n sava?", [ Line [ Txt "cc" ]; Line []; Line [ Txt " sava?" ] ])
      ; (">cc sava?", [ Line_quote [ Txt "cc sava?" ] ])
      ; (">cc sava\n?", [ Line_quote [ Txt "cc sava" ]; Line [ Txt "?" ] ])
      ; ("cc >>13 sava?", [ Line [ Txt "cc "; Id 13; Txt " sava?" ] ])
      ; (">cc >>13 sava?", [ Line_quote [ Txt "cc "; Id 13; Txt " sava?" ] ])
      ; (">>13 cc sava?", [ Line [ Id 13; Txt " cc sava?" ] ])
      ; (">>13\n cc sava?", [ Line [ Id 13 ]; Line [ Txt " cc sava?" ] ])
      ; (">>>13\n cc sava?", [ Line_quote [ Id 13 ]; Line [ Txt " cc sava?" ] ])
      ; ( ">>>>13\n cc sava?"
        , [ Line_quote [ Txt ">"; Id 13 ]; Line [ Txt " cc sava?" ] ] )
      ; (">>13 >cc sava?", [ Line [ Id 13; Txt " >cc sava?" ] ])
      ; ( ">>>>13\n cc sava?"
        , [ Line_quote [ Txt ">"; Id 13 ]; Line [ Txt " cc sava?" ] ] )
      ]
    in
    List.iter (fun (s, _) -> check_id s) l;
    List.iter (fun (s, expected) -> check_eq expected s) l;
    ()
end

module Test_json_data = struct
  let err () =
    let err_result = Alcotest.result err string in
    let check e =
      (check err_result) "read(write(o))=id" (Ok e)
        (Json_data.Write.err e |> Json_data.Read.err)
    in
    let l =
      Err.
        [ Internal (Db "a")
        ; Internal (Conan "a")
        ; Bad_form
        ; Forbidden
        ; Unauthorized_login "a"
        ]
    in
    List.iter check l
end

module Test_user = struct
  let email = "user_1@test.com"

  let nick = "user_1"

  let password = "hunter2"

  let bio = "hello im user_1 ~~"

  let make () =
    (check unit_result) "is ok" (Ok ())
      (let* () = User.register ~email ~nick ~password in
       Ok () );
    ()

  let login () =
    (check unit_result) "is ok" (Ok ())
      (let* _ : User_private.t = User.login ~login:email ~password in
       Ok () );
    (check unit_result) "is ok" (Ok ())
      (let* _ : User_private.t = User.login ~login:nick ~password in
       Ok () );
    ()

  let get_id () =
    let* u = User.login ~login:email ~password in
    Ok u.user_id

  let get_user () =
    (check unit_result) "is ok" (Ok ())
      (let* id = get_id () in
       let* _ : user = User.get_user id in
       let* _ : User_private.t = User.get_user_private id in
       Ok () );
    ()

  let get_image () =
    (check unit_result) "is ok" (Ok ())
      (let* id = get_id () in
       let* _image_data : string = User.get_image id in
       Ok () );
    ()

  let update () =
    let email_2 = "user_2@test.com" in
    let nick_2 = "user_2" in
    let password_2 = "xXhunter2Xx" in
    (check unit_result) "is ok" (Ok ())
      (let* id = get_id () in
       let* () = User.update_email id email_2 in
       let* () = User.update_nick id nick_2 in
       let* () = User.update_password id password_2 in
       let* () = User.update_bio id bio in
       let* () =
         (* should not accept change to already taken value *)
         assert_error (User.update_email id email_2)
       in
       (* revert changes *)
       let* () = User.update_email id email in
       let* () = User.update_nick id nick in
       let* () = User.update_password id password in
       Ok () );
    ()

  let delete () =
    (check unit_result) "is ok" (Ok ())
      (let* id = get_id () in
       let* () = User.delete_avatar id in
       let* () = User.delete_user id in
       let* () = assert_error (User.get_user id) in
       let* () = assert_error (User.login ~login:email ~password) in
       Ok () );
    ()
end

module Test_post = struct
  let post_count = ref 0

  let subject = "first thread"

  let mk_comment =
   fun () ->
    incr post_count;
    let s = Fmt.str "comment nb %d ^^ ~~!" !post_count in
    s

  let assert_post_not_found id =
    match Post.get_post id with
    | Ok _ -> error "post found"
    | Error e -> assert_true (e = Not_found_post id)

  let assert_post_image_found id =
    let* _ : string = Post.get_thumbnail_data id in
    let* _ : string = Post.get_image_data id in
    Ok ()

  let assert_post_image_not_found id =
    match assert_post_image_found id with
    | Ok _ -> error "post image found"
    | Error e -> assert_true (e = Not_found_image id)

  let get_first_thread () =
    let* catalog = Post.get_catalog () in
    match catalog with [] -> error "empty catalog" | hd :: _ -> Ok hd

  let empty_catalog () =
    (check unit_result) "is ok" (Ok ())
      (let* catalog = Post.get_catalog () in
       assert_true (List.is_empty catalog) );
    ()

  let make_thread () =
    (check unit_result) "is ok" (Ok ())
      (let* user_id = Test_user.get_id () in
       let* user = User.get_user user_id in
       let lat, lng = (12.0, -13.0) in
       let comment = mk_comment () in
       let image_data = None in
       let* thread =
         Post.make_thread ~comment ~image_data ~subject ~lat ~lng user
       in
       let post_id = thread.op.id in
       let date = thread.op.date in
       let* expected_comment =
         Comment.of_string comment
         |> Result.map_error (fun s ->
                Err.Unprocessable (Fmt.str "comment: %s" s) )
       in
       let expected_op =
         { id = post_id
         ; parent_t_id = post_id
         ; date
         ; poster_id = user_id
         ; poster_nick = Test_user.nick
         ; comment = expected_comment
         ; image_info = None
         ; backlinks = []
         }
       in
       let expected_thread =
         Thread_w_reply.
           { op = expected_op
           ; subject
           ; lat
           ; lng
           ; bump_status = Alive 0
           ; reply_count = 0
           ; reply_l = [ expected_op ]
           }
       in
       assert_true (expected_thread = thread) );
    ()

  let make_reply () =
    (check unit_result) "is ok" (Ok ())
      (let* user_id = Test_user.get_id () in
       let* user = User.get_user user_id in
       let* parent_thread = get_first_thread () in
       let comment = mk_comment () in
       let image_data = None in
       let* post = Post.make_post ~comment ~image_data ~parent_thread user in
       let* expected_comment =
         Comment.of_string comment
         |> Result.map_error (fun s ->
                Err.Unprocessable (Fmt.str "comment: %s" s) )
       in
       let expected_post =
         { id = post.id
         ; parent_t_id = parent_thread.op.id
         ; date = post.date
         ; poster_id = user_id
         ; poster_nick = Test_user.nick
         ; comment = expected_comment
         ; image_info = None
         ; backlinks = []
         }
       in
       let* () = assert_true (expected_post = post) in
       let* parent_thread_updated = Post.get_thread parent_thread.op.id in
       let* () = assert_true @@ (!post_count = 2) in
       let* () =
         assert_true
           ({ parent_thread with reply_count = 1 } = parent_thread_updated)
       in
       Ok () );
    ()

  let make_reply_with_image () =
    let f img =
      let mime, name, alt, data = img in
      let image_data = Some (Some name, alt, data) in
      let* user_id = Test_user.get_id () in
      let* user = User.get_user user_id in
      let* parent_thread = get_first_thread () in
      let comment = mk_comment () in
      let* post = Post.make_post ~comment ~image_data ~parent_thread user in
      let* expected_comment =
        Comment.of_string comment
        |> Result.map_error (fun s ->
               Err.Unprocessable (Fmt.str "comment: %s" s) )
      in
      (* image read/write to file for thumbnail creation + strip exif change image data
         thumbnail dimension can be <> than image dimension *)
      let post_image_info = Option.get post.image_info in
      let expected_image_info =
        { md5 = post_image_info.md5
        ; mime
        ; w = 1
        ; h = 1
        ; thumb_w = post_image_info.thumb_w
        ; thumb_h = post_image_info.thumb_h
        ; name
        ; alt
        }
      in
      let expected_post =
        { id = post.id
        ; parent_t_id = parent_thread.op.id
        ; date = post.date
        ; poster_id = user_id
        ; poster_nick = Test_user.nick
        ; comment = expected_comment
        ; image_info = Some expected_image_info
        ; backlinks = []
        }
      in
      Fmt.epr "expected --@.%s@." (Json_data.Write.post expected_post);
      Fmt.epr "got --@.%s@." (Json_data.Write.post post);
      let* () = assert_true (expected_post = post) in
      Ok ()
    in
    (check unit_result) "is ok" (Ok ())
      (let* () = assert_true (Array.length imgs = 4) in
       let* () = array_iter f imgs in
       Ok () );
    ()

  let no_exif () =
    let get_img id = Post.get_image_data id in
    let get_img_name id =
      let* info = Post.get_image_info id in
      Ok info.name
    in
    (check unit_result) "is ok" (Ok ())
      ((* post with fff.png *)
       let id1 = 3 in
       (* post with fff.exif.png *)
       let id2 = 6 in
       let* img1 = get_img id1 in
       let* img2 = get_img id2 in
       let* img1_name = get_img_name id1 in
       let* img2_name = get_img_name id2 in
       let* () = assert_true (img1_name = "fff.png") in
       let* () = assert_true (img2_name = "fff.exif.png") in
       let* () =
         assert_true
           (let regex = Re.Posix.compile_pat "exif" in
            Re.exec_opt regex img2 |> Option.is_none )
       in
       let* () = assert_true (img1 = img2) in
       Ok () )

  let gets () =
    (check unit_result) "is ok" (Ok ())
      (let* thread = get_first_thread () in
       let* thread_w_reply = Post.get_thread_w_reply thread.op.id in
       let thread' = Util.thread_w_reply_to_simple thread_w_reply in
       let* () = assert_true (thread = thread') in
       let count = !post_count in
       let* () = assert_true @@ (count = 6) in
       (* TODO remove op from thread's replies *)
       (* - 1 because op does not count as a reply *)
       let* () = assert_true @@ (thread.reply_count = count - 1) in
       (* but not here because its in the replies list of thread *)
       let* () = assert_true @@ (List.length thread_w_reply.reply_l = count) in
       (* !! post id start at 1 *)
       let* () = assert_error @@ Post.get_post 0 in
       (* get all posts an compare them to thread replies *)
       let id_l = List.init count (fun i -> i + 1) in
       let* post_l = list_map Post.get_post id_l in
       let* () = assert_true (thread_w_reply.reply_l = post_l) in
       (* check image data *)
       (* first 2 post don't have image *)
       let* () = assert_post_image_not_found 1 in
       let* () = assert_post_image_not_found 2 in
       (* last 4 post have images *)
       let* () = assert_post_image_found 3 in
       let* () = assert_post_image_found 4 in
       let* () = assert_post_image_found 5 in
       let* () = assert_post_image_found 6 in
       Ok () );
    ()

  let post_delete id =
    let* user_id = Test_user.get_id () in
    let* user = User.get_user user_id in
    let* () = Post.delete ~user id in
    Ok ()

  let delete_reply () =
    (check unit_result) "is ok" (Ok ())
      ((* delete last post *)
       let* () = post_delete !post_count in
       let count = !post_count - 1 in
       let* () = assert_post_not_found !post_count in
       let* () = assert_post_image_not_found !post_count in
       let* thread = get_first_thread () in
       let* Thread_w_reply.
              { op; subject; lat; lng; bump_status; reply_count; reply_l } =
         Post.get_thread_w_reply thread.op.id
       in
       let thread' = { op; subject; lat; lng; bump_status; reply_count } in
       let* () = assert_true (thread = thread') in
       let id_l = List.init count (fun i -> i + 1) in
       let* post_l = list_map Post.get_post id_l in
       let* () = assert_true (reply_l = post_l) in
       Ok () );
    ()

  let delete_thread () =
    (check unit_result) "is ok" (Ok ())
      ((* delete first thread *)
       let* t_info = get_first_thread () in
       let* () = post_delete t_info.op.id in
       let* () = assert_error @@ get_first_thread () in
       (* check all posts are deleted *)
       let id_l = List.init !post_count (fun i -> i + 1) in
       let* () = list_iter (fun id -> assert_post_not_found id) id_l in
       let* () = list_iter (fun id -> assert_post_image_not_found id) id_l in
       Ok () );
    ()
end

let () =
  run "Tests"
    [ ("Comment read & write", [ test_case "comment" `Quick Test_comment.f ])
    ; ("Json data read & write", [ test_case "err" `Quick Test_json_data.err ])
    ; (* !! order of tests on database is important *)
      ( "User"
      , Test_user.
          [ test_case "make" `Quick make
          ; test_case "login" `Quick login
          ; test_case "get" `Quick get_user
          ; test_case "get_image" `Quick get_image
          ; test_case "update" `Quick update
          ; test_case "delete" `Quick delete
          ; test_case "re make user_1" `Quick make
          ] )
    ; ( "Post"
      , Test_post.
          [ test_case "empty catalog" `Quick empty_catalog
          ; test_case "make thread" `Quick make_thread
          ; test_case "make reply" `Quick make_reply
          ; test_case "make reply with image" `Quick make_reply_with_image
          ; test_case "gets" `Quick gets
          ; test_case "no exif" `Quick no_exif
          ; test_case "delete reply" `Quick delete_reply
          ; test_case "delete thread" `Quick delete_thread
          ] )
    ]