diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index da42745..7500401 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -38,7 +38,7 @@ jobs: with: ocaml-compiler: ${{ matrix.ocaml-compiler }} - - run: opam install . --deps-only + - run: opam install . --deps-only --with-test - run: opam exec -- dune build diff --git a/dune-project b/dune-project index d1fbf9c..6fa9fe1 100644 --- a/dune-project +++ b/dune-project @@ -23,6 +23,6 @@ (name sarif) (synopsis "Static Analysis Results Interchange Format (SARIF) Version 2.1.0") (description "Static Analysis Results Interchange Format (SARIF) Version 2.1.0") - (depends (ocaml (>= 4.14.0)) dune core re2 (atdgen (>= 2.10.0)) (atdgen-runtime (>= 2.10.0)) timedesc ppx_jane ppx_deriving (uri (>= 4.4.0))) + (depends (ocaml (>= 4.14.0)) dune re (atdgen (>= 2.10.0)) (atdgen-runtime (>= 2.10.0)) timedesc (ppx_expect :with-test) ppx_deriving (uri (>= 4.4.0))) (tags - (sarif))) \ No newline at end of file + (sarif))) diff --git a/lib/dune b/lib/dune index 227d3ae..bc5151f 100644 --- a/lib/dune +++ b/lib/dune @@ -1,7 +1,7 @@ (library (public_name sarif) (name sarif) - (libraries core timedesc atdgen-runtime re2 uri) + (libraries timedesc atdgen-runtime re uri) (preprocess (pps ppx_deriving.show ppx_deriving.ord ppx_deriving.eq)) (flags :standard -w -30)) diff --git a/lib/sarif_v_2_1_0_util.ml b/lib/sarif_v_2_1_0_util.ml index 9017fbf..9156bb0 100644 --- a/lib/sarif_v_2_1_0_util.ml +++ b/lib/sarif_v_2_1_0_util.ml @@ -1,6 +1,5 @@ (** Validation functions used by atdgen validator *) -open Core open Timedesc open Sarif_v_2_1_0_t @@ -11,12 +10,14 @@ let validate_iso8601_opt = function | Ok _ -> true | Error _ -> false +let re_mime_type = + Re.Str.regexp "^[^/]+/.+$" + let validate_mime_type x = - let re = Re2.create_exn "[^/]+/.+" in Re2.matches re x + Re.Str.string_match re_mime_type x 0 -let validate_mime_type_opt = function - | None -> true - | Some v -> let re = Re2.create_exn "[^/]+/.+" in Re2.matches re v +let validate_mime_type_opt x = + Option.fold ~none:true ~some:validate_mime_type x let validate_int64_minimum_zero x = if (Int64.compare x (-1L)) > 0 then true else false @@ -33,40 +34,46 @@ let validate_int64_minimum_one_opt = function let validate_int64_minimum_minus_one x = if (Int64.compare x (-2L)) > 0 then true else false +let re_guid = + Re.Str.regexp "^[0-9a-fA-F]{8}-[0-9a-fA-F]{4}-[1-5][0-9a-fA-F]{3}-[89abAB][0-9a-fA-F]{3}-[0-9a-fA-F]{12}$" + let validate_guid x = - let re = Re2.create_exn "^[0-9a-fA-F]{8}-[0-9a-fA-F]{4}-[1-5][0-9a-fA-F]{3}-[89abAB][0-9a-fA-F]{3}-[0-9a-fA-F]{12}$" - in Re2.matches re x + Re.Str.string_match re_guid x 0 -let validate_guid_opt = function - | None -> true - | Some v -> let re = Re2.create_exn "^[0-9a-fA-F]{8}-[0-9a-fA-F]{4}-[1-5][0-9a-fA-F]{3}-[89abAB][0-9a-fA-F]{3}-[0-9a-fA-F]{12}$" - in Re2.matches re v +let validate_guid_opt o = + Option.fold o ~none:true ~some:validate_guid + +let re_dotted_quad_file = + Re.Str.regexp "^[0-9]+(\\\\.[0-9]+){3}$" let validate_dotted_quad_file_v x = - let re = Re2.create_exn "[0-9]+(\\\\.[0-9]+){3}" - in Re2.matches re x + Re.Str.string_match re_dotted_quad_file x 0 -let validate_dotted_quad_file_v_opt = function - | None -> true - | Some v -> let re = Re2.create_exn "[0-9]+(\\\\.[0-9]+){3}" in Re2.matches re v +let validate_dotted_quad_file_v_opt o = + Option.fold o ~none:true ~some:validate_dotted_quad_file_v + +let re_language = + Re.Str.regexp "^[a-zA-Z]{2}(-[a-zA-Z]{2})?$" let validate_language x = - let re = Re2.create_exn "^[a-zA-Z]{2}(-[a-zA-Z]{2})?$" - in Re2.matches re x + Re.Str.string_match re_language x 0 -let validate_language_opt = function - | None -> true - | Some v -> let re = Re2.create_exn "^[a-zA-Z]{2}(-[a-zA-Z]{2})?$" in Re2.matches re v +let validate_language_opt x = + Option.fold x ~none:true ~some:validate_language let validate_unique = function | [] -> true - | lst -> if List.contains_dup lst ~compare:Stdlib.compare then false else true - -let validate_unique_opt = function - | None -> true - | Some v -> match v with - | [] -> true - | lst -> if List.contains_dup lst ~compare:Stdlib.compare then false else true + | cur :: rem -> + let rec loop cur rem = + not (List.mem cur rem) && + match rem with + | [] -> true + | cur :: rem -> loop cur rem + in + loop cur rem + +let validate_unique_opt xs_opt = + Option.fold ~none:true ~some:validate_unique xs_opt let validate_rank x = if (Int64.compare x (-2L)) > 0 && (Int64.compare x (101L)) < 0 then true else false @@ -87,12 +94,12 @@ let validate_list_min_size_one x = if (Int.compare (List.length x) 1) > 0 then t let validate_list_all_str_list (lst : string list option) pred = match lst with | None -> true - | Some v -> List.for_all v ~f:pred + | Some v -> List.for_all pred v let validate_list_all_deprecated_guid_list (lst : reporting_descriptor_deprecated_guids_item list option) pred = match lst with | None -> true - | Some v -> List.for_all v ~f:pred + | Some v -> List.for_all pred v (** Validator for type address *) let validate_address (address : address) = diff --git a/sarif.opam b/sarif.opam index 6ff4022..2e257fd 100644 --- a/sarif.opam +++ b/sarif.opam @@ -13,12 +13,11 @@ bug-reports: "https://github.com/gborough/sarif/issues" depends: [ "ocaml" {>= "4.14.0"} "dune" {>= "3.12"} - "core" - "re2" + "re" "atdgen" {>= "2.10.0"} "atdgen-runtime" {>= "2.10.0"} "timedesc" - "ppx_jane" + "ppx_expect" {with-test} "ppx_deriving" "uri" {>= "4.4.0"} "odoc" {with-doc} diff --git a/test/dune b/test/dune index 15fd0de..d66416f 100644 --- a/test/dune +++ b/test/dune @@ -1,7 +1,7 @@ (library (name test_sarif) - (libraries sarif core ppx_expect.common ppx_expect.config ppx_expect.config_types) + (libraries sarif ppx_expect.common ppx_expect.config ppx_expect.config_types) (inline_tests (deps (glob_files data/*))) - (preprocess (pps ppx_jane))) + (preprocess (pps ppx_expect))) -(include_subdirs unqualified) \ No newline at end of file +(include_subdirs unqualified) diff --git a/test/malformed.ml b/test/malformed.ml index eb6be02..4261228 100644 --- a/test/malformed.ml +++ b/test/malformed.ml @@ -1,130 +1,135 @@ -open Core open Sarif +let read_all file = + let ic = open_in_bin file in + let s = really_input_string ic (in_channel_length ic) in + close_in ic; + s + let%expect_test "malformed_iso8601_date" = - let json = In_channel.read_all "data/malformed.json" in + let json = read_all "data/malformed.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let artifact = Sarif_v_2_1_0_j.string_of_artifact @@ List.nth_exn (Option.value_exn parsed_run.artifacts) 0 in + let artifact = Sarif_v_2_1_0_j.string_of_artifact @@ List.nth (Option.get parsed_run.artifacts) 0 in let parsed_artifact = Sarif_v_2_1_0_j.artifact_of_string artifact in let res = Sarif_v_2_1_0_util.validate_artifact parsed_artifact in if res then print_endline "true" else print_endline "false"; [%expect {|false|}] let%expect_test "malformed_mime_type" = - let json = In_channel.read_all "data/malformed.json" in + let json = read_all "data/malformed.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let artifact = Sarif_v_2_1_0_j.string_of_artifact @@ List.nth_exn (Option.value_exn parsed_run.artifacts) 1 in + let artifact = Sarif_v_2_1_0_j.string_of_artifact @@ List.nth (Option.get parsed_run.artifacts) 1 in let parsed_artifact = Sarif_v_2_1_0_j.artifact_of_string artifact in let res = Sarif_v_2_1_0_util.validate_artifact parsed_artifact in if res then print_endline "true" else print_endline "false"; [%expect {|false|}] let%expect_test "malformed_minimum_zero" = - let json = In_channel.read_all "data/malformed.json" in + let json = read_all "data/malformed.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let artifact = Sarif_v_2_1_0_j.string_of_artifact @@ List.nth_exn (Option.value_exn parsed_run.artifacts) 2 in + let artifact = Sarif_v_2_1_0_j.string_of_artifact @@ List.nth (Option.get parsed_run.artifacts) 2 in let parsed_artifact = Sarif_v_2_1_0_j.artifact_of_string artifact in let res = Sarif_v_2_1_0_util.validate_artifact parsed_artifact in if res then print_endline "true" else print_endline "false"; [%expect {|false|}] let%expect_test "malformed_minimum_one" = - let json = In_channel.read_all "data/malformed.json" in + let json = read_all "data/malformed.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let result = Sarif_v_2_1_0_j.string_of_result @@ List.nth_exn (Option.value_exn parsed_run.results) 0 in + let result = Sarif_v_2_1_0_j.string_of_result @@ List.nth (Option.get parsed_run.results) 0 in let parsed_result = Sarif_v_2_1_0_j.result_of_string result in let res = Sarif_v_2_1_0_util.validate_result parsed_result in if res then print_endline "true" else print_endline "false"; [%expect {|false|}] let%expect_test "malformed_minimum_minus_one" = - let json = In_channel.read_all "data/malformed.json" in + let json = read_all "data/malformed.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let artifact = Sarif_v_2_1_0_j.string_of_artifact @@ List.nth_exn (Option.value_exn parsed_run.artifacts) 3 in + let artifact = Sarif_v_2_1_0_j.string_of_artifact @@ List.nth (Option.get parsed_run.artifacts) 3 in let parsed_artifact = Sarif_v_2_1_0_j.artifact_of_string artifact in let res = Sarif_v_2_1_0_util.validate_artifact parsed_artifact in if res then print_endline "true" else print_endline "false"; [%expect {|false|}] let%expect_test "malformed_guid" = - let json = In_channel.read_all "data/malformed.json" in + let json = read_all "data/malformed.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let result = Sarif_v_2_1_0_j.string_of_result @@ List.nth_exn (Option.value_exn parsed_run.results) 1 in + let result = Sarif_v_2_1_0_j.string_of_result @@ List.nth (Option.get parsed_run.results) 1 in let parsed_result = Sarif_v_2_1_0_j.result_of_string result in let res = Sarif_v_2_1_0_util.validate_result parsed_result in if res then print_endline "true" else print_endline "false"; [%expect {|false|}] let%expect_test "malformed_dotted_quad_file" = - let json = In_channel.read_all "data/malformed.json" in + let json = read_all "data/malformed.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let taxonomies = Sarif_v_2_1_0_j.string_of_tool_component @@ List.hd_exn @@ Option.value_exn parsed_run.taxonomies in + let taxonomies = Sarif_v_2_1_0_j.string_of_tool_component @@ List.hd @@ Option.get parsed_run.taxonomies in let parsed_taxonomies = Sarif_v_2_1_0_j.tool_component_of_string taxonomies in let res = Sarif_v_2_1_0_util.validate_tool_component parsed_taxonomies in if res then print_endline "true" else print_endline "false"; [%expect {|false|}] let%expect_test "malformed_language" = - let json = In_channel.read_all "data/malformed1.json" in + let json = read_all "data/malformed1.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in let res = Sarif_v_2_1_0_util.validate_run parsed_run in if res then print_endline "true" else print_endline "false"; [%expect {|false|}] let%expect_test "malformed_none_unique" = - let json = In_channel.read_all "data/malformed1.json" in + let json = read_all "data/malformed1.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let result = Sarif_v_2_1_0_j.string_of_result @@ List.hd_exn @@ Option.value_exn parsed_run.results in + let result = Sarif_v_2_1_0_j.string_of_result @@ List.hd @@ Option.get parsed_run.results in let parsed_result = Sarif_v_2_1_0_j.result_of_string result in let res = Sarif_v_2_1_0_util.validate_result parsed_result in if res then print_endline "true" else print_endline "false"; [%expect {|false|}] let%expect_test "malformed_rank" = - let json = In_channel.read_all "data/malformed2.json" in + let json = read_all "data/malformed2.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let result = Sarif_v_2_1_0_j.string_of_result @@ List.hd_exn @@ Option.value_exn parsed_run.results in + let result = Sarif_v_2_1_0_j.string_of_result @@ List.hd @@ Option.get parsed_run.results in let parsed_result = Sarif_v_2_1_0_j.result_of_string result in let res = Sarif_v_2_1_0_util.validate_result parsed_result in if res then print_endline "true" else print_endline "false"; [%expect {|false|}] let%expect_test "malformed_uri" = - let json = In_channel.read_all "data/malformed3.json" in + let json = read_all "data/malformed3.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let result = Sarif_v_2_1_0_j.string_of_result @@ List.hd_exn @@ Option.value_exn parsed_run.results in + let result = Sarif_v_2_1_0_j.string_of_result @@ List.hd @@ Option.get parsed_run.results in let parsed_result = Sarif_v_2_1_0_j.result_of_string result in let res = Sarif_v_2_1_0_util.validate_result parsed_result in if res then print_endline "true" else print_endline "false"; [%expect {|false|}] let%expect_test "malformed_list_min_size_one" = - let json = In_channel.read_all "data/malformed4.json" in + let json = read_all "data/malformed4.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in let res = Sarif_v_2_1_0_util.validate_run parsed_run in if res then print_endline "true" else print_endline "false"; - [%expect {|false|}] \ No newline at end of file + [%expect {|false|}] diff --git a/test/test_sarif.ml b/test/test_sarif.ml index 890a8e2..7559191 100644 --- a/test/test_sarif.ml +++ b/test/test_sarif.ml @@ -1,139 +1,144 @@ -open Core open Sarif +let read_all file = + let ic = open_in_bin file in + let s = really_input_string ic (in_channel_length ic) in + close_in ic; + s + let%expect_test "code_flows" = - let json = In_channel.read_all "data/code_flows.json" in + let json = read_all "data/code_flows.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let result = Sarif_v_2_1_0_j.string_of_result @@ List.hd_exn @@ Option.value_exn parsed_run.results in + let result = Sarif_v_2_1_0_j.string_of_result @@ List.hd @@ Option.get parsed_run.results in let parsed_result = Sarif_v_2_1_0_j.result_of_string result in - let code_flows = Sarif_v_2_1_0_j.string_of_code_flow @@ List.hd_exn @@ Option.value_exn parsed_result.code_flows in + let code_flows = Sarif_v_2_1_0_j.string_of_code_flow @@ List.hd @@ Option.get parsed_result.code_flows in print_endline code_flows; [%expect {| {"message":{"text":"Path from declaration to usage."},"threadFlows":[{"locations":[{"importance":"essential","location":{"logicalLocations":[{"fullyQualifiedName":"collections::list::add"}],"message":{"text":"Variable 'ptr' declared."},"physicalLocation":{"artifactLocation":{"uri":"collections/list.h"},"region":{"snippet":{"text":"int* ptr;"},"startColumn":8,"startLine":15}}}},{"importance":"unimportant","location":{"logicalLocations":[{"fullyQualifiedName":"collections::list::add"}],"physicalLocation":{"artifactLocation":{"uri":"collections/list.h"},"region":{"snippet":{"text":"offset = 0;"},"startColumn":8,"startLine":18}}}},{"importance":"essential","location":{"logicalLocations":[{"fullyQualifiedName":"collections::list::add"}],"message":{"text":"Uninitialized variable 'ptr' passed to method 'add_core'."},"physicalLocation":{"artifactLocation":{"uri":"collections/list.h"},"region":{"snippet":{"text":"add_core(ptr, offset, val)"},"startColumn":8,"startLine":25}}}}]}]} |}] let%expect_test "context_region" = - let json = In_channel.read_all "data/context_region.json" in + let json = read_all "data/context_region.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let result = Sarif_v_2_1_0_j.string_of_result @@ List.hd_exn @@ Option.value_exn parsed_run.results in + let result = Sarif_v_2_1_0_j.string_of_result @@ List.hd @@ Option.get parsed_run.results in let parsed_result = Sarif_v_2_1_0_j.result_of_string result in - let location = Sarif_v_2_1_0_j.string_of_location @@ List.hd_exn @@ Option.value_exn parsed_result.locations in + let location = Sarif_v_2_1_0_j.string_of_location @@ List.hd @@ Option.get parsed_result.locations in let parsed_location = Sarif_v_2_1_0_j.location_of_string location in - let physical_location = Sarif_v_2_1_0_j.string_of_physical_location @@ Option.value_exn parsed_location.physical_location in + let physical_location = Sarif_v_2_1_0_j.string_of_physical_location @@ Option.get parsed_location.physical_location in let parsed_physical_location = Sarif_v_2_1_0_j.physical_location_of_string physical_location in - let context_region = Sarif_v_2_1_0_j.string_of_region @@ Option.value_exn parsed_physical_location.context_region in + let context_region = Sarif_v_2_1_0_j.string_of_region @@ Option.get parsed_physical_location.context_region in print_endline context_region; [%expect {| {"endColumn":28,"snippet":{"text":"/// This is a BAD word."},"startColumn":5,"startLine":4} |}] let%expect_test "default_rule_configuration" = - let json = In_channel.read_all "data/default_rule_configuration.json" in + let json = read_all "data/default_rule_configuration.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in let tool = Sarif_v_2_1_0_j.string_of_tool parsed_run.tool in let parsed_tool = Sarif_v_2_1_0_j.tool_of_string tool in let driver = Sarif_v_2_1_0_j.string_of_tool_component parsed_tool.driver in let parsed_driver = Sarif_v_2_1_0_j.tool_component_of_string driver in - let rules = Sarif_v_2_1_0_j.string_of_reporting_descriptor @@ List.hd_exn @@ Option.value_exn parsed_driver.rules in + let rules = Sarif_v_2_1_0_j.string_of_reporting_descriptor @@ List.hd @@ Option.get parsed_driver.rules in print_endline rules; [%expect {| {"defaultConfiguration":{"level":"error"},"id":"TUT0001"} |}] let%expect_test "embedded_binary_content" = - let json = In_channel.read_all "data/embedded_binary_content.json" in + let json = read_all "data/embedded_binary_content.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let result = Sarif_v_2_1_0_j.string_of_result @@ List.hd_exn @@ Option.value_exn parsed_run.results in + let result = Sarif_v_2_1_0_j.string_of_result @@ List.hd @@ Option.get parsed_run.results in let parsed_result = Sarif_v_2_1_0_j.result_of_string result in - let location = Sarif_v_2_1_0_j.string_of_location @@ List.hd_exn @@ Option.value_exn parsed_result.locations in + let location = Sarif_v_2_1_0_j.string_of_location @@ List.hd @@ Option.get parsed_result.locations in print_endline location; [%expect {| {"physicalLocation":{"artifactLocation":{"index":0,"uri":"data.bin"},"region":{"byteLength":2,"byteOffset":2}}} |}] let%expect_test "embedded_text_content" = - let json = In_channel.read_all "data/embedded_text_content.json" in + let json = read_all "data/embedded_text_content.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let artifacts = Sarif_v_2_1_0_j.string_of_artifact @@ List.hd_exn @@ Option.value_exn parsed_run.artifacts in + let artifacts = Sarif_v_2_1_0_j.string_of_artifact @@ List.hd @@ Option.get parsed_run.artifacts in print_endline artifacts; [%expect {| {"contents":{"text":"Hello,\r\nworld"},"encoding":"UTF-8","location":{"uri":"explicit.txt"}} |}] let%expect_test "notifications" = - let json = In_channel.read_all "data/notifications.json" in + let json = read_all "data/notifications.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in let tool = Sarif_v_2_1_0_j.string_of_tool parsed_run.tool in let parsed_tool = Sarif_v_2_1_0_j.tool_of_string tool in let driver = Sarif_v_2_1_0_j.string_of_tool_component parsed_tool.driver in let parsed_driver = Sarif_v_2_1_0_j.tool_component_of_string driver in - let notifications = Sarif_v_2_1_0_j.string_of_reporting_descriptor @@ List.hd_exn @@ Option.value_exn parsed_driver.notifications in + let notifications = Sarif_v_2_1_0_j.string_of_reporting_descriptor @@ List.hd @@ Option.get parsed_driver.notifications in print_endline notifications; [%expect {| {"defaultConfiguration":{"level":"warning"},"id":"TUTN9001","messageStrings":{"disabled":{"text":"'{0}' cannot be disabled because this rule does not exist."},"enabled":{"text":"'{0}' cannot be enabled because this rule does not exist."}},"name":"unknown-rule","shortDescription":{"text":"This notification is triggered when the user supplies a command line argument to enable or disable a rule that does not exist."}} |}] let%expect_test "original_uri_base_ids" = - let json = In_channel.read_all "data/original_uri_base_ids.json" in + let json = read_all "data/original_uri_base_ids.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let original_uri_base_ids = Sarif_v_2_1_0_j.string_of_hm_str_al @@ Option.value_exn parsed_run.original_uri_base_ids in + let original_uri_base_ids = Sarif_v_2_1_0_j.string_of_hm_str_al @@ Option.get parsed_run.original_uri_base_ids in print_endline original_uri_base_ids; [%expect {| {"REPOROOT":{"description":{"text":"The directory into which the repo was cloned."},"properties":{"comment":"The SARIF producer has chosen not to specify a URI for REPOROOT. See ยง3.14.14, NOTE 1, for an explanation."}},"SRCROOT":{"description":{"text":"The r."},"properties":{"comment":"SRCROOT is expressed relative to REPOROOT."},"uri":"src/","uriBaseId":"REPOROOT"},"LOGSROOT":{"description":{"text":"Destination for tool logs."},"properties":{"comment":"An originalUriBaseId that resolves directly to an absolute URI."},"uri":"file:///C:/logs/"}} |}] let%expect_test "regional_variants" = - let json = In_channel.read_all "data/regional_variants.json" in + let json = read_all "data/regional_variants.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let result = Sarif_v_2_1_0_j.string_of_result @@ List.hd_exn @@ Option.value_exn parsed_run.results in + let result = Sarif_v_2_1_0_j.string_of_result @@ List.hd @@ Option.get parsed_run.results in let parsed_result = Sarif_v_2_1_0_j.result_of_string result in - let location = Sarif_v_2_1_0_j.string_of_location @@ List.hd_exn @@ Option.value_exn parsed_result.locations in + let location = Sarif_v_2_1_0_j.string_of_location @@ List.hd @@ Option.get parsed_result.locations in print_endline location; [%expect {| {"physicalLocation":{"artifactLocation":{"index":0,"uri":"TextFile.txt"},"region":{"endColumn":4,"endLine":1,"startColumn":2,"startLine":1}}} |}] let%expect_test "result_stacks" = - let json = In_channel.read_all "data/result_stacks.json" in + let json = read_all "data/result_stacks.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let result = Sarif_v_2_1_0_j.string_of_result @@ List.hd_exn @@ Option.value_exn parsed_run.results in + let result = Sarif_v_2_1_0_j.string_of_result @@ List.hd @@ Option.get parsed_run.results in let parsed_result = Sarif_v_2_1_0_j.result_of_string result in - let stacks = Sarif_v_2_1_0_j.string_of_stack @@ List.hd_exn @@ Option.value_exn parsed_result.stacks in + let stacks = Sarif_v_2_1_0_j.string_of_stack @@ List.hd @@ Option.get parsed_result.stacks in print_endline stacks; [%expect {| {"frames":[{"location":{"logicalLocations":[{"fullyQualifiedName":"collections::list::add_core"}],"message":{"text":"Exception thrown."},"physicalLocation":{"artifactLocation":{"uri":"collections/list.h","uriBaseId":"SRCROOT"},"region":{"startColumn":15,"startLine":110}}},"module":"platform","parameters":["null","0","14"],"threadId":52},{"location":{"logicalLocations":[{"fullyQualifiedName":"collections::list::add"}],"physicalLocation":{"artifactLocation":{"uri":"collections/list.h","uriBaseId":"SRCROOT"},"region":{"startColumn":15,"startLine":43}}},"module":"platform","parameters":["14"],"threadId":52},{"location":{"logicalLocations":[{"fullyQualifiedName":"main"}],"physicalLocation":{"artifactLocation":{"uri":"application/main.cpp","uriBaseId":"SRCROOT"},"region":{"startColumn":9,"startLine":28}}},"module":"application","threadId":52}],"message":{"text":"Call stack resulting from usage of uninitialized variable."}} |}] let%expect_test "rule_metadata" = - let json = In_channel.read_all "data/rule_metadata.json" in + let json = read_all "data/rule_metadata.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in let tool = Sarif_v_2_1_0_j.string_of_tool parsed_run.tool in let parsed_tool = Sarif_v_2_1_0_j.tool_of_string tool in let driver = Sarif_v_2_1_0_j.string_of_tool_component parsed_tool.driver in let parsed_driver = Sarif_v_2_1_0_j.tool_component_of_string driver in - let rules = Sarif_v_2_1_0_j.string_of_reporting_descriptor @@ List.hd_exn @@ Option.value_exn parsed_driver.rules in + let rules = Sarif_v_2_1_0_j.string_of_reporting_descriptor @@ List.hd @@ Option.get parsed_driver.rules in print_endline rules; [%expect {| {"defaultConfiguration":{"level":"error"},"fullDescription":{"markdown":"Every JSON property whose value is defined by the schema to be a URI (with `\"format\": \"uri\"` or `\"format\": \"uri-reference\"`) must contain a valid URI.","text":"Every JSON property whose value is defined by the schema to be a URI (with \"format\": \"uri\" or \"format\": \"uri-reference\") must contain a valid URI."},"id":"TUT1001","messageStrings":{"default":{"markdown":"The URI `{0}` is invalid.","text":"The URI '{0}' is invalid."}},"name":"InvalidUri","shortDescription":{"markdown":"Properties defined with the `uri` or `uri-reference` format must contain valid URIs.","text":"Properties defined with the 'uri' or 'uri-reference' format must contain valid URIs."}} |}] let%expect_test "suppresions" = - let json = In_channel.read_all "data/suppresions.json" in + let json = read_all "data/suppresions.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let result = Sarif_v_2_1_0_j.string_of_result @@ List.nth_exn (Option.value_exn parsed_run.results) 1 in + let result = Sarif_v_2_1_0_j.string_of_result @@ List.nth (Option.get parsed_run.results) 1 in let parsed_result = Sarif_v_2_1_0_j.result_of_string result in - let suppressions = Sarif_v_2_1_0_j.string_of_suppression @@ List.hd_exn @@ Option.value_exn parsed_result.suppressions in + let suppressions = Sarif_v_2_1_0_j.string_of_suppression @@ List.hd @@ Option.get parsed_result.suppressions in print_endline suppressions; [%expect {| {"kind":"inSource"} |}] let%expect_test "taxonomies" = - let json = In_channel.read_all "data/taxonomies.json" in + let json = read_all "data/taxonomies.json" in let parsed_all = Sarif_v_2_1_0_j.sarif_json_schema_of_string json in - let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd_exn @@ parsed_all.runs in + let run = Sarif_v_2_1_0_j.string_of_run @@ List.hd @@ parsed_all.runs in let parsed_run = Sarif_v_2_1_0_j.run_of_string run in - let taxonomies = Sarif_v_2_1_0_j.string_of_tool_component @@ List.hd_exn @@ Option.value_exn parsed_run.taxonomies in + let taxonomies = Sarif_v_2_1_0_j.string_of_tool_component @@ List.hd @@ Option.get parsed_run.taxonomies in print_endline taxonomies; [%expect {| {"guid":"1A567403-868F-405E-92CF-771A9ECB03A1","name":"Requirement levels","shortDescription":{"text":"This taxonomy classifies rules according to whether their use is required or recommended by company policy."},"taxa":[{"id":"RQL1001","name":"Required","shortDescription":{"text":"Rules in this category are required by company policy. All violations must be fixed unless an exemption is granted."}},{"id":"RQL1002","name":"Recommended","shortDescription":{"text":"Rules in this category are recommended but not required by company policy. Violations should be fixed but an exemption is not required to suppress a result."}}]} |}]