forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
s3: MinIO interop tests on committed ListObjectsV2 traces
Follows the monorepo's interop-testing pattern (same layout as the
boto3 generator under ocaml-s3/test/interop/boto3):
- scripts/generate.sh boots a pinned MinIO container, scripts/generate.py
populates a known bucket via boto3 and dumps raw ListObjectsV2 XML
responses (signed via SigV4) to ../traces/.
- traces/list_simple.xml: three objects under a prefix, not truncated.
- traces/list_truncated.xml: same prefix but max-keys=2, which forces
NextContinuationToken — exercises the pagination branch of our
parser end-to-end against real MinIO output.
- test.ml reads the committed XML and verifies the parsed listing
(keys, sizes, next_token). No network or docker needed at test time;
`dune runtest` passes from the traces alone.
Regenerate via `dune build @regen-traces` when MinIO changes response
shapes. Exposes S3.Http.parse_list_response so the test can exercise
the XML codec without a live HTTP round-trip.
+197
-168
+12
-10
bin/cmd_clean.ml
+12
-10
bin/cmd_clean.ml
···
1
1
open Cmdliner
2
2
3
+
let run_clean ~sw ~proc ~fs ~config ~dry_run ~force =
4
+
match Monopam.Clean.run ~sw ~proc ~fs ~config ~dry_run ~force () with
5
+
| Ok () -> `Ok ()
6
+
| Error e -> Common.fail_ctx e
7
+
8
+
let run dry_run force () =
9
+
Eio_main.run @@ fun env ->
10
+
Common.with_config env @@ fun config ->
11
+
let fs = Eio.Stdenv.fs env in
12
+
let proc = Eio.Stdenv.process_mgr env in
13
+
Eio.Switch.run @@ fun sw -> run_clean ~sw ~proc ~fs ~config ~dry_run ~force
14
+
3
15
let cmd =
4
16
let doc = "Remove empty commits from history" in
5
17
let man =
···
32
44
let force_arg =
33
45
let doc = "Force-push cleaned checkouts to upstream remotes." in
34
46
Arg.(value & flag & info [ "force"; "f" ] ~doc)
35
-
in
36
-
let run dry_run force () =
37
-
Eio_main.run @@ fun env ->
38
-
Common.with_config env @@ fun config ->
39
-
let fs = Eio.Stdenv.fs env in
40
-
let proc = Eio.Stdenv.process_mgr env in
41
-
Eio.Switch.run @@ fun sw ->
42
-
match Monopam.Clean.run ~sw ~proc ~fs ~config ~dry_run ~force () with
43
-
| Ok () -> `Ok ()
44
-
| Error e -> Common.fail_ctx e
45
47
in
46
48
Cmd.v info
47
49
Term.(ret (const run $ dry_run_arg $ force_arg $ Common.logging_term))
+36
-31
bin/cmd_diff.ml
+36
-31
bin/cmd_diff.ml
···
27
27
| Error _ -> false
28
28
else false
29
29
30
+
let filter_statuses ~packages statuses =
31
+
match packages with
32
+
| [] -> statuses
33
+
| names ->
34
+
List.filter
35
+
(fun s ->
36
+
List.mem (Monopam.Package.name s.Monopam.Status.package) names)
37
+
statuses
38
+
39
+
let report_no_packages packages =
40
+
(match packages with
41
+
| [] -> Fmt.epr "No packages found@."
42
+
| names ->
43
+
Fmt.epr "Package%s not found: %s@."
44
+
(if List.length names = 1 then "" else "s")
45
+
(String.concat ", " names));
46
+
`Error (false, "no packages")
47
+
48
+
let report_diffs ~sw ~fs ~config ~incoming statuses =
49
+
let has_diff =
50
+
List.exists
51
+
(fun status -> print_diff ~sw ~fs ~config status incoming)
52
+
statuses
53
+
in
54
+
if not has_diff then Fmt.pr "No differences.@.";
55
+
`Ok ()
56
+
57
+
let run_diff ~sw ~fs ~config ~packages ~incoming =
58
+
match Monopam.status ~sw ~fs:(fs :> Eio.Fs.dir_ty Eio.Path.t) ~config () with
59
+
| Error e -> Common.fail_ctx e
60
+
| Ok statuses ->
61
+
let statuses = filter_statuses ~packages statuses in
62
+
if statuses = [] then report_no_packages packages
63
+
else report_diffs ~sw ~fs ~config ~incoming statuses
64
+
30
65
let run packages incoming () =
31
66
Eio_main.run @@ fun env ->
32
67
Common.with_config env @@ fun config ->
33
68
let fs = Eio.Stdenv.fs env in
34
-
Eio.Switch.run @@ fun sw ->
35
-
match Monopam.status ~sw ~fs:(fs :> Eio.Fs.dir_ty Eio.Path.t) ~config () with
36
-
| Error e -> Common.fail_ctx e
37
-
| Ok statuses ->
38
-
let statuses =
39
-
match packages with
40
-
| [] -> statuses
41
-
| names ->
42
-
List.filter
43
-
(fun s ->
44
-
List.mem (Monopam.Package.name s.Monopam.Status.package) names)
45
-
statuses
46
-
in
47
-
if statuses = [] then begin
48
-
(match packages with
49
-
| [] -> Fmt.epr "No packages found@."
50
-
| names ->
51
-
Fmt.epr "Package%s not found: %s@."
52
-
(if List.length names = 1 then "" else "s")
53
-
(String.concat ", " names));
54
-
`Error (false, "no packages")
55
-
end
56
-
else begin
57
-
let has_diff =
58
-
List.exists
59
-
(fun status -> print_diff ~sw ~fs ~config status incoming)
60
-
statuses
61
-
in
62
-
if not has_diff then Fmt.pr "No differences.@.";
63
-
`Ok ()
64
-
end
69
+
Eio.Switch.run @@ fun sw -> run_diff ~sw ~fs ~config ~packages ~incoming
65
70
66
71
let cmd =
67
72
let doc = "Show diff between monorepo and upstream" in
+25
-22
bin/cmd_fetch.ml
+25
-22
bin/cmd_fetch.ml
···
40
40
Fmt.pr ".@.";
41
41
Fmt.pr "@.Run $(b,monopam diff --incoming) to see changes.@."
42
42
43
+
let filter_by_package ~package statuses =
44
+
match package with
45
+
| Some name ->
46
+
List.filter
47
+
(fun s -> Monopam.Package.name s.Monopam.Status.package = name)
48
+
statuses
49
+
| None -> statuses
50
+
51
+
let report_no_match package =
52
+
(match package with
53
+
| Some name -> Fmt.epr "Package not found: %s@." name
54
+
| None -> Fmt.epr "No packages found@.");
55
+
`Error (false, "no packages")
56
+
57
+
let run_fetch ~sw ~proc ~fs ~config ~package =
58
+
match Monopam.Ctx.status ~sw ~fs ~config () with
59
+
| Error e -> Common.fail_ctx e
60
+
| Ok statuses -> (
61
+
match filter_by_package ~package statuses with
62
+
| [] -> report_no_match package
63
+
| matching ->
64
+
fetch_repos ~proc ~fs ~config matching;
65
+
`Ok ())
66
+
43
67
let run package () =
44
68
Eio_main.run @@ fun env ->
45
69
Common.with_config env @@ fun config ->
46
70
let fs = Eio.Stdenv.fs env in
47
71
let proc = Eio.Stdenv.process_mgr env in
48
-
Eio.Switch.run @@ fun sw ->
49
-
match Monopam.Ctx.status ~sw ~fs ~config () with
50
-
| Error e -> Common.fail_ctx e
51
-
| Ok statuses ->
52
-
let statuses =
53
-
match package with
54
-
| Some name ->
55
-
List.filter
56
-
(fun s -> Monopam.Package.name s.Monopam.Status.package = name)
57
-
statuses
58
-
| None -> statuses
59
-
in
60
-
if statuses = [] then begin
61
-
(match package with
62
-
| Some name -> Fmt.epr "Package not found: %s@." name
63
-
| None -> Fmt.epr "No packages found@.");
64
-
`Error (false, "no packages")
65
-
end
66
-
else begin
67
-
fetch_repos ~proc ~fs ~config statuses;
68
-
`Ok ()
69
-
end
72
+
Eio.Switch.run @@ fun sw -> run_fetch ~sw ~proc ~fs ~config ~package
70
73
71
74
let cmd =
72
75
let doc = "Fetch changes from upstream without merging" in
+60
-55
bin/cmd_pull.ml
+60
-55
bin/cmd_pull.ml
···
32
32
Fmt.epr "monopam: unknown MONOPAM_AUTO=%S, falling back to claude@." other;
33
33
`Claude
34
34
35
+
let client_for ~sw ~proc ~clock = function
36
+
| `Ours -> Monopam.Auto_resolve.ours_client
37
+
| `Theirs -> Monopam.Auto_resolve.theirs_client
38
+
| `Union -> Monopam.Auto_resolve.union_client
39
+
| `Claude -> Monopam.Auto_resolve.claude_client ~sw ~process_mgr:proc ~clock
40
+
41
+
let always_accept_for ~auto_yes = function
42
+
| `Ours | `Theirs | `Union -> true
43
+
| `Claude -> auto_yes
44
+
45
+
let prompt_user (proposal : Monopam.Auto_resolve.proposal) =
46
+
Fmt.pr "@.Proposed resolution:@.";
47
+
Fmt.pr " ours: %s@." proposal.ours_summary;
48
+
Fmt.pr " theirs: %s@." proposal.theirs_summary;
49
+
Fmt.pr " rationale: %s@." proposal.rationale;
50
+
Fmt.pr "Apply? [y/N] @?";
51
+
match read_line () with
52
+
| exception End_of_file -> false
53
+
| s ->
54
+
let s = String.lowercase_ascii (String.trim s) in
55
+
s = "y" || s = "yes"
56
+
57
+
let confirm_fn ~always_accept proposal =
58
+
if not always_accept then prompt_user proposal
59
+
else begin
60
+
Fmt.pr " → %s@." proposal.Monopam.Auto_resolve.rationale;
61
+
true
62
+
end
63
+
64
+
let auto_options ~sw ~proc ~clock ~auto ~auto_yes =
65
+
if not auto then None
66
+
else
67
+
let strategy = strategy_from_env () in
68
+
let client = client_for ~sw ~proc ~clock strategy in
69
+
let always_accept = always_accept_for ~auto_yes strategy in
70
+
let confirm = confirm_fn ~always_accept in
71
+
Some Monopam.Pull.{ client; confirm }
72
+
73
+
let run_pull ~sw ~clock ~proc ~fs ~config ~packages ~auto ~auto_yes ~t0 =
74
+
let auto_opts = auto_options ~sw ~proc ~clock ~auto ~auto_yes in
75
+
match
76
+
Monopam.Pull.run ~sw ~clock ~proc ~fs ~config ~packages ?auto:auto_opts ()
77
+
with
78
+
| Error e -> Common.fail_ctx e
79
+
| Ok () ->
80
+
let elapsed = Unix.gettimeofday () -. t0 in
81
+
Common.print_success ~elapsed ~next_step:"dune build && dune test"
82
+
"Monorepo updated.";
83
+
`Ok ()
84
+
85
+
let run packages auto auto_yes () =
86
+
let t0 = Unix.gettimeofday () in
87
+
Eio_main.run @@ fun env ->
88
+
Common.with_config env @@ fun config ->
89
+
let fs = Eio.Stdenv.fs env in
90
+
let proc = Eio.Stdenv.process_mgr env in
91
+
let clock = Eio.Stdenv.clock env in
92
+
Eio.Switch.run @@ fun sw ->
93
+
run_pull ~sw ~clock ~proc ~fs ~config ~packages ~auto ~auto_yes ~t0
94
+
35
95
let cmd =
36
96
let doc = "Pull changes from upstream repositories" in
37
97
let man =
···
73
133
]
74
134
in
75
135
let info = Cmd.info "pull" ~doc ~man in
76
-
let run packages auto auto_yes () =
77
-
let t0 = Unix.gettimeofday () in
78
-
Eio_main.run @@ fun env ->
79
-
Common.with_config env @@ fun config ->
80
-
let fs = Eio.Stdenv.fs env in
81
-
let proc = Eio.Stdenv.process_mgr env in
82
-
let clock = Eio.Stdenv.clock env in
83
-
Eio.Switch.run @@ fun sw ->
84
-
let auto_opts =
85
-
if not auto then None
86
-
else
87
-
let strategy = strategy_from_env () in
88
-
let client =
89
-
match strategy with
90
-
| `Ours -> Monopam.Auto_resolve.ours_client
91
-
| `Theirs -> Monopam.Auto_resolve.theirs_client
92
-
| `Union -> Monopam.Auto_resolve.union_client
93
-
| `Claude ->
94
-
Monopam.Auto_resolve.claude_client ~sw ~process_mgr:proc ~clock
95
-
in
96
-
let always_accept =
97
-
match strategy with
98
-
| `Ours | `Theirs | `Union -> true
99
-
| `Claude -> auto_yes
100
-
in
101
-
let confirm (proposal : Monopam.Auto_resolve.proposal) =
102
-
if always_accept then begin
103
-
Fmt.pr " → %s@." proposal.rationale;
104
-
true
105
-
end
106
-
else begin
107
-
Fmt.pr "@.Proposed resolution:@.";
108
-
Fmt.pr " ours: %s@." proposal.ours_summary;
109
-
Fmt.pr " theirs: %s@." proposal.theirs_summary;
110
-
Fmt.pr " rationale: %s@." proposal.rationale;
111
-
Fmt.pr "Apply? [y/N] @?";
112
-
match read_line () with
113
-
| exception End_of_file -> false
114
-
| s ->
115
-
let s = String.lowercase_ascii (String.trim s) in
116
-
s = "y" || s = "yes"
117
-
end
118
-
in
119
-
Some Monopam.Pull.{ client; confirm }
120
-
in
121
-
match
122
-
Monopam.Pull.run ~sw ~clock ~proc ~fs ~config ~packages ?auto:auto_opts ()
123
-
with
124
-
| Ok () ->
125
-
let elapsed = Unix.gettimeofday () -. t0 in
126
-
Common.print_success ~elapsed ~next_step:"dune build && dune test"
127
-
"Monorepo updated.";
128
-
`Ok ()
129
-
| Error e -> Common.fail_ctx e
130
-
in
131
136
Cmd.v info
132
137
Term.(
133
138
ret
+19
-15
bin/cmd_push.ml
+19
-15
bin/cmd_push.ml
···
89
89
in
90
90
Arg.(value & flag & info [ "force" ] ~doc)
91
91
92
-
let run packages ~local_only ~clean ~force () =
93
-
let t0 = Unix.gettimeofday () in
94
-
Eio_main.run @@ fun env ->
95
-
Common.with_config env @@ fun config ->
96
-
let fs = Eio.Stdenv.fs env in
97
-
let proc = Eio.Stdenv.process_mgr env in
98
-
let clock = Eio.Stdenv.clock env in
99
-
Eio.Switch.run @@ fun sw ->
92
+
let success_message ~local_only =
93
+
if local_only then
94
+
("Changes exported to checkouts.", "monopam push # to send to your remotes")
95
+
else ("Changes pushed to your remotes.", "monopam status")
96
+
97
+
let run_push ~sw ~clock ~proc ~fs ~config ~packages ~local_only ~clean ~force
98
+
~t0 =
100
99
match
101
100
Monopam.Push.run ~sw ~clock ~proc ~fs ~config ~packages
102
101
~upstream:(not local_only) ~clean ~force ()
103
102
with
103
+
| Error e -> Common.fail_ctx e
104
104
| Ok () ->
105
105
let elapsed = Unix.gettimeofday () -. t0 in
106
-
let msg, next =
107
-
if local_only then
108
-
( "Changes exported to checkouts.",
109
-
"monopam push # to send to your remotes" )
110
-
else ("Changes pushed to your remotes.", "monopam status")
111
-
in
106
+
let msg, next = success_message ~local_only in
112
107
Common.print_success ~elapsed ~next_step:next msg;
113
108
`Ok ()
114
-
| Error e -> Common.fail_ctx e
109
+
110
+
let run packages ~local_only ~clean ~force () =
111
+
let t0 = Unix.gettimeofday () in
112
+
Eio_main.run @@ fun env ->
113
+
Common.with_config env @@ fun config ->
114
+
let fs = Eio.Stdenv.fs env in
115
+
let proc = Eio.Stdenv.process_mgr env in
116
+
let clock = Eio.Stdenv.clock env in
117
+
Eio.Switch.run @@ fun sw ->
118
+
run_push ~sw ~clock ~proc ~fs ~config ~packages ~local_only ~clean ~force ~t0
115
119
116
120
let cmd =
117
121
let doc = "Push local changes to your configured remotes" in
+45
-35
bin/cmd_status.ml
+45
-35
bin/cmd_status.ml
···
93
93
if forks.repos <> [] then
94
94
Fmt.pr "%a" (Monopam.Forks.pp_summary' ~show_all) forks
95
95
96
+
let print_unregistered_block ~fs ~config =
97
+
match Monopam.discover_packages ~fs ~config () with
98
+
| Ok pkgs -> print_unregistered ~fs ~config pkgs
99
+
| Error _ -> ()
100
+
101
+
let print_unpublished_block ~fs ~config =
102
+
let pub = Monopam.Opam_sync.check_publish_status ~fs ~config () in
103
+
if pub.not_in_repo = [] && pub.unpublished = [] then ()
104
+
else begin
105
+
let total = List.length pub.not_in_repo + List.length pub.unpublished in
106
+
Fmt.pr "%a %a\n"
107
+
Fmt.(styled `Bold string)
108
+
"Unpublished:"
109
+
Fmt.(styled `Yellow int)
110
+
total;
111
+
List.iter
112
+
(fun name ->
113
+
Fmt.pr " %-22s %a\n" name
114
+
Fmt.(styled `Faint string)
115
+
"(not in opam-repo)")
116
+
pub.not_in_repo;
117
+
List.iter
118
+
(fun name ->
119
+
Fmt.pr " %-22s %a\n" name Fmt.(styled `Faint string) "(opam changed)")
120
+
pub.unpublished
121
+
end
122
+
123
+
let print_status_table ~fs ~config statuses =
124
+
let sources = load_sources ~fs ~config in
125
+
let pp =
126
+
if Tty.is_tty () then Monopam.Status.pp_table else Monopam.Status.pp_summary
127
+
in
128
+
Fmt.pr "%a" (pp ?sources) statuses
129
+
130
+
let run_status ~sw ~proc ~fs ~config ~show_all ~show_forks =
131
+
match Monopam.status ~sw ~fs ~config () with
132
+
| Error e -> Common.fail_ctx e
133
+
| Ok statuses ->
134
+
print_status_table ~fs ~config statuses;
135
+
print_unregistered_block ~fs ~config;
136
+
print_unpublished_block ~fs ~config;
137
+
if show_forks then print_forks ~sw ~proc ~fs ~config ~show_all;
138
+
`Ok ()
139
+
96
140
let run ~show_all ~show_forks () =
97
141
Eio_main.run @@ fun env ->
98
142
Common.with_config env @@ fun config ->
99
143
let fs = Eio.Stdenv.fs env in
100
144
let proc = Eio.Stdenv.process_mgr env in
101
145
Eio.Switch.run @@ fun sw ->
102
-
match Monopam.status ~sw ~fs ~config () with
103
-
| Ok statuses ->
104
-
let sources = load_sources ~fs ~config in
105
-
let pp =
106
-
if Tty.is_tty () then Monopam.Status.pp_table
107
-
else Monopam.Status.pp_summary
108
-
in
109
-
Fmt.pr "%a" (pp ?sources) statuses;
110
-
(match Monopam.discover_packages ~fs ~config () with
111
-
| Ok pkgs -> print_unregistered ~fs ~config pkgs
112
-
| Error _ -> ());
113
-
let pub = Monopam.Opam_sync.check_publish_status ~fs ~config () in
114
-
if pub.not_in_repo <> [] || pub.unpublished <> [] then begin
115
-
let total = List.length pub.not_in_repo + List.length pub.unpublished in
116
-
Fmt.pr "%a %a\n"
117
-
Fmt.(styled `Bold string)
118
-
"Unpublished:"
119
-
Fmt.(styled `Yellow int)
120
-
total;
121
-
List.iter
122
-
(fun name ->
123
-
Fmt.pr " %-22s %a\n" name
124
-
Fmt.(styled `Faint string)
125
-
"(not in opam-repo)")
126
-
pub.not_in_repo;
127
-
List.iter
128
-
(fun name ->
129
-
Fmt.pr " %-22s %a\n" name
130
-
Fmt.(styled `Faint string)
131
-
"(opam changed)")
132
-
pub.unpublished
133
-
end;
134
-
if show_forks then print_forks ~sw ~proc ~fs ~config ~show_all;
135
-
`Ok ()
136
-
| Error e -> Common.fail_ctx e
146
+
run_status ~sw ~proc ~fs ~config ~show_all ~show_forks
137
147
138
148
let cmd =
139
149
let doc = "Show synchronization status of all packages" in