agent-snapshot.git

index fcbb783..2b963a0 100644
--- a/dune-project
+++ b/dune-project
@@ -8,6 +8,7 @@
   (ocaml (>= 5.4))
   dune
   yojson
+  ppx_deriving_yojson
   camomile
   ocaml-git
   fpath

index 3492f63..dbed0e6 100644
--- a/src/ocaml/agent_snapshot.ml
+++ b/src/ocaml/agent_snapshot.ml
@@ -107,6 +107,27 @@ type repo_record = {
   mutable dirty : bool;
 }
 
+(** JSON array of strings in the ignore config file. *)
+type ignore_file_entries = string list [@@deriving yojson]
+
+(** One repository row in manifest.json ["git_repositories"]. *)
+type manifest_repo = {
+  root : string;
+  head : string;
+  dirty : bool;
+}
+[@@deriving yojson]
+
+(** Subset of the per-file ["after"] object needed by [restore_snapshot]. *)
+type manifest_after = {
+  exists : bool;
+  tombstone : bool [@default false];
+  blob : string option [@default None];
+  mode : int option [@default None];
+  mtime : int option [@default None];
+}
+[@@deriving yojson { strict = false }]
+
 let empty_metadata () : metadata =
   { exists = false; tombstone = false; regular = false; directory = false; mode = 0; size = 0L; mtime = 0; blob = None }
 
@@ -193,16 +214,11 @@ let load_ignore_config () : unit =
     try Json.from_file !ignore_config_path
     with Sys_error _ -> failwith ("ignore config does not exist: " ^ !ignore_config_path)
   in
-  match json with
-  | `List entries ->
+  match ignore_file_entries_of_yojson json with
+  | Ok entries ->
       ignored_paths :=
-        !ignore_config_path
-        :: List.map
-             (function
-               | `String entry -> best_effort_canonical (expand_ignore_entry entry)
-               | _ -> failwith ("ignore config entries must be strings: " ^ !ignore_config_path))
-             entries
-  | _ -> failwith ("ignore config must be a JSON array: " ^ !ignore_config_path)
+        !ignore_config_path :: List.map (fun entry -> best_effort_canonical (expand_ignore_entry entry)) entries
+  | Error msg -> failwith ("ignore config: " ^ msg ^ " (" ^ !ignore_config_path ^ ")")
 
 let mode_of_kind (kind : Unix.file_kind) : int =
   match kind with
@@ -307,7 +323,7 @@ let classify_git (input_path : string) : git_info =
                   match Hashtbl.find_opt repos root with
                   | Some rec_record -> rec_record
                   | None ->
-                      let rec_record = { root; head = info.head; dirty = false } in
+                      let rec_record : repo_record = { root; head = info.head; dirty = false } in
                       Hashtbl.add repos root rec_record;
                       rec_record
                 in
@@ -412,7 +428,10 @@ let git_json (git : git_info) : Json.t =
 
 let write_manifest (out : string) (command : string list) (exit_status : int) : unit =
   let repo_items =
-    Hashtbl.fold (fun _ repo acc -> `Assoc [ ("root", jstr repo.root); ("head", jstr repo.head); ("dirty", `Bool repo.dirty) ] :: acc) repos []
+    Hashtbl.fold
+      (fun _ (repo : repo_record) acc ->
+        manifest_repo_to_yojson { root = repo.root; head = repo.head; dirty = repo.dirty } :: acc)
+      repos []
     |> List.sort Stdlib.compare
   in
   let file_items =
@@ -626,35 +645,33 @@ let restore_snapshot (dir : string) : unit =
       match file_json with
       | `Assoc item -> (
           match (List.assoc_opt "path" item, List.assoc_opt "after" item : Json.t option * Json.t option) with
-          | Some (`String path), Some (`Assoc after) ->
-              let exists = match List.assoc_opt "exists" after with Some (`Bool b) -> b | _ -> false in
-              if not exists then (
-                let tombstone = match List.assoc_opt "tombstone" after with Some (`Bool b) -> b | _ -> false in
-                if tombstone then
-                  try FileUtil.rm ~force:FileUtil.Force [ path ]
-                  with FileUtil.RmError _ | Unix.Unix_error (_, _, _) -> ())
-              else (
-                match List.assoc_opt "blob" after with
-                | None -> ()
-                | Some (`String digest) ->
-                    mkdir_p (dirname path);
-                    let same =
-                      FileUtil.test (FileUtil.And (FileUtil.Exists, FileUtil.Not FileUtil.Is_dir)) path
-                      && fnv1a_file_digest path = digest
-                    in
-                    if not same then (
-                      let tmp = path ^ ".agent-snapshot.tmp" in
-                      copy_file (concat_path (concat_path dir "blobs") digest) tmp;
-                      Unix.rename tmp path);
-                    (match List.assoc_opt "mode" after with
-                    | Some (`Int mode) ->
-                        FileUtil.chmod (`Octal (mode land 0o7777)) [ path ]
-                    | _ -> ());
-                    (match List.assoc_opt "mtime" after with
-                    | Some (`Int mtime) ->
-                        FileUtil.touch ~time:(FileUtil.Touch_timestamp (float_of_int mtime)) path
-                    | _ -> ())
-                | _ -> ())
+          | Some (`String path), Some (`Assoc after_fields) -> (
+              match manifest_after_of_yojson (`Assoc after_fields) with
+              | Error _ -> ()
+              | Ok after ->
+                  if not after.exists then (
+                    if after.tombstone then
+                      try FileUtil.rm ~force:FileUtil.Force [ path ]
+                      with FileUtil.RmError _ | Unix.Unix_error (_, _, _) -> ())
+                  else (
+                    match after.blob with
+                    | None -> ()
+                    | Some digest ->
+                        mkdir_p (dirname path);
+                        let same =
+                          FileUtil.test (FileUtil.And (FileUtil.Exists, FileUtil.Not FileUtil.Is_dir)) path
+                          && fnv1a_file_digest path = digest
+                        in
+                        if not same then (
+                          let tmp = path ^ ".agent-snapshot.tmp" in
+                          copy_file (concat_path (concat_path dir "blobs") digest) tmp;
+                          Unix.rename tmp path);
+                        (match after.mode with
+                        | Some mode -> FileUtil.chmod (`Octal (mode land 0o7777)) [ path ]
+                        | None -> ());
+                        (match after.mtime with
+                        | Some mtime -> FileUtil.touch ~time:(FileUtil.Touch_timestamp (float_of_int mtime)) path
+                        | None -> ())))
           | _ -> ())
       | _ -> ())
     files

index cf8401b..0bf84bc 100644
--- a/src/ocaml/dune
+++ b/src/ocaml/dune
@@ -1,6 +1,8 @@
 (executable
  (name agent_snapshot)
  (public_name agent-snapshot)
+ (preprocess
+  (pps ppx_deriving_yojson))
  (foreign_stubs
   (language c)
   (names ptrace_stubs))