diff --git a/.github/workflows/branch.yml b/.github/workflows/branch.yml index bb0b9d6..dae841d 100644 --- a/.github/workflows/branch.yml +++ b/.github/workflows/branch.yml @@ -25,7 +25,7 @@ jobs: - name: Set-up OCaml uses: ocaml/setup-ocaml@v2 with: - ocaml-compiler: '5.2.1' + ocaml-compiler: '5.4.1' - run: opam install . --deps-only --with-test working-directory: ${{ github.event.repository.name }} diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 39d719a..cf23873 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -25,7 +25,7 @@ jobs: - name: Set-up OCaml uses: ocaml/setup-ocaml@v2 with: - ocaml-compiler: '5.2.1' + ocaml-compiler: '5.4.1' - run: opam install . --deps-only --with-test working-directory: ${{ github.event.repository.name }} diff --git a/.ocamlformat b/.ocamlformat index 912bea4..81bbcc8 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,2 +1,2 @@ profile = default -version = 0.27.0 +version = 0.28.1 diff --git a/README.md b/README.md index 2b7fbe2..c37a620 100644 --- a/README.md +++ b/README.md @@ -12,11 +12,28 @@ opam update opam install starred_ml -TOKEN={{your github personal token}} starred_ml render > README.md +TOKEN={{your github personal token}} starred_ml render > README.md ``` For full option list, run `starred_ml --help`. +## Development + +Clone the repo, then create and configure an opam switch: + +```shell +opam switch create starred_ml ocaml-base-compiler.5.4.1 +eval $(opam env --switch=starred_ml) +opam install . --deps-only --with-test -y +``` + +Build and run tests: + +```shell +dune build +dune test +``` + _See [Templating](#Templating) section for details on the output markdown._ diff --git a/bin/dune b/bin/dune index ade33ca..3eecc1e 100644 --- a/bin/dune +++ b/bin/dune @@ -9,4 +9,4 @@ cmdliner logs.fmt logs.threaded - mirage-crypto-rng-eio)) + mirage-crypto-rng.unix)) diff --git a/bin/main.ml b/bin/main.ml index b502b58..7119094 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -6,6 +6,7 @@ module Github = Starred_ml.Github let () = Logs.set_reporter (Logs_fmt.reporter ()) and () = Logs_threaded.enable () +and () = Printexc.record_backtrace true module Render_cli = struct let name = "render" @@ -46,24 +47,32 @@ module Render_cli = struct & info [ "u"; "url" ] ~env ~docv:"GITHUB_URL" ~doc) let fetch (max_pages : int option) url token template = - Eio_main.run @@ fun env -> - Mirage_crypto_rng_eio.run (module Mirage_crypto_rng.Fortuna) env - @@ fun () -> - let client = - Client.make ~https:(Some (https ~authenticator:null_auth)) env#net - in - Eio.Switch.run @@ fun sw -> - let rec fetch_github l acc curr_page = - match fetch ~sw l client token with - | Some (r, Some next_url) - when Option.value ~default:max_int max_pages >= curr_page -> - fetch_github next_url (acc @ Github.from_string r) (curr_page + 1) - | Some (r, _) -> acc @ Github.from_string r - | None -> acc - in - let content = fetch_github (Format.sprintf "%s?per_page=100" url) [] 1 in - Eio.Stdenv.stdout env - |> Eio.Flow.copy_string @@ print_content content template + try + Eio_main.run @@ fun env -> + Mirage_crypto_rng_unix.use_default (); + let client = + Client.make ~https:(Some (https ~authenticator:null_auth)) env#net + in + Eio.Switch.run @@ fun sw -> + let rec fetch_github l acc curr_page = + match fetch ~sw l client token with + | Some (r, Some next_url) + when Option.value ~default:max_int max_pages >= curr_page -> + fetch_github next_url (acc @ Github.from_string r) (curr_page + 1) + | Some (r, _) -> acc @ Github.from_string r + | None -> acc + in + let content = fetch_github (Format.sprintf "%s?per_page=100" url) [] 1 in + Eio.Stdenv.stdout env + |> Eio.Flow.copy_string @@ print_content content template + with + | Failure msg -> + Printf.eprintf "Error: %s\n" msg; + exit 1 + | exn -> + Printf.eprintf "Fatal: %s\n" (Printexc.to_string exn); + Printexc.print_backtrace stderr; + exit 1 let fetch_t = Term.(const fetch $ max_pages $ url $ token $ template) diff --git a/dune-project b/dune-project index 988851e..3012573 100644 --- a/dune-project +++ b/dune-project @@ -1,4 +1,4 @@ -(lang dune 3.14) +(lang dune 3.21) (name starred_ml) @@ -24,7 +24,7 @@ (>= v0.16.0)) (alcotest (and - (>= 1.7.0) + (>= 1.9.1) :with-test)) (yojson (>= 2.1.2)) @@ -34,8 +34,8 @@ (>= 3.7.0)) (ppx_deriving (>= 5.2.1)) - (mirage-crypto-rng-eio - (>= 1.1.0)) + (mirage-crypto-rng + (>= 1.2.0)) (logs (>= 0.7.0)) (jingoo @@ -43,12 +43,10 @@ (fmt (>= 0.9.0)) (eio_main - (>= 1.2)) + (>= 1.3)) (eio - (>= 1.2)) + (>= 1.3)) (cohttp-eio - (>= 6.0.0)) - (slug - (>= 1.0.1)) + (>= 6.2.1)) ocaml dune)) diff --git a/lib/http_util.ml b/lib/http_util.ml index bfe0d00..70fda59 100644 --- a/lib/http_util.ml +++ b/lib/http_util.ml @@ -31,14 +31,26 @@ let next_link s = in link +let handle_status status = + match status with + | `OK -> () + | `Unauthorized -> + failwith + (Http.Status.to_string status ^ ". Please check the provided token.") + | #Http.Status.client_error | #Http.Status.server_error -> + failwith (Http.Status.to_string status) + | status -> + raise + (Invalid_argument + (Printf.sprintf "Catastrophic failure: unexpected status %s" + (Http.Status.to_string status))) + let fetch ~sw api_url client token = let headers = Http.Header.of_list [ ("Authorization", Format.sprintf "Bearer %s" token) ] in let resp, body = Client.get ~headers ~sw client (Uri.of_string api_url) in - - if Http.Status.compare resp.status `OK = 0 then - Some - ( Eio.Buf_read.(parse_exn take_all) body ~max_size:max_int, - next_link resp.headers ) - else None + handle_status resp.status; + Some + ( Eio.Buf_read.(parse_exn take_all) body ~max_size:max_int, + next_link resp.headers ) diff --git a/starred_ml.opam b/starred_ml.opam index 975c357..8efbd3b 100644 --- a/starred_ml.opam +++ b/starred_ml.opam @@ -10,21 +10,20 @@ bug-reports: "https://github.com/paulosuzart/starred_ml/issues" depends: [ "cmdliner" {>= "1.2.0"} "re2" {>= "v0.16.0"} - "alcotest" {>= "1.7.0" & with-test} + "alcotest" {>= "1.9.1" & with-test} "yojson" {>= "2.1.2"} "tls-eio" {>= "1.0.4"} "ppx_deriving_yojson" {>= "3.7.0"} "ppx_deriving" {>= "5.2.1"} - "mirage-crypto-rng-eio" {>= "1.1.0"} + "mirage-crypto-rng" {>= "1.2.0"} "logs" {>= "0.7.0"} "jingoo" {>= "1.5.0"} "fmt" {>= "0.9.0"} - "eio_main" {>= "1.2"} - "eio" {>= "1.2"} - "cohttp-eio" {>= "6.0.0"} - "slug" {>= "1.0.1"} + "eio_main" {>= "1.3"} + "eio" {>= "1.3"} + "cohttp-eio" {>= "6.2.1"} "ocaml" - "dune" {>= "3.14"} + "dune" {>= "3.21"} "odoc" {with-doc} ] build: [ @@ -42,3 +41,4 @@ build: [ ] ] dev-repo: "git+https://github.com/paulosuzart/starred_ml.git" +x-maintenance-intent: ["(latest)"] diff --git a/test/test_starred_ml.ml b/test/test_starred_ml.ml index 58b4197..0eb82f7 100644 --- a/test/test_starred_ml.ml +++ b/test/test_starred_ml.ml @@ -13,6 +13,9 @@ let starred_pp ppf i = let starred_testable = Alcotest.testable starred_pp ( = ) +(** [test_group] verifies that [by_language] correctly partitions a mixed list + of repos into per-language buckets, preserving insertion order within each + bucket and ordering buckets by first occurrence. *) let test_group () = let sample_java_repo = { @@ -55,17 +58,43 @@ let option_pp ppf o = let testable_link = Alcotest.testable option_pp ( = ) +(** [test_no_next_page] verifies that [next_link] returns [None] when the + [Link] header only contains a [prev] relation, indicating we are on the + last page of Github pagination. *) let test_no_next_page () = Alcotest.(check testable_link) "A last page returns None" None (next_link @@ Http.Header.of_list [ ("Link", "; rel=\"prev\"") ]) +(** [test_next_page] verifies that [next_link] extracts the URL from a [Link] + header that contains a [next] relation, which Github uses to signal there + are more pages of starred repos to fetch. *) let test_next_page () = Alcotest.(check testable_link) - "A last page returns None" (Some "http://s") + "A page with next link returns Some url" (Some "http://s") (next_link @@ Http.Header.of_list [ ("Link", "; rel=\"next\"") ]) +(** [test_unauthorized] checks that a 401 response raises [Failure] with a + message instructing the user to check their token. *) +let test_unauthorized () = + Alcotest.check_raises "401 raises Failure with token hint" + (Failure "401 Unauthorized. Please check the provided token.") (fun () -> + Http_util.handle_status `Unauthorized) + +(** [test_server_error] checks that a 5xx response raises [Failure] with the + HTTP status string, so the caller can surface it directly to the user. *) +let test_server_error () = + Alcotest.check_raises "500 raises Failure with status string" + (Failure "500 Internal Server Error") (fun () -> + Http_util.handle_status `Internal_server_error) + +(** [test_client_error] checks that a generic 4xx response (e.g. 403 Forbidden) + raises [Failure] with the HTTP status string. *) +let test_client_error () = + Alcotest.check_raises "403 raises Failure with status string" + (Failure "403 Forbidden") (fun () -> Http_util.handle_status `Forbidden) + let () = run "Starred_ml" [ @@ -74,5 +103,8 @@ let () = [ test_case "No Pagination" `Quick test_no_next_page; test_case "Next Pat" `Quick test_next_page; + test_case "Unauthorized" `Quick test_unauthorized; + test_case "Server Error" `Quick test_server_error; + test_case "Client Error" `Quick test_client_error; ] ); ]