diff --git a/dune-project b/dune-project index 934cd1cf..e326d6a9 100644 --- a/dune-project +++ b/dune-project @@ -50,9 +50,9 @@ (extlib (>= 1.7.8)) (lwt - (>= 5.7.0)) + (and (>= 5.7.0) (< 6.0.0))) (lwt_ppx - (>= 2.0.0)) + (and (>= 5.7.0) (< 6.0.0))) (ptime (>= 1.2.0)) (ocamldiff @@ -61,8 +61,7 @@ (>= 5.1.0)) (sqlgg (>= 20231201)) - (re2 - (>= 0.16.0)) + re uri (omd (< 2)) diff --git a/lib/action.ml b/lib/action.ml index eb96fd36..5fbec66b 100644 --- a/lib/action.ml +++ b/lib/action.ml @@ -31,13 +31,13 @@ let try_process_notification body n = Lwt.return_unit module Action (Github_api : Api.Github) (Slack_api : Api.Slack) (Buildkite_api : Api.Buildkite) = struct - let canonical_regex = Re2.create_exn {|\.|\-|\+.*|@.*|} + let canonical_regex = Re.Perl.compile_pat {|\.|\-|\+.*|@.*|} (* Match email domain, everything after '+', as well as dots and hyphens *) let username_to_slack_id_tbl = Stringtbl.empty () let canonicalize_email_username email = - email |> Re2.rewrite_exn ~template:"" canonical_regex |> String.lowercase_ascii + email |> Re.replace_string ~all:true canonical_regex ~by:"" |> String.lowercase_ascii let refresh_username_to_slack_id_tbl ~ctx = log#info "updating github to slack username mapping"; diff --git a/lib/api_local.ml b/lib/api_local.ml index 401927cb..4cc27353 100644 --- a/lib/api_local.ml +++ b/lib/api_local.ml @@ -241,9 +241,11 @@ module Buildkite : Api.Buildkite = struct match job.log_url with | None -> Lwt.return_error "Unable to get job log, job has no log_url field" | Some log_url -> - match Re2.find_submatches_exn Util.Build.buildkite_api_org_pipeline_build_job_re log_url with - | exception exn -> Exn.fail ~exn "failed to parse buildkite build url %s" log_url - | [| Some _; Some org; Some pipeline; Some build_nr; Some job_nbr |] -> + match Re.exec_opt Util.Build.buildkite_api_org_pipeline_build_job_re log_url with + | None -> Exn.fail "failed to parse buildkite build url %s" log_url + | Some g -> + match Re.Group.(get_opt g 1, get_opt g 2, get_opt g 3, get_opt g 4) with + | Some org, Some pipeline, Some build_nr, Some job_nbr -> let file = clean_forward_slashes (sprintf "organizations/%s/pipelines/%s/builds/%s/jobs/%s/logs" org pipeline build_nr job_nbr) diff --git a/lib/api_remote.ml b/lib/api_remote.ml index 5e50c2a2..bcb4b3d1 100644 --- a/lib/api_remote.ml +++ b/lib/api_remote.ml @@ -107,7 +107,7 @@ module Github : Api.Github = struct | "base64" -> begin try response.content - |> Re2.rewrite_exn (Re2.create_exn "\n") ~template:"" + |> Re.replace_string ~all:true (Re.Perl.compile_pat "\n") ~by:"" |> decode_string_pad |> Config_j.config_of_string |> fun res -> Lwt.return @@ Ok res diff --git a/lib/common.ml b/lib/common.ml index 5ce87d4f..82ce0346 100644 --- a/lib/common.ml +++ b/lib/common.ml @@ -166,9 +166,11 @@ module Stringtbl = struct let unwrap = to_list end -module Re2 = struct - include Re2 +module Regex = struct + type t = string * Re.re - let wrap s = create_exn s - let unwrap = Re2.to_string + let wrap s = s, Re.Perl.compile_pat s + let unwrap (s, _) = s + + let matches (_, re) s = Re.execp re s end diff --git a/lib/dune b/lib/dune index 39e002a2..ff44b50f 100644 --- a/lib/dune +++ b/lib/dune @@ -17,7 +17,7 @@ omd ptime ptime.clock - re2 + re sexplib0 sqlgg.sqlite3 sqlgg.traits diff --git a/lib/github.ml b/lib/github.ml index 382c46f6..3cbe725d 100644 --- a/lib/github.ml +++ b/lib/github.ml @@ -34,7 +34,8 @@ let event_of_filename filename = | [ kind; _; "json" ] -> Some kind | _ -> None -let merge_commit_re = Re2.create_exn {|^Merge(?: remote-tracking)? branch '(?:origin/)?(.+)'(?: of [^ ]+)?( into .+)?$|} +let merge_commit_re = + Re.Perl.compile_pat {|^Merge(?: remote-tracking)? branch '(?:origin/)?(.+)'(?: of [^ ]+)?( into .+)?$|} let is_merge_commit_to_ignore ~(cfg : Config_t.config) ~branch commit = match cfg.main_branch_name with @@ -51,13 +52,15 @@ let is_merge_commit_to_ignore ~(cfg : Config_t.config) ~branch commit = *) let title = Util.first_line commit.message in begin - match Re2.find_submatches_exn merge_commit_re title with - | [| Some _; Some incoming_branch; receiving_branch |] -> + match Re.exec_opt merge_commit_re title with + | None -> false + | Some g -> + match Re.Group.(get_opt g 1, get_opt g 2) with + | Some incoming_branch, receiving_branch -> let receiving_branch = Option.map (fun s -> Stre.drop_prefix s " into ") receiving_branch in (* Should this raise when prefix isn't present? *) String.equal branch incoming_branch || Option.map_default (not $ String.equal branch) false receiving_branch | _ -> false - | exception Re2.Exceptions.Regex_match_failed _ -> false end | Some _ | None -> false @@ -183,11 +186,11 @@ type gh_resource = type gh_link = repository * gh_resource -let pr_commit_msg_re = Re2.create_exn {|\(#(\d+)\)|} -let commit_sha_re = Re2.create_exn {|[a-f0-9]{4,40}|} +let pr_commit_msg_re = Re.Perl.compile_pat {|\(#(\d+)\)|} +let commit_sha_re = Re.Perl.compile_pat {|[a-f0-9]{4,40}|} let comparer_re = {|([a-zA-Z0-9/:\-_.~\^]+)|} -let compare_basehead_re = Re2.create_exn (sprintf {|%s([.]{3})%s|} comparer_re comparer_re) -let gh_org_team_re = Re2.create_exn {|[a-zA-Z0-9\-]+/([a-zA-Z0-9\-]+)|} +let compare_basehead_re = Re.Perl.compile_pat (sprintf {|%s([.]{3})%s|} comparer_re comparer_re) +let gh_org_team_re = Re.Perl.compile_pat {|[a-zA-Z0-9\-]+/([a-zA-Z0-9\-]+)|} (** [gh_link_of_string s] parses a URL string [s] to try to match a supported GitHub link type, generating repository endpoints if necessary *) @@ -238,14 +241,17 @@ let gh_link_of_string url_str = Some (repo, Issue (int_of_string n)) | [ owner; name; "commit"; commit_hash ] | [ owner; name; "pull"; _; "commits"; commit_hash ] -> let repo = make_repo ~prefix ~owner ~name in - if Re2.matches commit_sha_re commit_hash then Some (repo, Commit commit_hash) else None + if Re.execp commit_sha_re commit_hash then Some (repo, Commit commit_hash) else None | owner :: name :: "compare" :: base_head | owner :: name :: "pull" :: _ :: "files" :: base_head -> let base_head = String.concat "/" base_head in let repo = make_repo ~prefix ~owner ~name in begin - match Re2.find_submatches_exn compare_basehead_re base_head with - | [| _; Some base; _; Some merge |] -> Some (repo, Compare (base, merge)) - | _ | (exception Re2.Exceptions.Regex_match_failed _) -> None + match Re.exec_opt compare_basehead_re base_head with + | None -> None + | Some g -> + match Re.Group.(get_opt g 1, get_opt g 3) with + | Some base, Some merge -> Some (repo, Compare (base, merge)) + | _ -> None end | [] -> None | next :: path -> extract_link_type ~prefix:(next :: prefix) path @@ -256,10 +262,12 @@ let gh_link_of_string url_str = let get_project_owners (pr : pull_request) ({ rules } : Config_t.project_owners) = Rule.Project_owners.match_rules pr.labels rules |> List.partition_map (fun reviewer -> - try - let team = Re2.find_first_exn ~sub:(`Index 1) gh_org_team_re reviewer in - Right team - with Re2.Exceptions.Regex_match_failed _ -> Left reviewer) + match Re.exec_opt gh_org_team_re reviewer with + | None -> Left reviewer + | Some g -> + match Re.Group.get_opt g 1 with + | Some team -> Right team + | None -> Left reviewer) |> fun (reviewers, team_reviewers) -> let already_requested_or_author = pr.user.login :: List.map (fun r -> r.login) pr.requested_reviewers in let already_requested_team = List.map (fun r -> r.slug) pr.requested_teams in diff --git a/lib/rule.atd b/lib/rule.atd index 08d2ab7a..60ab8234 100644 --- a/lib/rule.atd +++ b/lib/rule.atd @@ -1,6 +1,6 @@ type channel_name = string wrap -type regex = string wrap +type regex = string wrap (* Text fields from the GitHub payload that can be used in a condition *) type comparable_field = [ diff --git a/lib/rule.ml b/lib/rule.ml index 3df32391..04ea21ff 100644 --- a/lib/rule.ml +++ b/lib/rule.ml @@ -21,7 +21,7 @@ module Status = struct | Target_url -> notification.target_url in let rec match_condition = function - | Match { field; re } -> value_of_field field |> Option.map (Re2.matches re) |> Option.default false + | Match { field; re } -> value_of_field field |> Option.map (Common.Regex.matches re) |> Option.default false | All_of conditions -> List.for_all match_condition conditions | One_of conditions -> List.exists match_condition conditions | Not condition -> not @@ match_condition condition diff --git a/lib/slack.ml b/lib/slack.ml index 12641bad..e63ef1b7 100644 --- a/lib/slack.ml +++ b/lib/slack.ml @@ -75,18 +75,18 @@ let make_message ?username ?text ?attachments ?blocks ?thread ?handler ?(reply_b }, handler ) -let github_handle_regex = Re2.create_exn {|\B@([[:alnum:]][[:alnum:]-]{1,38})\b|} (* Match GH handles in messages - a GitHub handle has at most 39 chars and no underscore *) +let github_handle_regex = Re.Perl.compile_pat {|\B@([a-zA-Z0-9][a-zA-Z0-9-]{1,38})\b|} let add_slack_mentions_to_body slack_match_func body = - let replace_match m = - let gh_handle = Re2.Match.get_exn ~sub:(`Index 0) m in - let gh_handle_without_at = Re2.Match.get_exn ~sub:(`Index 1) m in + let replace_match g = + let gh_handle = Re.Group.get g 0 in + let gh_handle_without_at = Re.Group.get g 1 in match slack_match_func gh_handle_without_at with | None -> gh_handle | Some user_id -> sprintf "<@%s>" (Slack_user_id.project user_id) in - Re2.replace_exn github_handle_regex body ~f:replace_match + Re.replace ~all:true github_handle_regex ~f:replace_match body let format_attachments ~slack_match_func ~footer ~body = let format_mention_in_markdown (md : unfurl) = @@ -264,16 +264,16 @@ let git_short_sha_hash hash = String.sub hash 0 8 let pp_commit_common url id message author = let title = escape_mrkdwn @@ first_line message in (* check if the title contains a PR number and enrich with the PR link if so *) - match Re2.matches Github.pr_commit_msg_re title with + match Re.execp Github.pr_commit_msg_re title with | false -> sprintf "`<%s|%s>` %s - %s" url (git_short_sha_hash id) title author | true -> - let f m = - let pr_num = Re2.Match.get_exn ~sub:(`Index 1) m in + let f g = + let pr_num = Re.Group.get g 1 in match Github.gh_link_of_string url with | Some ((r, _) : repository * Github.gh_resource) -> sprintf "(<%s/pull/%s|#%s>)" r.url pr_num pr_num | None -> sprintf "(#%s)" pr_num in - let title' = Re2.replace_exn Github.pr_commit_msg_re title ~f in + let title' = Re.replace ~all:true Github.pr_commit_msg_re ~f title in sprintf "`<%s|%s>` %s - %s" url (git_short_sha_hash id) title' author let pp_commit ({ url; id; message; author; _ } : commit) = pp_commit_common url id message (escape_mrkdwn @@ author.name) @@ -335,7 +335,7 @@ let generate_push_notification notification channel = in make_message ~username ~channel ~text:(String.concat "\n" lines) () -let buildkite_description_re = Re2.create_exn {|^Build #(\d+)(.*)|} +let buildkite_description_re = Re.Perl.compile_pat {|^Build #(\d+)(.*)|} let generate_status_notification ~(job_log : (string * string) list) ~(cfg : Config_t.config) (n : status_notification) channel = @@ -353,13 +353,14 @@ let generate_status_notification ~(job_log : (string * string) list) ~(cfg : Con | Some _ when not is_buildkite -> desc | Some target_url -> (* Specific to buildkite *) - match Re2.find_submatches_exn buildkite_description_re desc with - | [| Some _; Some build_nr; Some rest |] -> + match Re.exec_opt buildkite_description_re desc with + | None -> desc + | Some g -> + match Re.Group.get_opt g 1, Re.Group.get_opt g 2 with + | Some build_nr, Some rest -> (* We use a zero-with space \u{200B} to prevent slack from interpreting #XXXXXX as a color *) sprintf "Build <%s|#\u{200B}%s>%s" target_url build_nr rest - | _ | (exception _) -> - (* we either match on the first case or get an exception *) - desc + | _ -> desc in let author_mention = (* If the author's email is not associated with a github account the author will be missing. diff --git a/lib/util.ml b/lib/util.ml index 48871603..9f0532a5 100644 --- a/lib/util.ml +++ b/lib/util.ml @@ -44,40 +44,39 @@ module Build = struct pipeline_name : string; } - let buildkite_is_failed_re = Re2.create_exn {|^Build #\d+ failed|} - let buildkite_is_failing_re = Re2.create_exn {|^Build #(\d+) is failing|} - let buildkite_is_canceled_re = Re2.create_exn {|^Build #\d+ canceled by .+|} - let buildkite_is_success_re = Re2.create_exn {|^Build #\d+ passed|} + let buildkite_is_failed_re = Re.Perl.compile_pat {|^Build #\d+ failed|} + let buildkite_is_failing_re = Re.Perl.compile_pat {|^Build #(\d+) is failing|} + let buildkite_is_canceled_re = Re.Perl.compile_pat {|^Build #\d+ canceled by .+|} + let buildkite_is_success_re = Re.Perl.compile_pat {|^Build #\d+ passed|} let buildkite_org_pipeline_build_re = (* buildkite.com///builds/ *) - Re2.create_exn {|buildkite.com/([\w_-]+)/([\w_-]+)/builds/(\d+)|} + Re.Perl.compile_pat {|buildkite.com/([\w_-]+)/([\w_-]+)/builds/(\d+)|} let buildkite_api_org_pipeline_build_job_re = (* https://api.buildkite.com/v2/organizations//pipelines//builds//jobs//log *) - Re2.create_exn + Re.Perl.compile_pat {|https://api.buildkite.com/v2/organizations/([\w_-]+)/pipelines/([\w_-]+)/builds/(\d+)/jobs/([\d\w_-]+)/log|} let buildkite_is_step_re = (* Checks if a pipeline or build step, by looking into the buildkite context buildkite//(/?) *) - Re2.create_exn {|buildkite/[\w_-]+/([\w_-]+(/[\w_-]+)*)|} + Re.Perl.compile_pat {|buildkite/[\w_-]+/([\w_-]+(/[\w_-]+)*)|} let buildkite_pipeline_name_re = (* Gets the pipeline name from the buildkite context *) - Re2.create_exn {|buildkite/([\w_-]+)|} + Re.Perl.compile_pat {|buildkite/([\w_-]+)|} - let is_pipeline_step context = Re2.matches buildkite_is_step_re context + let is_pipeline_step context = Re.execp buildkite_is_step_re context (** For now we only care about buildkite pipelines and steps. Other CI systems are not supported yet. *) let parse_context ~context = match Stre.starts_with context "buildkite/" with | false -> None | true -> - try - let pipeline_name = Re2.find_first_exn ~sub:(`Index 1) buildkite_pipeline_name_re context in - Some { is_pipeline_step = is_pipeline_step context; pipeline_name } - with _ -> None + match Re.exec_opt buildkite_pipeline_name_re context with + | None -> None + | Some g -> Some { is_pipeline_step = is_pipeline_step context; pipeline_name = Re.Group.get g 1 } let parse_context_exn ~context = match parse_context ~context with @@ -86,13 +85,13 @@ module Build = struct let buildkite_build_number_re = (* buildkite.com///builds/ *) - Re2.create_exn {|buildkite.com/[\w_-]+/[\w_-]+/builds/(\d+)|} + Re.Perl.compile_pat {|buildkite.com/[\w_-]+/[\w_-]+/builds/(\d+)|} (** For now we only care about buildkite pipelines and steps. Other CI systems are not supported yet. *) let get_build_number_exn ~build_url = - match Re2.find_first_exn ~sub:(`Index 1) buildkite_build_number_re build_url with - | build_number -> int_of_string build_number - | exception _ -> util_error "failed to get build number from url" + match Re.exec_opt buildkite_build_number_re build_url with + | Some g -> int_of_string (Re.Group.get g 1) + | None -> util_error "failed to get build number from url" let get_build_url (n : Github_t.status_notification) = match n.target_url with @@ -100,21 +99,23 @@ module Build = struct | Some build_url -> Ok build_url let get_org_pipeline_build' build_url = - match Re2.find_submatches_exn buildkite_org_pipeline_build_re build_url with - | exception _ -> util_error "failed to parse Buildkite build url: %s" build_url - | [| Some _; Some org; Some pipeline; Some build_nr |] -> org, pipeline, build_nr + match Re.exec_opt buildkite_org_pipeline_build_re build_url with + | None -> util_error "failed to parse Buildkite build url: %s" build_url + | Some g -> + match Re.Group.get_opt g 1, Re.Group.get_opt g 2, Re.Group.get_opt g 3 with + | Some org, Some pipeline, Some build_nr -> org, pipeline, build_nr | _ -> util_error "failed to get the build details from the notification. Is this a Buildkite notification?" let get_org_pipeline_build (n : Github_t.status_notification) = Result.(map get_org_pipeline_build' (get_build_url n)) let is_failed_build (n : Github_t.status_notification) = - n.state = Failure && Re2.matches buildkite_is_failed_re (Option.default "" n.description) + n.state = Failure && Re.execp buildkite_is_failed_re (Option.default "" n.description) let is_failing_build (n : Github_t.status_notification) = - n.state = Failure && Re2.matches buildkite_is_failing_re (Option.default "" n.description) + n.state = Failure && Re.execp buildkite_is_failing_re (Option.default "" n.description) let is_canceled_build (n : Github_t.status_notification) = - n.state = Failure && Re2.matches buildkite_is_canceled_re (Option.default "" n.description) + n.state = Failure && Re.execp buildkite_is_canceled_re (Option.default "" n.description) let is_main_branch (cfg : Config_t.config) (n : Github_t.status_notification) = match cfg.main_branch_name with @@ -255,15 +256,15 @@ module Webhook = struct let git_ssh_re = (* matches git ssh clone links *) - Re2.create_exn {|^git@([A-Za-z0-9.-]+):([A-Za-z0-9._-]+)\/([A-Za-z0-9._-]+)\.git$|} + Re.Perl.compile_pat {|^git@([A-Za-z0-9.-]+):([A-Za-z0-9._-]+)\/([A-Za-z0-9._-]+)\.git$|} let git_ssh_to_repo url = - match Re2.find_submatches_exn git_ssh_re url with - | exception exn -> util_error ~exn "failed to parse git ssh link %s" url - | [| Some _; Some "github.com"; Some user; Some repo |] -> Github { url = "github.com"; user; repo } - | [| Some _; Some url; Some user; Some repo |] -> - (* GHE links *) - GHE { url; user; repo } + match Re.exec_opt git_ssh_re url with + | None -> util_error "failed to parse git ssh link %s" url + | Some g -> + match Re.Group.get_opt g 1, Re.Group.get_opt g 2, Re.Group.get_opt g 3 with + | Some host, Some user, Some repo when host = "github.com" -> Github { url = "github.com"; user; repo } + | Some url, Some user, Some repo -> GHE { url; user; repo } | _ -> util_error "failed to get repo details from the ssh link." let git_ssh_to_api_url ?(resource = "") url = diff --git a/monorobot.opam b/monorobot.opam index 8010a9d5..de51543a 100644 --- a/monorobot.opam +++ b/monorobot.opam @@ -21,13 +21,13 @@ depends: [ "digestif" {>= "1.2.0"} "devkit" {>= "1.20240429"} "extlib" {>= "1.7.8"} - "lwt" {>= "5.7.0"} - "lwt_ppx" {>= "2.0.0"} + "lwt" {>= "5.7.0" & < "6.0.0"} + "lwt_ppx" {>= "5.7.0" & < "6.0.0"} "ptime" {>= "1.2.0"} "ocamldiff" {>= "1.2"} "sqlite3" {>= "5.1.0"} "sqlgg" {>= "20231201"} - "re2" {>= "0.16.0"} + "re" "uri" "omd" {< "2"} "yojson"