Paging a connection #

GitHub's GraphQL connections page with cursors (GraphQL Cursor Connections): each page has pageInfo { hasNextPage endCursor }, and the next page is asked with after: set to that endCursor. A stub transport serves a connection of 250 numbered issues, a hundred a page, and records the cursor of each request.

# let member name = function
    | Json.Object (ms, _) -> Option.map snd (Json.Value.member_key name ms)
    | _ -> None;;
val member : string -> Json.t -> Json.t option = <fun>
# let variable name body =
    match Option.bind (member "variables" (Json.Value.of_string_exn body))
            (member name) with
    | Some (Json.String (s, _)) -> Some s
    | _ -> None;;
val variable : string -> string -> string option = <fun>
# let page ~total ~first after =
    let from = Option.fold ~none:0 ~some:int_of_string after in
    let upto = min total (from + first) in
    Fmt.str
      {|{"data":{"repository":{"issues":{"pageInfo":{"hasNextPage":%b,"endCursor":"%d"},"nodes":[%s]}}}}|}
      (upto < total) upto
      (String.concat "," (List.init (upto - from) (fun i -> string_of_int (from + i))));;
val page : total:int -> first:int -> string option -> string = <fun>
# let issues =
    Github_query.Template.v
      "query($owner: String!, $name: String!, $after: String) {
         repository(owner: $owner, name: $name) {
           issues(first: 100, after: $after) {
             pageInfo { hasNextPage endCursor } nodes { number }
           }
         }
       }"
      (fun (owner, name) ->
        [ ("owner", Json.Value.string owner); ("name", Json.Value.string name) ]);;
val issues : (string * string) Github_query.Template.t = <abstr>
# let with_client answer f =
    Eio_mock.Backend.run @@ fun () ->
    let clock = Eio_mock.Clock.make () in
    let store = Cas_store.in_memory ~clock () in
    let sent = ref [] in
    let transport ~headers:_ body =
      sent := variable "after" body :: !sent;
      Ok (Github_query.response ~status:200 (answer body))
    in
    let r = f (Github_query.v ~clock ~store ~token:"t" transport) in
    (r, List.rev !sent);;
val with_client :
  (string -> string) -> (Github_query.t -> 'a) -> 'a * string option list =
  <fun>
# let show = function
    | Ok l -> Fmt.str "%d nodes, %s .. %s" (List.length l)
                (Json.Value.to_string (List.hd l))
                (Json.Value.to_string (List.nth l (List.length l - 1)))
    | Error (Github_query.Graphql es) -> "errors " ^ Json.Value.to_canonical es
    | Error e -> Fmt.str "%a" Github_query.pp_error e;;
val show : (Json.t list, Github_query.error) result -> string = <fun>

Github_query.nodes follows the cursors to the last page. Asked twice under one snapshot, the pages are read back from the store.

# with_client
    (fun body -> page ~total:250 ~first:100 (variable "after" body))
    (fun gq ->
      let ask () =
        Github_query.nodes gq ~policy:(Cas_store.Policy.Snapshot "d")
          ~path:[ "repository"; "issues" ] issues ("ocaml", "dune")
      in
      let first = ask () in
      (show first, show (ask ())));;
- : (string * string) * string option list =
(("250 nodes, 0 .. 249", "250 nodes, 0 .. 249"),
 [None; Some "100"; Some "200"])

until stops at the first node it holds for, and asks no page after it.

# with_client
    (fun body -> page ~total:250 ~first:100 (variable "after" body))
    (fun gq ->
      Github_query.nodes gq ~policy:(Cas_store.Policy.Snapshot "d")
        ~until:(fun n -> Json.Value.to_string n = "150")
        ~path:[ "repository"; "issues" ] issues ("ocaml", "dune")
      |> show);;
- : string * string option list = ("150 nodes, 0 .. 149", [None; Some "100"])

A page that fails makes the whole answer an error, never the nodes read before it.

# with_client
    (fun body ->
      match variable "after" body with
      | Some "200" ->
          {|{"data":{"repository":null},"errors":[{"message":"Something went wrong while executing your query."}]}|}
      | after -> page ~total:250 ~first:100 after)
    (fun gq ->
      Github_query.nodes gq ~policy:(Cas_store.Policy.Snapshot "d")
        ~path:[ "repository"; "issues" ] issues ("ocaml", "dune")
      |> show);;
- : string * string option list =
("errors [{\"message\":\"Something went wrong while executing your query.\"}]",
 [None; Some "100"; Some "200"])

A repository GitHub does not know is Not_found; a page that says there is another one but gives no cursor is Incomplete.

# with_client
    (fun _ ->
      {|{"data":{"repository":null},"errors":[{"type":"NOT_FOUND","path":["repository"],"message":"Could not resolve to a Repository"}]}|})
    (fun gq ->
      Github_query.nodes gq ~policy:(Cas_store.Policy.Snapshot "d")
        ~path:[ "repository"; "issues" ] issues ("ocaml", "gone")
      |> show)
  |> fst;;
- : string = "not found"
# with_client
    (fun _ ->
      {|{"data":{"repository":{"issues":{"pageInfo":{"hasNextPage":true},"nodes":[1]}}}}|})
    (fun gq ->
      Github_query.nodes gq ~policy:(Cas_store.Policy.Snapshot "d")
        ~path:[ "repository"; "issues" ] issues ("ocaml", "dune")
      |> show)
  |> fst;;
- : string = "incomplete answer: no endCursor at repository.issues"

Searches past the cap #

GitHub returns at most 1,000 results of a search (GitHub search docs), and its qualifiers take ranges of RFC 3339 times (Query for dates). A stub search holds 2,500 repositories, the one numbered i created i seconds after the epoch, and answers the count and the pages of a query whose created: range it reads, with no more than 1,000 nodes in all.

# let seconds s =
    match Ptime.of_rfc3339 s with
    | Ok (p, _, _) -> int_of_float (Ptime.to_float_s p)
    | Error _ -> failwith s;;
val seconds : string -> int = <fun>
# let after_prefix prefix s =
    let n = String.length prefix in
    let rec go i =
      if String.sub s i n = prefix then String.sub s (i + n) (String.length s - i - n)
      else go (i + 1)
    in
    go 0;;
val after_prefix : string -> string -> string = <fun>
# let search ~created body =
    let q = Option.get (variable "q" body) in
    let lo, hi =
      match String.split_on_char '.' (after_prefix "created:" q) with
      | [ lo; ""; hi ] -> (seconds lo, seconds hi)
      | _ -> failwith q
    in
    let hits = List.filter (fun c -> c >= lo && c <= hi) created in
    let from = Option.fold ~none:0 ~some:int_of_string (variable "after" body) in
    let page = List.filteri (fun j _ -> j >= from && j < from + 100 && j < 1000) hits in
    let upto = from + List.length page in
    Fmt.str
      {|{"data":{"search":{"repositoryCount":%d,"pageInfo":{"hasNextPage":%b,"endCursor":"%d"},"nodes":[%s]}}}|}
      (List.length hits) (upto < min 1000 (List.length hits)) upto
      (String.concat "," (List.map string_of_int page));;
val search : created:int list -> string -> string = <fun>
# let range n =
    (Ptime.epoch, Option.get (Ptime.of_float_s (float_of_int n)));;
val range : int -> Ptime.t * Ptime.t = <fun>

The 2,500 results come back whole and in order.

# let created = List.init 2500 Fun.id in
  let found, _ =
    with_client (search ~created) (fun gq ->
      Github_query.Search.nodes gq ~policy:(Cas_store.Policy.Snapshot "d")
        ~kind:Github_query.Search.Repository ~fields:"... on Repository { name }"
        ~range:(range 2499) "language:OCaml")
  in
  ( show found,
    List.map Json.Value.to_string (Result.get_ok found)
    = List.map string_of_int created );;
- : string * bool = ("2500 nodes, 0 .. 2499", true)

More than 1,000 results created in one second cannot be split further: the search is Incomplete, not its first 1,000 results.

# with_client (search ~created:(List.init 1500 (fun _ -> 7))) (fun gq ->
    Github_query.Search.nodes gq ~policy:(Cas_store.Policy.Snapshot "d")
      ~kind:Github_query.Search.Repository ~fields:"... on Repository { name }"
      ~range:(range 10) "language:OCaml"
    |> show)
  |> fst;;
- : string =
"incomplete answer: 1500 results over the cap of 1000 in language:OCaml created:1970-01-01T00:00:07+00:00..1970-01-01T00:00:07+00:00"