Something went wrong. Try again.
A local Git merge queue with content-bound gate verdicts
Something went wrong. Try again.
8.0 kB · 183 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184(** Check results, as the lines of a Git note.
A check result is a fact about a tree: check [test] passed on tree T, under build configuration K and rules R, on platform P and machine M (doc/machines.md, "Check results name the trees they are about"). The platform is a field of the result, never part of K: what a check requires of it is {!Results.verdict}'s. Results are Git notes on the tree under [refs/notes/mq-checks], one line per result, so [git notes --ref=mq-checks show COMMIT^{tree}] prints them without mq (doc/rules.md, rule 2).
A line reads, with one space between fields:
{v mq2 passed pre-commit tree=<T> attempt=1 config=<K> rules=<R> machine=laptop platform=Darwin/arm64 mode=self confined=seatbelt seconds=12 at=2026-10-01T12:00:00Z log=<sha256> v}
[mq2] is the schema of the line; a reader that does not know a line's schema counts it as no result. A line of [mq1], the schema whose K covered the platform, is no result either, and is read no further. The result and the check's name follow, then [key=value] fields in this order: the tree the result is about, the run's attempt, the build configuration, the commit of the rules that judged the tree, the machine that ran the check, the platform it ran on as {!Platform_name.to_field} writes it, whether a land in its caller's process ([self]) or a scheduler-started run ([scheduled]) ran it, the mechanism that confined the check or [no] when it ran unconfined (doc/trust.md, "How a check is confined"), the seconds it took, when it ended in RFC 3339 UTC, and the SHA-256 of its log when it wrote one.
A line survives a union merge ([git notes merge -s cat_sort_uniq]): each line is a whole result that refers to no other line and to no position, so the sorted union of two notes, with duplicates removed, is again a note that holds every result of both. A result is added and never edited; the same fact recorded twice is one line. *)
(** The type for who ran a check: a land in its caller's process, or a run the scheduler started. A scheduler-started run reuses only results a scheduler-started run made. *)type mode = Self | Scheduled
type t = private { result : Check.result; check : Check.name; tree : Tree.t; (** The tree the result is about: a line read from the note of another tree is no result there ({!Results.of_notes}). *) attempt : int; (** The run's attempt in its land, from [1]. *) config : Build_config.t; rules : Commit.t; (** The commit of the rules that judged the tree. *) machine : Host.t; (** The machine that ran the check. *) platform : Platform_name.t; (** The platform the check ran on. *) mode : mode; confined : Confinement.mechanism option; (** What confined the check, or [None] when it ran unconfined. *) seconds : Duration.t; (** How long the run took. *) at : Ptime.t; (** When the run ended. *) log : string option; (** The hex SHA-256 of the run's log. *)}(** The type for results. *)
val v : result:Check.result -> check:Check.name -> tree:Tree.t -> attempt:int -> config:Build_config.t -> rules:Commit.t -> machine:Host.t -> platform:Platform_name.t -> mode:mode -> confined:Confinement.mechanism option -> seconds:Duration.t -> at:Ptime.t -> ?log:string -> unit -> (t, [ `Msg of string ]) result(** [v ~result ~check ~tree ~config ~rules ~machine ~platform ~mode ~confined ~seconds ~at ?log ()] is a result, or why it cannot be written as a line: an [attempt] below [1], or a [log] that is not 64 lowercase hexadecimal digits. The machine's name and the seconds are valid by their types. *)
val schema : string(** [schema] is the schema word that starts every line this module writes, [mq2]. *)
val to_line : t -> string(** [to_line r] is [r] as one line, without a newline. *)
val of_line : string -> (t, [ `Msg of string | `Schema of string ]) result(** [of_line s] reads what {!to_line} writes. It is [`Schema w] when [s] starts with a word [w] other than {!schema}, and [`Msg] when a line of this schema is malformed, an unknown field included. *)
val of_earlier : string -> bool(** [of_earlier s] is [true] iff [s] is a line of a schema {!schema} replaced, [mq1]: no result, read no further. *)
val upgrade : machine:Host.t -> platform:Platform_name.t -> string -> (string option, [ `Msg of string ]) result(** [upgrade ~machine ~platform s] is the {!schema} line of the [mq1] line [s], which a result of [machine] wrote: its fields with [platform] after the machine. It is [None] when [s] is no [mq1] line, and an error naming the line when [s] names another machine, whose platform this one cannot know, or does not read as a result once upgraded. *)
(** {1:forgotten Forgotten results}
[mq forget] sets stored results aside without editing a line: it adds one that names the check, or [*] for every check, the tree, the machine that wrote it, when, the hex SHA-256 of each result line it sets aside, and the reason when one was given, the rest of the line:
{v mq2 forgot suite tree=<T> machine=laptop at=2026-10-01T12:00:00Z results=<sha256>,<sha256> reason=its build directory was stale v}
The results it names no longer count, whatever their build configuration or mode, so the next land or probe of the tree runs the check again; every other result counts, one recorded after the line included, whatever the clock says. It survives a union merge as any line does. *)
type forgotten(** The type for a line that sets results aside. *)
val forgotten : ?check:Check.name -> ?reason:string -> tree:Tree.t -> machine:Host.t -> at:Ptime.t -> t list -> forgotten(** [forgotten ?check ?reason ~tree ~machine ~at rs] sets aside the results of [rs] about [check] on [tree], of every check when [check] is absent. [reason] is put on one line ({!Outcome.line}); an empty one is none. *)
val forgotten_count : forgotten -> int(** [forgotten_count f] is the number of results [f] sets aside. *)
val forgotten_line : forgotten -> string(** [forgotten_line f] is [f] as one line, without a newline. *)
val forgotten_message : forgotten -> string(** [forgotten_message f] is the message of the commit on [refs/notes/mq-checks] that adds [f]: [mq: check results forgotten], an empty line, and [f] as a line. *)
val of_note : string -> t list * string list(** [of_note text] is the results of the note [text], one a line, less those a {{!forgotten}[forgot] line} of [text] sets aside, and the non-empty lines it could not read. Empty lines and the lines of an earlier schema are skipped.*)
val only_about : Tree.t -> string -> (unit, [ `Msg of string ]) result(** [only_about tree text] is [Ok ()] iff every non-empty line of the note [text] is a result or a {{!forgotten}[forgot] line} about [tree]: what a note of [tree] written by another machine must hold before its lines join this machine's; a line of an earlier schema is no result and is kept as it is. It names the first line that is neither, or that is about another tree, by its position. *)
val union : t list -> string(** [union rs] is the note holding [rs]: their lines sorted bytewise, duplicates removed, each ending with a newline, which is what [cat_sort_uniq] leaves.*)
val commit_message : t -> string(** [commit_message r] is the message of the commit on [refs/notes/mq-checks] that adds [r]: [mq: a check result], an empty line, and [r] as a line, so [git log refs/notes/mq-checks] reads as the record of each result added. *)
val is_commit_message : string -> bool(** [is_commit_message m] is [true] iff [m] is a message {!commit_message} writes: its first line is [mq: a check result]. *)
val equal : t -> t -> bool(** [equal a b] is [true] iff [a] and [b] are the same line. *)
val pp : t Fmt.t(** [pp] formats a result as its line. *)