Merge pull request #30 from nationalarchives/29-handle-existing-annotation-id

29 handle existing annotation

Author: jptmoore

miiify/bin/clone.ml

@@ -13,13 +13,13 @@ let dir_is_nonempty path =
       (* treat any entry (including hidden) as non-empty; this is a safety check *)
       List.length items > 0
 
-let run_clone ~repo_url ~git_path ~force =
+let run_clone ~repo_url ~git_path =
   let* () = Lwt_io.printl "Miiify Clone" in
   let* () = Lwt_io.printlf "Remote: %s" repo_url in
   let* () = Lwt_io.printlf "Local:  %s" git_path in
   let* () = Lwt_io.printl "" in
 
-  (* Safer default: refuse to clone into an existing non-empty directory unless forced. *)
+  (* Refuse to clone into an existing non-empty directory. *)
   let* () =
     if Sys.file_exists git_path then (
       if not (Sys.is_directory git_path) then (
@@ -29,21 +29,18 @@ let run_clone ~repo_url ~git_path ~force =
             git_path
         in
         Lwt.fail (Failure "Invalid --git path")
-      ) else if dir_is_nonempty git_path && not force then (
+      ) else if dir_is_nonempty git_path then (
         let* () =
           Lwt_io.eprintlf
             "Error: --git directory already exists and is not empty: %s"
             git_path
         in
         let* () =
           Lwt_io.eprintl
-            "Refusing to clone into an existing store. Use --force to reuse it."
+            "Remove it first if you want to start fresh: rm -rf <git-path>"
         in
         Lwt.fail (Failure "Refusing to clone into non-empty directory")
-      ) else if dir_is_nonempty git_path && force then
-        Lwt_io.eprintl
-          "Warning: --force set; reusing existing --git directory (HEAD may change)"
-      else
+      ) else
         Lwt.return_unit
     ) else
       Lwt.return_unit
@@ -126,12 +123,12 @@ let run_clone ~repo_url ~git_path ~force =
         Lwt.fail (Failure "Clone failed")
       ))
 
-let clone_repo repo_url git_path force =
+let clone_repo repo_url git_path =
   let result =
     Lwt_main.run
       (Lwt.catch
          (fun () ->
-           let* () = run_clone ~repo_url ~git_path ~force in
+           let* () = run_clone ~repo_url ~git_path in
            Lwt.return (Ok ()))
          (fun exn -> Lwt.return (Error exn)))
   in
@@ -152,23 +149,19 @@ let git_path =
   let doc = "Local Irmin Git store directory" in
   Arg.(value & opt string "git_store" & info ["git"; "g"] ~docv:"DIR" ~doc)
 
-let force_flag =
-  let doc = "Allow cloning into an existing non-empty --git directory (reuse store; may move HEAD)" in
-  Arg.(value & flag & info ["force"; "f"] ~doc)
-
 let cmd =
   let doc = "Clone remote Git repository into Irmin Git store" in
   let man = [
     `S Manpage.s_description;
     `P "Clones a remote Git repository into a local Irmin Git store.";
     `P "Fetches from remote using Irmin's native sync mechanism.";
-    `P "By default, refuses to clone into an existing non-empty --git directory.";
+    `P "Refuses to clone into an existing non-empty --git directory. Remove it first if needed.";
     `P "Example:";
     `Pre "  miiify-clone https://github.com/org/annotations.git";
     `Pre "  miiify-clone https://github.com/org/annotations.git --git ./my-db";
   ] in
   let info = Cmd.info "clone" ~version:"0.1.0" ~doc ~man in
-  Cmd.v info Term.(const clone_repo $ repo_url $ git_path $ force_flag)
+  Cmd.v info Term.(const clone_repo $ repo_url $ git_path)
 
 let () =
   (* Initialize RNG for git-paf/mirage-crypto *)

miiify/bin/compile.ml

@@ -65,17 +65,25 @@ let process_annotation git_path data validate =
         Lwt.fail (Failure ("JSON validation failed for " ^ String.concat "/" git_path))
   in
 
-  (* Check if user supplied an ID - warn that it will be ignored *)
+  (* Check for existing id - error if --validate, warn and continue otherwise *)
   let* () =
     try
       let json = Yojson.Basic.from_string data in
       match Yojson.Basic.Util.member "id" json with
       | `Null -> Lwt.return_unit
       | `String supplied_id ->
-          Lwt_io.printlf "ℹ %s - Ignoring supplied ID (%s)"
-            (String.concat "/" git_path) supplied_id
+          if validate then
+            let* () =
+              Lwt_io.eprintlf "✗ %s - annotation must not contain an id (%s)"
+                (String.concat "/" git_path) supplied_id
+            in
+            Lwt.fail (Failure ("Annotation contains existing id: " ^ String.concat "/" git_path))
+          else
+            Lwt_io.printlf "ℹ %s - Ignoring supplied ID (%s)"
+              (String.concat "/" git_path) supplied_id
       | _ -> Lwt.return_unit
-    with _ -> Lwt.return_unit
+    with Failure _ as e -> Lwt.fail e
+       | _ -> Lwt.return_unit
   in
 
   (* Validate against schema if flag is set *)

miiify/bin/import.ml

@@ -66,17 +66,25 @@ let import_annotation container_id path validate =
       Lwt.return_unit
   in
 
-  (* Check if user supplied an ID - warn that it will be ignored *)
+  (* Check for existing id - error if --validate, warn and continue otherwise *)
   let* () =
     try
       let json = Yojson.Basic.from_string content in
       match Yojson.Basic.Util.member "id" json with
       | `Null -> Lwt.return_unit
       | `String supplied_id ->
-          Lwt_io.printlf "ℹ %s/%s - Ignoring supplied ID (%s)"
-            container_id filename supplied_id
+          if validate then
+            let* () =
+              Lwt_io.eprintlf "✗ %s/%s - annotation must not contain an id (%s)"
+                container_id filename supplied_id
+            in
+            Lwt.fail (Failure ("Annotation contains existing id in " ^ path))
+          else
+            Lwt_io.printlf "ℹ %s/%s - Ignoring supplied ID (%s)"
+              container_id filename supplied_id
       | _ -> Lwt.return_unit
-    with _ -> Lwt.return_unit
+    with Failure _ as e -> Lwt.fail e
+       | _ -> Lwt.return_unit
   in
 
   (* Return key and data for batch commit *)
@@ -283,6 +291,20 @@ let import_directory input_dir git_path validate =
     Printf.eprintf "Error: Path is not a directory: %s\n" input_dir;
     exit 1
   );
+
+  (* Refuse to import into an existing non-empty git store unless forced *)
+  if Sys.file_exists git_path then (
+    if not (Sys.is_directory git_path) then (
+      Printf.eprintf "Error: --git path exists and is not a directory: %s\n" git_path;
+      exit 1
+    ) else
+      let entries = Sys.readdir git_path |> Array.to_list in
+      if List.length entries > 0 then (
+        Printf.eprintf "Error: --git directory already exists and is not empty: %s\n" git_path;
+        Printf.eprintf "Remove it first if you want to start fresh: rm -rf <git-path>\n";
+        exit 1
+      )
+  );
 
   let result =
     Lwt_main.run
@@ -320,6 +342,7 @@ let cmd =
     `S Manpage.s_description;
     `P "Imports JSON annotation files into Irmin Git store for development/testing.";
     `P "In production, use 'miiify clone' to clone a remote repository instead.";
+    `P "Refuses to import into an existing non-empty --git directory. Remove it first if needed.";
     `P "Example:";
     `Pre "  miiify-import --input ./annotations --git ./git_store";
     `Pre "  miiify-import --input ./annotations --git ./git_store --validate";

miiify/dune-project

@@ -2,7 +2,7 @@
 
 (name miiify)
 
-(version 2.0.1)
+(version 2.0.2)
 
 (generate_opam_files true)
 

miiify/lib/annotation.ml

@@ -69,20 +69,13 @@ let page json ~page ~total ~limit =
 
 let annotation json = json |> to_string
 
-(* Inject ID into annotation for read-only serving *)
+(* Inject ID into annotation for read-only serving.
+   Any existing id field is replaced with the server-generated IRI. *)
 let inject_id json ~container_id ~annotation_id ~base_url =
-  let open Util in
-  let existing_id = json |> member "id" in
-  match existing_id with
-  | `Null ->
-      (* No ID present, inject it *)
-      let iri = base_url ^ "/" ^ container_id ^ "/" ^ annotation_id in
-      combine (`Assoc [ ("id", `String iri) ]) json
-  | `String id ->
-      (* ID exists but might not match server URL, update it *)
-      let iri = base_url ^ "/" ^ container_id ^ "/" ^ annotation_id in
-      if id <> iri then
-        combine (`Assoc [ ("id", `String iri) ]) json
-      else
-        json
-  | _ -> json
+  let iri = base_url ^ "/" ^ container_id ^ "/" ^ annotation_id in
+  let stripped =
+    match json with
+    | `Assoc pairs -> `Assoc (List.filter (fun (k, _) -> k <> "id") pairs)
+    | other -> other
+  in
+  Util.combine (`Assoc [ ("id", `String iri) ]) stripped

miiify/miiify.opam

@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "2.0.1"
+version: "2.0.2"
 synopsis: "A web annotation server"
 description:
   "A simple web annotation server built from the same principles at Git"

miiify/test/response_test.ml

@@ -86,10 +86,20 @@ let test_id_replacement _switch () =
     Miiify.Controller.get_annotation ~db ~container_id ~annotation_id ~base_url
   in
   let json = Yojson.Basic.from_string result in
-  let id = Yojson.Basic.Util.member "id" json |> Yojson.Basic.Util.to_string in
 
+  (* Confirm the id is the server-generated IRI *)
+  let id = Yojson.Basic.Util.member "id" json |> Yojson.Basic.Util.to_string in
   Alcotest.(check string) "annotation has server-generated ID (not supplied ID)"
     "http://localhost:10000/my-canvas/highlight-1" id;
+
+  (* Confirm no duplicate id keys (JSON parsed as assoc should have exactly one "id") *)
+  let id_count =
+    match json with
+    | `Assoc pairs -> List.length (List.filter (fun (k, _) -> k = "id") pairs)
+    | _ -> 0
+  in
+  Alcotest.(check int) "exactly one id key in output" 1 id_count;
+
   Lwt.return_unit
 
 (* Test: ID injection into container *)

miiify/test/smoke_test.ml

@@ -66,7 +66,72 @@ let test_import_compile_then_http _switch () =
 
   Lwt.return_unit
 
+(* Test: annotation with existing id is warned but accepted without --validate *)
+let test_import_with_id_no_validate _switch () =
+  let ws = make_temp_workspace "id-no-validate" in
+  let _ =
+    write_annotation_file ~annotations_dir:ws.annotations_dir
+      ~container_id:"my-canvas" ~slug:"anno-with-id" ~contents:annotation_with_id
+  in
+  let result =
+    run_miiify_import ~annotations_dir:ws.annotations_dir ~git_repo:ws.git_repo
+  in
+  Alcotest.(check int) "import succeeds without --validate when annotation has id" 0 result;
+  Lwt.return_unit
+
+(* Test: annotation with existing id fails with --validate *)
+let test_import_with_id_validate _switch () =
+  let ws = make_temp_workspace "id-validate" in
+  let _ =
+    write_annotation_file ~annotations_dir:ws.annotations_dir
+      ~container_id:"my-canvas" ~slug:"anno-with-id" ~contents:annotation_with_id
+  in
+  let result =
+    run_miiify_import_validate ~annotations_dir:ws.annotations_dir ~git_repo:ws.git_repo
+  in
+  Alcotest.(check bool) "import fails with --validate when annotation has id" true (result <> 0);
+  Lwt.return_unit
+
+(* Test: compile with existing id is warned but accepted without --validate *)
+let test_compile_with_id_no_validate _switch () =
+  let ws = make_temp_workspace "compile-id-no-validate" in
+  let _ =
+    write_annotation_file ~annotations_dir:ws.annotations_dir
+      ~container_id:"my-canvas" ~slug:"anno-with-id" ~contents:annotation_with_id
+  in
+  let import_result =
+    run_miiify_import ~annotations_dir:ws.annotations_dir ~git_repo:ws.git_repo
+  in
+  Alcotest.(check int) "import succeeds" 0 import_result;
+  let result = run_miiify_compile ~git_repo:ws.git_repo ~pack_repo:ws.pack_repo in
+  Alcotest.(check int) "compile succeeds without --validate when annotation has id" 0 result;
+  Lwt.return_unit
+
+(* Test: compile with existing id fails with --validate *)
+let test_compile_with_id_validate _switch () =
+  let ws = make_temp_workspace "compile-id-validate" in
+  let _ =
+    write_annotation_file ~annotations_dir:ws.annotations_dir
+      ~container_id:"my-canvas" ~slug:"anno-with-id" ~contents:annotation_with_id
+  in
+  let import_result =
+    run_miiify_import ~annotations_dir:ws.annotations_dir ~git_repo:ws.git_repo
+  in
+  Alcotest.(check int) "import succeeds" 0 import_result;
+  let result = run_miiify_compile_validate ~git_repo:ws.git_repo ~pack_repo:ws.pack_repo in
+  Alcotest.(check bool) "compile fails with --validate when annotation has id" true (result <> 0);
+  Lwt.return_unit
+
 let () =
   Lwt_main.run @@
   run "Miiify Smoke Tests"
-    [ ("E2E", [ test_case "import+compile+http" `Quick test_import_compile_then_http ]) ]
+    [
+      ("E2E", [ test_case "import+compile+http" `Quick test_import_compile_then_http ]);
+      ( "ID handling",
+        [
+          test_case "import: id ignored without --validate" `Quick test_import_with_id_no_validate;
+          test_case "import: id rejected with --validate" `Quick test_import_with_id_validate;
+          test_case "compile: id ignored without --validate" `Quick test_compile_with_id_no_validate;
+          test_case "compile: id rejected with --validate" `Quick test_compile_with_id_validate;
+        ] );
+    ]

miiify/test/test_support.ml

@@ -62,6 +62,19 @@ let comment_annotation =
 
 let comment_target = "https://example.com/iiif/canvas/1#xywh=300,150,100,75"
 
+let annotation_with_id =
+  {|{
+  "id": "https://example.com/existing-id",
+  "type": "Annotation",
+  "motivation": "highlighting",
+  "body": {
+    "type": "TextualBody",
+    "value": "Has an existing id",
+    "purpose": "commenting"
+  },
+  "target": "https://example.com/iiif/canvas/1#xywh=100,100,200,50"
+}|}
+
 let write_file path contents =
   let oc = open_out path in
   output_string oc contents;
@@ -120,6 +133,14 @@ let run_miiify_import ~annotations_dir ~git_repo =
   in
   Sys.command cmd
 
+let run_miiify_import_validate ~annotations_dir ~git_repo =
+  let cmd =
+    Printf.sprintf "%s --input %s --git %s --validate > /dev/null 2>&1"
+      (Filename.quote (import_exe ())) (Filename.quote annotations_dir)
+      (Filename.quote git_repo)
+  in
+  Sys.command cmd
+
 let run_miiify_compile ~git_repo ~pack_repo =
   let cmd =
     Printf.sprintf "%s --git %s --pack %s > /dev/null 2>&1"
@@ -128,6 +149,14 @@ let run_miiify_compile ~git_repo ~pack_repo =
   in
   Sys.command cmd
 
+let run_miiify_compile_validate ~git_repo ~pack_repo =
+  let cmd =
+    Printf.sprintf "%s --git %s --pack %s --validate > /dev/null 2>&1"
+      (Filename.quote (compile_exe ())) (Filename.quote git_repo)
+      (Filename.quote pack_repo)
+  in
+  Sys.command cmd
+
 let create_test_db_from_files test_name =
   let ws = make_temp_workspace test_name in