Handling error

.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 }}

.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 }}

.ocamlformat

@@ -1,2 +1,2 @@
 profile = default
-version = 0.27.0
+version = 0.28.1

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._
 

bin/dune

@@ -9,4 +9,4 @@
   cmdliner
   logs.fmt
   logs.threaded
-  mirage-crypto-rng-eio))
+  mirage-crypto-rng.unix))

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)
 

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,21 +34,19 @@
    (>= 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))
+   (>= 1.3))
   (eio
-   (>= 1.2))
+   (>= 1.3))
   (cohttp-eio
-   (>= 6.0.0))
-  (slug
-   (>= 1.0.1))
+   (>= 6.2.1))
   ocaml
   dune))

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 )

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)"]

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", "<http://prev>; 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", "<http://s>; 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;
         ] );
     ]