test remote configuration against temporary repositories

Cover repository detection, fetch URL creation and changes, implicit push
preservation, idempotent adds, removal and collapsing, unknown remotes and
URLs that would be dangerous if git-fleet built shell command lines. Every
test runs in a temporary repository.

test/dune

@@ -1,3 +1,3 @@
 (test
  (name test_git_fleet)
- (libraries git_fleet alcotest))
+ (libraries git_fleet alcotest unix))

test/test_git_fleet.ml

@@ -1,18 +1,259 @@
-let test_version () =
+open Git_fleet
+
+let primary = "git@git.example.invalid:user/project.git"
+let github = "git@github.com:user/project.git"
+let backup = "git@backup.example.invalid:user/project.git"
+let urls = Alcotest.(list string)
+
+let ok = function
+  | Ok value -> value
+  | Error error ->
+      Alcotest.failf "unexpected error: %s" (Git.string_of_error error)
+
+let error = function
+  | Ok _ -> Alcotest.fail "expected an error"
+  | Error error -> error
+
+(* Arrange repository state with Git itself, so that the assertions do not
+   depend on the code under test. *)
+let git_exn dir args =
+  let argv = Array.of_list (("git" :: "-C" :: dir :: args)) in
+  let input = Unix.openfile Filename.null [ Unix.O_RDONLY ] 0 in
+  let output = Unix.openfile Filename.null [ Unix.O_WRONLY ] 0 in
+  let pid = Unix.create_process "git" argv input output output in
+  let _, status = Unix.waitpid [] pid in
+  Unix.close input;
+  Unix.close output;
+  match status with
+  | Unix.WEXITED 0 -> ()
+  | _ -> Alcotest.failf "git %s failed" (String.concat " " args)
+
+let rec remove_tree path =
+  match Unix.lstat path with
+  | exception Unix.Unix_error (Unix.ENOENT, _, _) -> ()
+  | { st_kind = Unix.S_DIR; _ } ->
+      Array.iter
+        (fun entry -> remove_tree (Filename.concat path entry))
+        (Sys.readdir path);
+      Unix.rmdir path
+  | _ -> Unix.unlink path
+
+(* Temporary directories only: the git-fleet repository itself is never
+   touched by the tests. *)
+let with_dir f =
+  let dir = Filename.temp_dir "git-fleet-test" "" in
+  Fun.protect ~finally:(fun () -> remove_tree dir) (fun () -> f dir)
+
+let with_repo f =
+  with_dir (fun dir ->
+      git_exn dir [ "init"; "-q" ];
+      f dir)
+
+let with_origin f =
+  with_repo (fun cwd ->
+      git_exn cwd [ "remote"; "add"; "origin"; primary ];
+      f cwd)
+
+let add ?(name = "origin") ?(fetch = false) ?(push = false) ~cwd url =
+  let plan = ok (Plan.add ~cwd ~name ~fetch ~push ~url) in
+  ok (Plan.execute ~cwd plan);
+  plan
+
+let remove ?(name = "origin") ~cwd url =
+  let plan = ok (Plan.remove ~cwd ~name ~url) in
+  ok (Plan.execute ~cwd plan);
+  plan
+
+let explicit ?(name = "origin") cwd = ok (Git.get_explicit_push_urls ~cwd ~name)
+let effective ?(name = "origin") cwd = ok (Git.get_push_urls ~cwd ~name)
+let fetch_urls ?(name = "origin") cwd = ok (Git.get_fetch_urls ~cwd ~name)
+
+let test_not_a_repository () =
+  with_dir (fun dir ->
+      Alcotest.(check bool) "outside a work tree" false (Git.is_repository ~cwd:dir))
+
+let test_empty_repository () =
+  with_repo (fun cwd ->
+      Alcotest.(check bool) "inside a work tree" true (Git.is_repository ~cwd);
+      Alcotest.(check urls) "no remotes" [] (ok (Git.remotes ~cwd)))
+
+let test_create_origin () =
+  with_repo (fun cwd ->
+      let plan = add ~cwd primary in
+      Alcotest.(check int) "one action" 1 (List.length plan);
+      Alcotest.(check urls) "remotes" [ "origin" ] (ok (Git.remotes ~cwd));
+      Alcotest.(check urls) "fetch" [ primary ] (fetch_urls cwd);
+      Alcotest.(check urls) "effective push" [ primary ] (effective cwd);
+      Alcotest.(check urls) "no explicit push" [] (explicit cwd))
+
+let test_custom_remote_name () =
+  with_repo (fun cwd ->
+      ignore (add ~cwd ~name:"upstream" primary);
+      Alcotest.(check urls) "remotes" [ "upstream" ] (ok (Git.remotes ~cwd));
+      Alcotest.(check urls) "fetch" [ primary ] (fetch_urls ~name:"upstream" cwd))
+
+let test_change_fetch_url () =
+  with_origin (fun cwd ->
+      ignore (add ~cwd ~fetch:true backup);
+      Alcotest.(check urls) "fetch" [ backup ] (fetch_urls cwd);
+      Alcotest.(check urls) "no explicit push" [] (explicit cwd);
+      Alcotest.(check urls) "push follows fetch" [ backup ] (effective cwd))
+
+let test_first_push_url_preserves_implicit () =
+  with_origin (fun cwd ->
+      ignore (add ~cwd github);
+      Alcotest.(check urls)
+        "implicit destination kept first" [ primary; github ] (explicit cwd);
+      Alcotest.(check urls) "effective push" [ primary; github ] (effective cwd);
+      Alcotest.(check urls) "fetch unchanged" [ primary ] (fetch_urls cwd))
+
+let test_add_second_push_url () =
+  with_origin (fun cwd ->
+      ignore (add ~cwd github);
+      ignore (add ~cwd backup);
+      Alcotest.(check urls)
+        "three destinations" [ primary; github; backup ] (explicit cwd))
+
+let test_duplicate_push_url_is_idempotent () =
+  with_origin (fun cwd ->
+      ignore (add ~cwd github);
+      let before = explicit cwd in
+      let plan = add ~cwd github in
+      Alcotest.(check int) "nothing planned" 0 (List.length plan);
+      Alcotest.(check urls) "configuration unchanged" before (explicit cwd))
+
+let test_implicit_destination_is_idempotent () =
+  with_origin (fun cwd ->
+      let plan = add ~cwd primary in
+      Alcotest.(check int) "nothing planned" 0 (List.length plan);
+      Alcotest.(check urls) "still implicit" [] (explicit cwd))
+
+let test_remove_push_url () =
+  with_origin (fun cwd ->
+      ignore (add ~cwd github);
+      ignore (add ~cwd backup);
+      ignore (remove ~cwd github);
+      Alcotest.(check urls) "order preserved" [ primary; backup ] (explicit cwd);
+      Alcotest.(check urls) "fetch unchanged" [ primary ] (fetch_urls cwd))
+
+let test_remove_collapses_to_implicit () =
+  with_origin (fun cwd ->
+      ignore (add ~cwd github);
+      ignore (remove ~cwd github);
+      Alcotest.(check urls) "redundant entry removed" [] (explicit cwd);
+      Alcotest.(check urls) "pushes where it fetches" [ primary ] (effective cwd))
+
+let test_remove_unknown_url () =
+  with_origin (fun cwd ->
+      ignore (add ~cwd github);
+      match error (Plan.remove ~cwd ~name:"origin" ~url:backup) with
+      | Git.Not_a_push_destination { remote = "origin"; url } ->
+          Alcotest.(check string) "reported url" backup url
+      | other -> Alcotest.failf "unexpected error: %s" (Git.string_of_error other))
+
+let test_remove_implicit_destination () =
+  with_origin (fun cwd ->
+      match error (Plan.remove ~cwd ~name:"origin" ~url:primary) with
+      | Git.Implicit_push_destination { remote = "origin"; url } ->
+          Alcotest.(check string) "reported url" primary url
+      | other -> Alcotest.failf "unexpected error: %s" (Git.string_of_error other))
+
+let test_unknown_remote () =
+  with_origin (fun cwd ->
+      Alcotest.(check bool)
+        "remote_exists" false
+        (ok (Git.remote_exists ~cwd ~name:"upstream"));
+      match error (Git.remote ~cwd ~name:"upstream") with
+      | Git.No_such_remote name -> Alcotest.(check string) "name" "upstream" name
+      | other -> Alcotest.failf "unexpected error: %s" (Git.string_of_error other))
+
+let test_planning_changes_nothing () =
+  with_origin (fun cwd ->
+      let plan = ok (Plan.add ~cwd ~name:"origin" ~fetch:false ~push:true ~url:github) in
+      Alcotest.(check int) "two actions planned" 2 (List.length plan);
+      Alcotest.(check urls) "no explicit push url written" [] (explicit cwd);
+      Alcotest.(check urls) "fetch untouched" [ primary ] (fetch_urls cwd);
+      Alcotest.(check (list string))
+        "equivalent git commands"
+        [
+          "git remote set-url --add --push origin " ^ primary;
+          "git remote set-url --add --push origin " ^ github;
+        ]
+        (List.map
+           (fun action -> String.concat " " (Git.command_of_action action))
+           plan))
+
+let test_status_representation () =
+  with_origin (fun cwd ->
+      ignore (add ~cwd github);
+      let remote = ok (Git.remote ~cwd ~name:"origin") in
       Alcotest.(check string)
-    "version"
+        "rendered status"
-    "0.2.0"
+        (String.concat "\n"
-    Git_fleet.Version.value
+           [
+             "origin";
+             "  fetch  " ^ primary;
+             "  push   " ^ primary;
+             "  push   " ^ github;
+           ])
+        (Cli.render_remote remote))
+
+(* A URL that would run a command, or lose its meaning, if git-fleet built
+   shell command lines out of user input. *)
+let test_hostile_url () =
+  with_repo (fun cwd ->
+      let marker = Filename.concat cwd "pwned" in
+      let hostile =
+        Printf.sprintf "ssh://git@example.invalid/a b;$(touch %s)`touch %s`.git"
+          marker marker
+      in
+      ignore (add ~cwd primary);
+      ignore (add ~cwd hostile);
+      Alcotest.(check bool) "no command was executed" false (Sys.file_exists marker);
+      Alcotest.(check urls) "stored verbatim" [ primary; hostile ] (explicit cwd);
+      ignore (remove ~cwd hostile);
+      Alcotest.(check urls) "removed exactly" [] (explicit cwd);
+      Alcotest.(check urls) "fetch url intact" [ primary ] (fetch_urls cwd))
+
+let test_version () =
+  Alcotest.(check string) "version" "0.2.0" Version.value
+
+let case name f = Alcotest.test_case name `Quick f
 
 let () =
-  Alcotest.run
+  (* Keep the developer's own Git configuration, such as url rewrites, out of
-    "git-fleet"
+     the results. *)
+  Unix.putenv "GIT_CONFIG_GLOBAL" Filename.null;
+  Unix.putenv "GIT_CONFIG_SYSTEM" Filename.null;
+  Alcotest.run "git-fleet"
     [
-      ( "version",
+      ( "repository",
         [
-          Alcotest.test_case
+          case "outside a repository" test_not_a_repository;
-            "reports 0.2.0"
+          case "empty repository" test_empty_repository;
-            `Quick
+          case "unknown remote" test_unknown_remote;
-            test_version;
         ] );
+      ( "fetch urls",
+        [
+          case "creates origin" test_create_origin;
+          case "custom remote name" test_custom_remote_name;
+          case "changes the fetch url" test_change_fetch_url;
+        ] );
+      ( "push destinations",
+        [
+          case "first push url preserves the implicit one"
+            test_first_push_url_preserves_implicit;
+          case "adds a second push url" test_add_second_push_url;
+          case "duplicate push url is idempotent" test_duplicate_push_url_is_idempotent;
+          case "implicit destination is idempotent" test_implicit_destination_is_idempotent;
+          case "removes a push url" test_remove_push_url;
+          case "collapses to implicit push" test_remove_collapses_to_implicit;
+          case "removing an unconfigured url fails" test_remove_unknown_url;
+          case "removing the implicit destination fails" test_remove_implicit_destination;
+          case "urls are never interpreted by a shell" test_hostile_url;
+        ] );
+      ( "planning",
+        [ case "planning does not touch the repository" test_planning_changes_nothing ] );
+      ( "status", [ case "renders a remote" test_status_representation ] );
+      ( "version", [ case "reports 0.2.0" test_version ] );
     ]