diff options
| author | Murilo Ijanc <[email protected]> | 2026-07-26 12:21:46 -0300 |
|---|---|---|
| committer | Murilo Ijanc <[email protected]> | 2026-07-26 12:21:46 -0300 |
| commit | 5598ea80735a51cb7b3690837b2b7d4240331b2d (patch) | |
| tree | 5ff0927a035ebe521c1b8d6a91fc547c81604631 | |
| download | ocaml-5598ea80735a51cb7b3690837b2b7d4240331b2d.tar.gz | |
Initial importv0.1.0
| -rw-r--r-- | .gitignore | 4 | ||||
| -rw-r--r-- | .ocamlformat | 2 | ||||
| -rw-r--r-- | LICENSE | 15 | ||||
| -rw-r--r-- | Makefile | 34 | ||||
| -rw-r--r-- | README.md | 190 | ||||
| -rw-r--r-- | cepis.opam | 33 | ||||
| -rw-r--r-- | dune-project | 30 | ||||
| -rw-r--r-- | lib/cepis.ml | 539 | ||||
| -rw-r--r-- | lib/cepis.mli | 283 | ||||
| -rw-r--r-- | lib/dune | 4 | ||||
| -rw-r--r-- | test/dune | 3 | ||||
| -rw-r--r-- | test/test_cepis.ml | 569 |
12 files changed, 1706 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..f80885d --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +_build/ +_opam/ +*.install +*.merlin diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 0000000..e7381c0 --- /dev/null +++ b/.ocamlformat @@ -0,0 +1,2 @@ +profile = default +margin = 80 @@ -0,0 +1,15 @@ +ISC License + +Copyright (c) 2026 Murilo Ijanc <[email protected]> + +Permission to use, copy, modify, and/or distribute this software for any +purpose with or without fee is hereby granted, provided that the above +copyright notice and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH +REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY +AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, +INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM +LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR +OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR +PERFORMANCE OF THIS SOFTWARE. diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..6430738 --- /dev/null +++ b/Makefile @@ -0,0 +1,34 @@ +DUNE ?= dune + +.DEFAULT_GOAL := help +.PHONY: help test lint format build check clean doc + +help: + @echo 'Targets:' + @echo ' test run the test suite' + @echo ' lint check formatting with ocamlformat (read-only)' + @echo ' format apply ocamlformat (writes)' + @echo ' build build the library' + @echo ' check lint + test + build, in that order' + @echo ' doc build the odoc documentation' + @echo ' clean remove build artefacts' + +test: + $(DUNE) runtest --force --no-buffer + +lint: + $(DUNE) build @fmt + +format: + $(DUNE) fmt + +build: + $(DUNE) build @install + +check: lint test build + +doc: + $(DUNE) build @doc + +clean: + $(DUNE) clean diff --git a/README.md b/README.md new file mode 100644 index 0000000..4e1a18f --- /dev/null +++ b/README.md @@ -0,0 +1,190 @@ +# cepis + +OCaml client for the [public CEP API at cep.is](https://cep.is). Official +Correios data (DNE), refreshed every two weeks. + +```ocaml +match Cepis.lookup "01001-000" with +| Ok a -> Printf.printf "%s %s %s\n" a.Cepis.logradouro a.Cepis.localidade a.Cepis.uf +(* Praça da Sé São Paulo SP *) +| Error e -> prerr_endline (Cepis.string_of_error e) +``` + +## Installation + +```sh +opam pin add cepis git+https://git.cep.is/ocaml.git +``` + +Requires OCaml 4.14 or newer. + +Three dependencies, each because the standard library has no equivalent: +[`ezcurl`](https://github.com/c-cube/ezcurl) for HTTP, because it is +synchronous and does not force an async runtime on callers; +[`yojson`](https://github.com/ocaml-community/yojson) for JSON, the +conventional choice; and [`csv`](https://github.com/Chris00/ocaml-csv) for the +batch endpoint, whose values may be quoted and contain commas. `ezcurl` binds +libcurl, so its development headers must be present; opam installs them for +you on most systems. + +## Usage + +### A single lookup + +`lookup` accepts the CEP masked or unmasked and returns an `address`: + +```ocaml +let a = Result.get_ok (Cepis.lookup "01310-100") in +a.Cepis.logradouro (* "Avenida Paulista" *) +a.Cepis.localidade (* "São Paulo" *) +a.Cepis.uf (* "SP" *) +a.Cepis.ibge (* "3550308" *) +a.Cepis.cep (* "01310100" (always unmasked) *) +Cepis.formatted_cep a (* "01310-100" *) +``` + +Fields the database does not have for that CEP come back as empty strings. + +### Coordinates + +About 57% of CEPs have a coordinate. When they do not, `geo` is `None`: + +```ocaml +match a.Cepis.geo with +| Some g -> Printf.printf "%f %f %d %s\n" g.Cepis.lat g.Cepis.lon g.Cepis.raio_m g.Cepis.precisao +| None -> () +``` + +**Check `precisao` before computing distance.** There are two kinds of point, +and the difference between them is tens of kilometres: + +| `precisao` | typical radius | what the point is | +| --- | --- | --- | +| `logradouro` | 110–140 m | the stretch of street — good for maps and distance | +| `localidade` | 7–40 km | the municipality centroid: the CEP *is* the whole city | + +`Cepis.is_precise` is the shorthand for `precisao = "logradouro"`: + +```ocaml +match a.Cepis.geo with +| Some g when Cepis.is_precise g -> shipping_from g.Cepis.lat g.Cepis.lon +| _ -> shipping_from_municipality a.Cepis.ibge +``` + +### Many CEPs at once + +Do not loop over `lookup`. Use `lookup_many`, which resolves up to 500 CEPs +per request: + +```ocaml +let ceps = [ "01001000"; "99999999"; "20040020" ] in +match Cepis.lookup_many ceps with +| Ok rows -> + List.iter2 + (fun cep -> function + | None -> Printf.printf "%s: not found\n" cep + | Some a -> Printf.printf "%s: %s\n" cep a.Cepis.localidade) + ceps rows +| Error e -> prerr_endline (Cepis.string_of_error e) +``` + +The list returned has **the same length and the same order** as the input. A +CEP that does not exist, or is malformed, becomes `None` at its position — it +does not vanish, and it does not fail the call. + +Lists longer than 500 are chunked automatically. + +> **Batches carry no coordinate.** The endpoint behind them is CSV, and the +> CSV has no `geo` column. Every address from `lookup_many` has `geo = None`, +> including for CEPs that do have one. Need `geo`? Use `lookup`, one at a time. + +### API health + +Useful for two things: checking the API answers, and knowing **which version +of the database** is live: + +```ocaml +let h = Result.get_ok (Cepis.health ()) in +Cepis.is_ok h (* true *) +h.Cepis.dne (* "26071" identifier of the fortnightly database *) +h.Cepis.ceps (* 1596168 *) +h.Cepis.base_gerada_em (* "2026-07-24T03:48:28Z" *) +``` + +An API reporting itself degraded is not an error — that arrives in `h.status`. + +## Configuration + +For anything beyond the defaults, build a `Cepis.Client.t` and reuse it. It +keeps no state between calls: + +```ocaml +let client = + Cepis.Client.create + ~base_url:"https://cep.is" (* point at another instance *) + ~timeout:10.0 (* seconds for one attempt, connection included *) + ~max_attempts:3 (* counting the first; 1 disables retrying *) + ~backoff_base:0.5 (* base of the exponential wait *) + ~backoff_max:8.0 (* cap on each wait *) + ~total_timeout:15.0 (* cap on the whole call, attempts included *) + () + +let address = Cepis.Client.lookup client "01001000" +``` + +Retries cover 429, 5xx and network failures, with exponential backoff and +jitter; 400 and 404 are never retried. See `Cepis.Client.create` in the +interface for the details of each parameter. + +The module-level functions (`Cepis.lookup`, etc.) share a default client built +with the defaults. Need a different configuration? Build your own. + +### Pointing at a local instance + +`base_url` is the only parameter that usually changes between environments. +The API repo brings a local instance up with `just up`: + +```ocaml +let client = Cepis.Client.create ~base_url:"http://localhost:8080" () +``` + +## Errors + +Expected failures come back as `('a, Cepis.error) result`; only a nonsensical +configuration raises, as `Invalid_argument`. The variants split by **the +decision you have to make**, not by the HTTP status that caused it: + +| error | when | does retrying help? | +| --- | --- | --- | +| `Invalid_cep` | not 8 digits | no | +| `Cep_not_found` | well-formed, not in the database | no | +| `Rate_limited` | 429; carries `retry_after` | yes, later | +| `Server_error` | 5xx; carries `status` | yes, later | +| `Network_error` | DNS, connection, timeout, TLS | yes, later | +| `Invalid_response` | unintelligible response | probably not | + +```ocaml +match Cepis.lookup cep_from_form with +| Ok address -> use address +| Error (Cepis.Cep_not_found _) -> ask_for_another_cep () +| Error _ -> reschedule () +``` + +`Invalid_response` almost always means something between you and the API is +answering instead of it — a captive Wi-Fi portal, a corporate proxy, an HTML +error page. Useful as a diagnosis: the problem is not in your code. + +## Development + +```sh +make # list the targets +make test # run the suite against a local HTTP server +make lint # ocamlformat check, touches nothing +make build # build the library +make check # lint, then test, then build +make doc # odoc documentation +``` + +## Licence + +ISC. See [LICENSE](LICENSE). diff --git a/cepis.opam b/cepis.opam new file mode 100644 index 0000000..9b497ad --- /dev/null +++ b/cepis.opam @@ -0,0 +1,33 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "0.1.0" +synopsis: "Client for the public CEP API at cep.is" +description: + "Look up Brazilian postal codes (CEP) against the public API at https://cep.is, which serves official Correios data (DNE) refreshed every two weeks. Single lookups carry a coordinate when the database has one; batches resolve up to 500 CEPs per request." +maintainer: ["Murilo Ijanc <[email protected]>"] +authors: ["Murilo Ijanc <[email protected]>"] +license: "ISC" +homepage: "https://cep.is" +depends: [ + "dune" {>= "3.0"} + "ocaml" {>= "4.14"} + "yojson" + "csv" + "ezcurl" + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://git.cep.is/ocaml.git" diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..3e7fa0f --- /dev/null +++ b/dune-project @@ -0,0 +1,30 @@ +(lang dune 3.0) + +(name cepis) + +(version 0.1.0) + +(generate_opam_files true) + +(license ISC) + +(authors "Murilo Ijanc <[email protected]>") + +(maintainers "Murilo Ijanc <[email protected]>") + +(source + (uri git+https://git.cep.is/ocaml.git)) + +(homepage "https://cep.is") + +(package + (name cepis) + (synopsis "Client for the public CEP API at cep.is") + (description + "Look up Brazilian postal codes (CEP) against the public API at https://cep.is, which serves official Correios data (DNE) refreshed every two weeks. Single lookups carry a coordinate when the database has one; batches resolve up to 500 CEPs per request.") + (depends + (ocaml + (>= 4.14)) + yojson + csv + ezcurl)) diff --git a/lib/cepis.ml b/lib/cepis.ml new file mode 100644 index 0000000..a168d37 --- /dev/null +++ b/lib/cepis.ml @@ -0,0 +1,539 @@ +let version = "0.1.0" +let default_url = "https://cep.is" +let max_batch = 500 + +type geo = { lat : float; lon : float; raio_m : int; precisao : string } + +let is_precise g = String.equal g.precisao "logradouro" + +type address = { + cep : string; + logradouro : string; + complemento : string; + unidade : string; + bairro : string; + localidade : string; + uf : string; + estado : string; + regiao : string; + ibge : string; + gia : string; + ddd : string; + siafi : string; + geo : geo option; + raw : (string * Yojson.Safe.t) list; +} + +let formatted_cep a = + if String.length a.cep = 8 then + String.sub a.cep 0 5 ^ "-" ^ String.sub a.cep 5 3 + else a.cep + +type health = { + status : string; + dne : string; + ceps : int; + geo : int; + base_gerada_em : string; +} + +let is_ok h = String.equal h.status "ok" + +type error = + | Invalid_cep of string + | Cep_not_found of string + | Rate_limited of { message : string; retry_after : float option } + | Server_error of { message : string; status : int } + | Network_error of string + | Invalid_response of string + +let error_message = function + | Invalid_cep m | Cep_not_found m | Network_error m | Invalid_response m -> m + | Rate_limited { message; _ } | Server_error { message; _ } -> message + +let string_of_error = function + | Invalid_cep m -> "invalid CEP: " ^ m + | Cep_not_found m -> "CEP not found: " ^ m + | Rate_limited { message; retry_after = Some s } -> + Printf.sprintf "rate limited (retry after %gs): %s" s message + | Rate_limited { message; retry_after = None } -> "rate limited: " ^ message + | Server_error { message; status } -> + Printf.sprintf "server error (%d): %s" status message + | Network_error m -> "network error: " ^ m + | Invalid_response m -> "invalid response: " ^ m + +let is_digit c = c >= '0' && c <= '9' + +let normalize_cep value = + let buf = Buffer.create 8 in + String.iter + (fun c -> match c with '-' | '.' | ' ' -> () | c -> Buffer.add_char buf c) + (String.trim value); + let cleaned = Buffer.contents buf in + let ok = + String.length cleaned = 8 && String.for_all (fun c -> is_digit c) cleaned + in + if ok then Ok cleaned + else Error (Invalid_cep (Printf.sprintf "CEP must be 8 digits, got %S" value)) + +let json_to_string = function + | `String s -> s + | `Int i -> string_of_int i + | `Intlit s -> s + | `Float f -> + if Float.is_integer f then Printf.sprintf "%.0f" f + else Printf.sprintf "%g" f + | `Bool b -> string_of_bool b + | _ -> "" + +let json_to_float = function + | `Int i -> Some (float_of_int i) + | `Float f -> Some f + | `Intlit s | `String s -> float_of_string_opt s + | _ -> None + +let field fields key = + match List.assoc_opt key fields with Some v -> v | None -> `Null + +let string_field fields key = json_to_string (field fields key) + +let int_field fields key = + match field fields key with + | `Int i -> i + | `Float f -> int_of_float f + | `Intlit s | `String s -> ( + match int_of_string_opt s with Some i -> i | None -> 0) + | _ -> 0 + +let geo_of_json = function + | `Assoc fields -> ( + match + ( json_to_float (field fields "lat"), + json_to_float (field fields "lon"), + json_to_float (field fields "raio_m"), + field fields "precisao" ) + with + | Some lat, Some lon, Some raio_m, ((`String _ | `Int _ | `Float _) as p) + -> + Some + { + lat; + lon; + raio_m = int_of_float raio_m; + precisao = json_to_string p; + } + | _ -> None) + | _ -> None + +let address_of_fields fields = + { + cep = string_field fields "cep"; + logradouro = string_field fields "logradouro"; + complemento = string_field fields "complemento"; + unidade = string_field fields "unidade"; + bairro = string_field fields "bairro"; + localidade = string_field fields "localidade"; + uf = string_field fields "uf"; + estado = string_field fields "estado"; + regiao = string_field fields "regiao"; + ibge = string_field fields "ibge"; + gia = string_field fields "gia"; + ddd = string_field fields "ddd"; + siafi = string_field fields "siafi"; + geo = geo_of_json (field fields "geo"); + raw = fields; + } + +let health_of_fields fields = + { + status = string_field fields "status"; + dne = string_field fields "dne"; + ceps = int_field fields "ceps"; + geo = int_field fields "geo"; + base_gerada_em = string_field fields "base_gerada_em"; + } + +let json_kind = function + | `Assoc _ -> "object" + | `List _ -> "array" + | `String _ -> "string" + | `Int _ | `Intlit _ -> "int" + | `Float _ -> "float" + | `Bool _ -> "bool" + | `Null -> "null" + | _ -> "value" + +let truncate_body body = + if String.length body <= 120 then body else String.sub body 0 120 ^ "..." + +let json_object_of_body body = + match Yojson.Safe.from_string body with + | `Assoc fields -> Ok fields + | other -> + Error + (Invalid_response + (Printf.sprintf "expected a JSON object, got %s" (json_kind other))) + | exception _ -> + Error + (Invalid_response + (Printf.sprintf + "response is not valid JSON — something between you and the API \ + is answering instead of it: %S" + (truncate_body body))) + +let api_message body fallback = + match Yojson.Safe.from_string body with + | `Assoc fields -> ( + match field fields "mensagem" with + | `String m when m <> "" -> m + | _ -> fallback) + | _ -> fallback + | exception _ -> fallback + +let months = + [| + "jan"; + "feb"; + "mar"; + "apr"; + "may"; + "jun"; + "jul"; + "aug"; + "sep"; + "oct"; + "nov"; + "dec"; + |] + +let month_index name = + let name = String.lowercase_ascii name in + let name = if String.length name > 3 then String.sub name 0 3 else name in + let found = ref None in + Array.iteri + (fun i m -> if String.equal m name then found := Some (i + 1)) + months; + !found + +let days_from_civil y m d = + let y = if m <= 2 then y - 1 else y in + let era = (if y >= 0 then y else y - 399) / 400 in + let yoe = y - (era * 400) in + let mp = (m + 9) mod 12 in + let doy = (((153 * mp) + 2) / 5) + d - 1 in + let doe = (yoe * 365) + (yoe / 4) - (yoe / 100) + doy in + (era * 146097) + doe - 719468 + +let words s = + String.split_on_char ' ' (String.map (function ',' -> ' ' | c -> c) s) + |> List.filter (fun w -> w <> "") + +let parse_http_date value = + let tokens = + match words value with + | first :: rest when String.length first > 0 && not (is_digit first.[0]) -> + rest + | tokens -> tokens + in + match tokens with + | day :: month :: year :: time :: _ -> ( + match + ( int_of_string_opt day, + month_index month, + int_of_string_opt year, + String.split_on_char ':' time ) + with + | Some day, Some month, Some year, [ h; mi; s ] -> ( + match + (int_of_string_opt h, int_of_string_opt mi, int_of_string_opt s) + with + | Some h, Some mi, Some s -> + Some + ((float_of_int (days_from_civil year month day) *. 86400.) + +. float_of_int ((h * 3600) + (mi * 60) + s)) + | _ -> None) + | _ -> None) + | _ -> None + +let retry_after_seconds = function + | None -> None + | Some value -> ( + let value = String.trim value in + match float_of_string_opt value with + | Some seconds -> Some (Float.max 0. seconds) + | None -> ( + match parse_http_date value with + | Some target -> Some (Float.max 0. (target -. Unix.gettimeofday ())) + | None -> None)) + +let header_value headers name = + let name = String.lowercase_ascii name in + List.fold_left + (fun acc (k, v) -> + if String.equal (String.lowercase_ascii (String.trim k)) name then + Some (String.trim v) + else acc) + None headers + +let retriable_status = [ 429; 500; 502; 503; 504 ] + +let unreserved c = + is_digit c + || (c >= 'a' && c <= 'z') + || (c >= 'A' && c <= 'Z') + || c = '-' || c = '_' || c = '.' || c = '~' + +let url_encode s = + let buf = Buffer.create (String.length s) in + String.iter + (fun c -> + if unreserved c then Buffer.add_char buf c + else Buffer.add_string buf (Printf.sprintf "%%%02X" (Char.code c))) + s; + Buffer.contents buf + +let strip_bom s = + if String.length s >= 3 && String.sub s 0 3 = "\xef\xbb\xbf" then + String.sub s 3 (String.length s - 3) + else s + +let csv_rows body = + match Csv.input_all (Csv.of_string (strip_bom body)) with + | [] -> [] + | header :: rows -> + let width = List.length header in + List.filter_map + (fun row -> + if List.for_all (fun cell -> String.trim cell = "") row then None + else + let padded = + List.init width (fun i -> try List.nth row i with _ -> "") + in + Some (List.combine header padded)) + rows + +let jitter = lazy (Random.State.make_self_init ()) + +module Client = struct + type t = { + base_url : string; + timeout : float; + max_attempts : int; + backoff_base : float; + backoff_max : float; + total_timeout : float option; + user_agent : string; + } + + let rec strip_trailing_slash s = + let n = String.length s in + if n > 0 && s.[n - 1] = '/' then + strip_trailing_slash (String.sub s 0 (n - 1)) + else s + + let create ?(base_url = default_url) ?(timeout = 10.) ?(max_attempts = 3) + ?(backoff_base = 0.5) ?(backoff_max = 8.) ?total_timeout ?user_agent () = + if max_attempts < 1 then + invalid_arg "Cepis.Client.create: max_attempts must be >= 1"; + if timeout <= 0. then invalid_arg "Cepis.Client.create: timeout must be > 0"; + { + base_url = strip_trailing_slash base_url; + timeout; + max_attempts; + backoff_base; + backoff_max; + total_timeout; + user_agent = + (match user_agent with + | Some ua -> ua + | None -> Printf.sprintf "cepis-ocaml/%s (+https://cep.is)" version); + } + + let base_url t = t.base_url + let user_agent t = t.user_agent + + let perform t url = + let config = + Ezcurl.Config.( + default |> follow_location true |> max_redirects 5 |> verbose false) + in + let set_opts curl = + let ms = int_of_float (t.timeout *. 1000.) in + Curl.set_timeoutms curl ms; + Curl.set_connecttimeoutms curl ms + in + match + Ezcurl.with_client ~set_opts (fun client -> + Ezcurl.get ~client ~config ~tries:1 + ~headers: + [ + ("User-Agent", t.user_agent); + ("Accept", "application/json, text/csv;q=0.9, */*;q=0.1"); + ("Accept-Encoding", "identity"); + ] + ~url ()) + with + | Ok response -> + Ok (response.Ezcurl.code, response.Ezcurl.body, response.Ezcurl.headers) + | Error (_, message) -> Error message + | exception Curl.CurlException (_, _, message) -> Error message + + let backoff t attempt retry_after = + match retry_after with + | Some seconds -> Float.min seconds t.backoff_max + | None -> + let ceiling = + Float.min + (t.backoff_base *. (2. ** float_of_int (attempt - 1))) + t.backoff_max + in + if ceiling <= 0. then 0. + else Random.State.float (Lazy.force jitter) ceiling + + let expired = function + | None -> false + | Some deadline -> Unix.gettimeofday () >= deadline + + let request t ?(accepted_status = [ 200 ]) path = + let url = t.base_url ^ path in + let deadline = + match t.total_timeout with + | None -> None + | Some total -> Some (Unix.gettimeofday () +. total) + in + let attempts = t.max_attempts in + let give_up status retry_after network = + match status with + | Some 429 -> + Error + (Rate_limited + { + message = + Printf.sprintf + "rate limit reached at %s (after %d attempt(s))" url + attempts; + retry_after; + }) + | Some status -> + Error + (Server_error + { + message = + Printf.sprintf + "the API answered %d at %s (after %d attempt(s))" status + url attempts; + status; + }) + | None -> + Error + (Network_error + (Printf.sprintf "could not reach %s (after %d attempt(s)): %s" + url attempts + (match network with + | Some m -> m + | None -> "deadline reached"))) + in + let wait_then t attempt retry_after = + let wait = backoff t attempt retry_after in + match deadline with + | None -> + if wait > 0. then Unix.sleepf wait; + true + | Some deadline -> + let remaining = deadline -. Unix.gettimeofday () in + if remaining <= 0. then false + else begin + let wait = Float.min wait remaining in + if wait > 0. then Unix.sleepf wait; + true + end + in + let rec attempt n status retry_after network = + if n > attempts || expired deadline then + give_up status retry_after network + else + match perform t url with + | Ok (code, body, _) + when List.mem code accepted_status + || not (List.mem code retriable_status) -> + Ok (code, body) + | Ok (code, _, headers) -> + let retry_after = + retry_after_seconds (header_value headers "Retry-After") + in + if n >= attempts then give_up (Some code) retry_after None + else if wait_then t n retry_after then + attempt (n + 1) (Some code) retry_after None + else give_up (Some code) retry_after None + | Error message -> + if n >= attempts then give_up None None (Some message) + else if wait_then t n None then + attempt (n + 1) None None (Some message) + else give_up None None (Some message) + in + attempt 1 None None None + + let ( let* ) = Result.bind + + let lookup t cep = + let* number = normalize_cep cep in + let* code, body = request t ("/" ^ number) in + if code = 404 then + Error + (Cep_not_found + (Printf.sprintf "CEP %s does not exist in the DNE database" number)) + else if code = 400 then + Error + (Invalid_cep + (api_message body (Printf.sprintf "CEP %s rejected" number))) + else + let* fields = json_object_of_body body in + Ok (address_of_fields fields) + + let lookup_chunk t ceps = + let query = url_encode (String.concat "," ceps) in + let* _, body = request t ("/csv?ceps=" ^ query) in + let rows = + List.map + (fun row -> + match List.assoc_opt "localidade" row with + | Some place when String.trim place <> "" -> + Some + (address_of_fields + (List.map (fun (k, v) -> (k, `String v)) row)) + | _ -> None) + (csv_rows body) + in + let wanted = List.length ceps in + let got = List.length rows in + if got = wanted then Ok rows + else if got > wanted then Ok (List.filteri (fun i _ -> i < wanted) rows) + else Ok (rows @ List.init (wanted - got) (fun _ -> None)) + + let rec chunks size list = + if list = [] then [] + else + let head = List.filteri (fun i _ -> i < size) list in + let tail = List.filteri (fun i _ -> i >= size) list in + head :: chunks size tail + + let lookup_many t ceps = + if ceps = [] then Ok [] + else + List.fold_left + (fun acc chunk -> + let* acc = acc in + let* rows = lookup_chunk t chunk in + Ok (acc @ rows)) + (Ok []) (chunks max_batch ceps) + + let health t = + let* _, body = request t ~accepted_status:[ 200; 503 ] "/health" in + let* fields = json_object_of_body body in + Ok (health_of_fields fields) +end + +let default = lazy (Client.create ()) +let lookup cep = Client.lookup (Lazy.force default) cep +let lookup_many ceps = Client.lookup_many (Lazy.force default) ceps +let health () = Client.health (Lazy.force default) diff --git a/lib/cepis.mli b/lib/cepis.mli new file mode 100644 index 0000000..3deeb0b --- /dev/null +++ b/lib/cepis.mli @@ -0,0 +1,283 @@ +(** OCaml client for the public CEP API at {{:https://cep.is} cep.is}. + + Quick use — the module-level functions share one default client: + + {[ + match Cepis.lookup "01001-000" with + | Ok a -> print_endline (a.Cepis.localidade ^ " " ^ a.Cepis.uf) + | Error e -> prerr_endline (Cepis.string_of_error e) + ]} + + In an application, build a {!Client.t} once and reuse it: + + {[ + let client = Cepis.Client.create ~timeout:5.0 ~total_timeout:15.0 () + let address = Cepis.Client.lookup client "01001000" + ]} + + Expected failures come back as [('a, error) result]. Only programmer errors + — a nonsensical configuration — raise, as [Invalid_argument]. + + Note on field names: the API surface is English, but the + {b data fields keep the API's own Portuguese names} ([logradouro], [bairro], + [localidade]). What you read in the JSON is what you access on the record. +*) + +val version : string +(** Version of this library, as it appears in the default [User-Agent]. *) + +val default_url : string +(** Where the public API lives: [https://cep.is]. *) + +val max_batch : int +(** How many CEPs the API accepts in one batch: 500. {!Client.lookup_many} + chunks longer input at this size on its own. *) + +(** {1 Data} *) + +type geo = { lat : float; lon : float; raio_m : int; precisao : string } +(** The CEP's coordinate, when the database has one. + + The point is the {b median} of the coordinates of that CEP's addresses, not + the mean: one badly geocoded address 40 km away shifts a mean and does not + move a median. + + Always check [precisao] before using [lat]/[lon] for distance: + + - ["logradouro"]: the point is a stretch of street. [raio_m] lands around + 100–150 m. Good for maps and for distance. + - ["localidade"]: the CEP {i is} the whole municipality (a city-wide general + CEP), and the point is its centroid. [raio_m] runs from 7 km to 40 km. + Computing shipping from this is wrong by tens of kilometres. + + [raio_m] is the radius containing 90% of that CEP's addresses. It exists + precisely so that error cannot pass unnoticed. *) + +val is_precise : geo -> bool +(** [true] when the coordinate points at a street, not a municipality. + + Shorthand for [precisao = "logradouro"], which is the check to make before + using the point to measure distance. *) + +type address = { + cep : string; + logradouro : string; + complemento : string; + unidade : string; + bairro : string; + localidade : string; + uf : string; + estado : string; + regiao : string; + ibge : string; + gia : string; + ddd : string; + siafi : string; + geo : geo option; + raw : (string * Yojson.Safe.t) list; +} +(** A CEP and everything the database knows about it. + + Fields the database does not have for that CEP come back as empty strings, + never absent — that is what the API returns, and changing it here would + create a difference between reading the JSON and reading this library. + + [geo] is the exception: it is [None] when there is no coordinate. There the + difference is real, because the API {b omits} the whole field in that case + (about 43% of CEPs) rather than sending null. + + [raw] holds the response's fields exactly as they arrived, uninterpreted, so + a field the API grows before this library is updated is not lost. For an + address that came from a batch it holds that CSV row's columns, every value + a string. *) + +val formatted_cep : address -> string +(** The CEP with its mask: ["01001-000"]. + + The native contract always returns it unmasked; formatting is presentation, + and it lives here so it does not become a repeated [Printf.sprintf] in every + project that uses this. *) + +type health = { + status : string; + dne : string; + ceps : int; + geo : int; + base_gerada_em : string; +} +(** The response of [GET /health]. + + Good for two things: checking that the API answers, and knowing + {b which version of the database} is live. The DNE database changes every + two weeks; [dne] identifies it. *) + +val is_ok : health -> bool +(** [true] when the API reports itself healthy. *) + +(** {1 Errors} *) + +(** Everything that can go wrong, split by + {b the decision the caller has to make} rather than by the HTTP status that + caused it. + + {!Invalid_cep} and {!Cep_not_found} are problems with the {i request}: the + same CEP will fail again. {!Network_error}, {!Server_error} and + {!Rate_limited} are problems with {i transport}: retrying may help, and the + client already retried on its own before returning any of them. *) +type error = + | Invalid_cep of string + (** The CEP is not 8 digits. Usually produced {b without} a request ever + being made — the client checks the format before going to the network. + Retrying is pointless. *) + | Cep_not_found of string + (** The CEP is well-formed but does not exist in the DNE database. + Retrying is pointless. *) + | Rate_limited of { message : string; retry_after : float option } + (** The API (or the edge in front of it) answered 429 on every attempt. + [retry_after] is what the server asked for, in seconds, or [None] if + it did not say. The client already honoured that value across the + attempts it made; it is exposed for callers who want to reschedule the + work. *) + | Server_error of { message : string; status : int } + (** The API answered 5xx on every attempt. [status] is the one seen on the + last attempt. Retrying later may help. *) + | Network_error of string + (** The request never completed: DNS, refused connection, timeout, TLS. + Returned only after every configured attempt has failed. Retrying + later may help. *) + | Invalid_response of string + (** A success status came back with a body that cannot be parsed. In + practice this means something between you and the API is answering + instead of it — a captive Wi-Fi portal, a corporate proxy, an HTML + error page. Useful as a diagnosis: the problem is not in your code. *) + +val error_message : error -> string +(** The human-readable message carried by an error, without its kind. *) + +val string_of_error : error -> string +(** The error rendered for a log line: kind, then message. *) + +(** {1 Validation} *) + +val normalize_cep : string -> (string, error) result +(** [normalize_cep value] returns the CEP's 8 digits, accepting the mask. + + ["01001-000"], ["01001000"] and [" 01001-000 "] all become ["01001000"]. + + Returns {!Invalid_cep} unless exactly 8 digits remain. This runs {b before} + any request: a 7-digit CEP is the caller's bug, and spending a round trip + for the server to say so wastes both sides' time. *) + +(** {1 Client} *) + +(** The configured client. Reuse one instance: the configuration is immutable + and no function keeps state between calls. *) +module Client : sig + type t + (** A client and its configuration. *) + + val create : + ?base_url:string -> + ?timeout:float -> + ?max_attempts:int -> + ?backoff_base:float -> + ?backoff_max:float -> + ?total_timeout:float -> + ?user_agent:string -> + unit -> + t + (** Build a client. + + @param base_url + Where the API lives, default {!default_url}. Point it at a local + instance (the API repo brings one up on [http://localhost:8080] with + [just up]) or at a test server. It is the only parameter that usually + changes between environments. Trailing slashes are stripped, so it + cannot produce doubled separators that some proxies normalise and others + 404. + @param timeout + Seconds allowed for {b one attempt}, connection included, default [10.]. + It is not a cap on the whole call — that cap is [total_timeout]. + @param max_attempts + How many attempts in total, counting the first, default [3]. [1] + disables retrying. The default covers the common case (one transient + failure) without turning a real outage into a long wait. + @param backoff_base + Base of the exponential wait in seconds, default [0.5]. The actual wait + is drawn from [[0, base * 2 ** (n-1)]] — {i full jitter}. The randomness + is not decoration: without it, N clients that fail together come back + together and reproduce the spike that took the service down. + @param backoff_max + Cap on each individual wait in seconds, default [8.]. It applies to a + server-sent [Retry-After] too, or a [Retry-After: 3600] from a + misconfigured proxy would park the caller for an hour. + @param total_timeout + Cap on the whole call, attempts and waits included. Absent leaves + [max_attempts] as the only bound. Set it in code serving a web request: + without it the worst case is [max_attempts * timeout] plus the sum of + the backoffs. + @param user_agent + Overrides the [User-Agent]. The default identifies the library and its + version, which is what lets the server diagnose an old client + misbehaving. + @raise Invalid_argument + if [max_attempts] is below 1 or [timeout] is not positive. *) + + val base_url : t -> string + (** The base URL the client was built with, trailing slashes stripped. *) + + val user_agent : t -> string + (** The [User-Agent] this client sends. *) + + val lookup : t -> string -> (address, error) result + (** [lookup client cep] resolves a single CEP, masked or unmasked. + + A 400 from the API surfaces as {!Invalid_cep} carrying the API's own + message: the format already passed local validation, so the server knows + something this client does not. *) + + val lookup_many : t -> string list -> (address option list, error) result + (** [lookup_many client ceps] resolves many CEPs in one batch. + + The list returned has {b the same length and the same order} as the input. + A CEP that does not exist becomes [None] at its position — it does not + vanish from the list, and it does not fail the call. That is the right + difference from {!lookup}: in a batch of a thousand, one bad CEP must not + cost the other nine hundred and ninety-nine. + + A malformed CEP also becomes [None], for the same reason, rather than + returning {!Invalid_cep}. If you need to know {i which} one was malformed, + validate first with {!normalize_cep}. + + Input is chunked into blocks of {!max_batch} automatically. + + {b Warning: the batch carries no coordinate.} The endpoint behind it is + CSV, and the CSV has no [geo] column. Every address returned here has + [geo = None], including for CEPs that do have one. Need [geo]? Use + {!lookup}, one at a time. *) + + val health : t -> (health, error) result + (** [health client] queries [GET /health]: does the API answer, and with which + database. + + Does not fail for an API reporting itself degraded — that arrives in the + [status] field, and checking health is exactly when you want the diagnosis + rather than an error. Network failures still fail. *) +end + +(** {1 Module-level conveniences} + + These share one default client, built with the defaults on first use. It + applies process-wide, including to other libraries that also use this + module. Need a different configuration? Build your own with + {!Client.create}. *) + +val lookup : string -> (address, error) result +(** Look up a CEP using the default client. See {!Client.lookup}. *) + +val lookup_many : string list -> (address option list, error) result +(** Look up many CEPs using the default client. See {!Client.lookup_many}, + especially the warning that batches carry no coordinate. *) + +val health : unit -> (health, error) result +(** Query the API's health using the default client. See {!Client.health}. *) diff --git a/lib/dune b/lib/dune new file mode 100644 index 0000000..f429f30 --- /dev/null +++ b/lib/dune @@ -0,0 +1,4 @@ +(library + (name cepis) + (public_name cepis) + (libraries unix yojson csv ezcurl)) diff --git a/test/dune b/test/dune new file mode 100644 index 0000000..d634b54 --- /dev/null +++ b/test/dune @@ -0,0 +1,3 @@ +(test + (name test_cepis) + (libraries cepis unix threads.posix)) diff --git a/test/test_cepis.ml b/test/test_cepis.ml new file mode 100644 index 0000000..cc98c4a --- /dev/null +++ b/test/test_cepis.ml @@ -0,0 +1,569 @@ +let failures = ref 0 +let total = ref 0 + +let check name ok = + incr total; + if ok then Printf.printf "ok %s\n%!" name + else begin + incr failures; + Printf.printf "FAIL %s\n%!" name + end + +type reply = { status : int; body : string; hdrs : (string * string) list } + +let reply ?(hdrs = []) status body = { status; body; hdrs } + +type server = { + socket : Unix.file_descr; + port : int; + mutex : Mutex.t; + mutable routes : (string * reply list) list; + mutable handler : (string -> reply) option; + mutable calls : string list; +} + +let reason = function + | 200 -> "OK" + | 400 -> "Bad Request" + | 404 -> "Not Found" + | 429 -> "Too Many Requests" + | 500 -> "Internal Server Error" + | 503 -> "Service Unavailable" + | _ -> "Status" + +let contains_terminator s = + let n = String.length s in + let rec go i = + if i + 4 > n then false + else if String.sub s i 4 = "\r\n\r\n" then true + else go (i + 1) + in + go 0 + +let read_request fd = + let buf = Buffer.create 1024 in + let chunk = Bytes.create 4096 in + let rec go () = + if contains_terminator (Buffer.contents buf) then Buffer.contents buf + else + let n = Unix.read fd chunk 0 4096 in + if n = 0 then Buffer.contents buf + else begin + Buffer.add_subbytes buf chunk 0 n; + go () + end + in + go () + +let request_path request = + match String.index_opt request '\r' with + | None -> "/" + | Some i -> ( + match String.split_on_char ' ' (String.sub request 0 i) with + | _ :: path :: _ -> path + | _ -> "/") + +let write_all fd s = + let len = String.length s in + let rec go off = + if off < len then go (off + Unix.write_substring fd s off (len - off)) + in + go 0 + +let next srv path = + Mutex.lock srv.mutex; + srv.calls <- path :: srv.calls; + let answer = + match srv.handler with + | Some f -> f path + | None -> ( + match List.assoc_opt path srv.routes with + | None | Some [] -> reply 404 {|{"erro":"cep_nao_encontrado"}|} + | Some [ only ] -> only + | Some (head :: rest) -> + srv.routes <- (path, rest) :: List.remove_assoc path srv.routes; + head) + in + Mutex.unlock srv.mutex; + answer + +let serve srv fd = + (try + let path = request_path (read_request fd) in + let answer = next srv path in + let head = Buffer.create 256 in + Buffer.add_string head + (Printf.sprintf "HTTP/1.1 %d %s\r\n" answer.status (reason answer.status)); + List.iter + (fun (k, v) -> Buffer.add_string head (Printf.sprintf "%s: %s\r\n" k v)) + answer.hdrs; + Buffer.add_string head + (Printf.sprintf "Content-Length: %d\r\n" (String.length answer.body)); + Buffer.add_string head "Content-Type: text/plain; charset=utf-8\r\n"; + Buffer.add_string head "Connection: close\r\n\r\n"; + write_all fd (Buffer.contents head ^ answer.body) + with _ -> ()); + try Unix.close fd with _ -> () + +let start () = + let socket = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in + Unix.setsockopt socket Unix.SO_REUSEADDR true; + Unix.bind socket (Unix.ADDR_INET (Unix.inet_addr_loopback, 0)); + Unix.listen socket 32; + let port = + match Unix.getsockname socket with + | Unix.ADDR_INET (_, port) -> port + | _ -> 0 + in + let srv = + { + socket; + port; + mutex = Mutex.create (); + routes = []; + handler = None; + calls = []; + } + in + let rec accept_loop () = + match Unix.accept socket with + | fd, _ -> + ignore (Thread.create (fun () -> serve srv fd) ()); + accept_loop () + | exception _ -> () + in + ignore (Thread.create accept_loop ()); + srv + +let stop srv = try Unix.close srv.socket with _ -> () +let url srv = Printf.sprintf "http://127.0.0.1:%d" srv.port +let respond srv path replies = srv.routes <- (path, replies) :: srv.routes + +let count srv prefix = + let n = String.length prefix in + Mutex.lock srv.mutex; + let matching = + List.length + (List.filter + (fun c -> String.length c >= n && String.sub c 0 n = prefix) + srv.calls) + in + Mutex.unlock srv.mutex; + matching + +let calls srv = + Mutex.lock srv.mutex; + let n = List.length srv.calls in + Mutex.unlock srv.mutex; + n + +let with_server f = + let srv = start () in + let client = + Cepis.Client.create ~base_url:(url srv) ~timeout:5.0 ~backoff_base:0.001 + ~backoff_max:0.01 () + in + Fun.protect ~finally:(fun () -> stop srv) (fun () -> f srv client) + +let se_fields = + {|"cep":"01001000","logradouro":"Praça da Sé","complemento":"lado ímpar","unidade":"","bairro":"Sé","localidade":"São Paulo","uf":"SP","estado":"São Paulo","regiao":"Sudeste","ibge":"3550308","gia":"1004","ddd":"11","siafi":"7107"|} + +let se_json = "{" ^ se_fields ^ "}" +let se_json_with extra = "{" ^ se_fields ^ "," ^ extra ^ "}" + +let csv_header = + "cep,logradouro,complemento,unidade,bairro,localidade,uf,estado,regiao,ibge,gia,ddd,siafi" + +let csv rows = csv_header ^ "\n" ^ String.concat "\n" rows ^ "\n" + +let is_error name predicate = function + | Ok _ -> check name false + | Error e -> check name (predicate e) + +let test_normalisation () = + List.iter + (fun value -> + check + (Printf.sprintf "normalize_cep accepts %S" value) + (Cepis.normalize_cep value = Ok "01001000")) + [ "01001000"; "01001-000"; " 01001-000 "; "01001.000" ]; + List.iter + (fun value -> + check + (Printf.sprintf "normalize_cep rejects %S" value) + (match Cepis.normalize_cep value with + | Error (Cepis.Invalid_cep _) -> true + | _ -> false)) + [ ""; "123"; "0100100a"; "010010000"; "abcdefgh" ] + +let test_successful_lookup () = + with_server (fun srv client -> + respond srv "/01001000" [ reply 200 se_json ]; + match Cepis.Client.lookup client "01001-000" with + | Error _ -> check "successful lookup" false + | Ok a -> + check "lookup reads localidade" (a.Cepis.localidade = "São Paulo"); + check "lookup reads uf" (a.Cepis.uf = "SP"); + check "lookup masks the cep" (Cepis.formatted_cep a = "01001-000"); + check "lookup without geo yields None" (a.Cepis.geo = None)) + +let test_geo_present () = + with_server (fun srv client -> + respond srv "/01310100" + [ + reply 200 + (se_json_with + {|"geo":{"lat":-23.5,"lon":-46.6,"raio_m":120,"precisao":"logradouro"}|}); + ]; + match Cepis.Client.lookup client "01310100" with + | Ok { Cepis.geo = Some g; _ } -> + check "geo latitude is read" (Float.abs (g.Cepis.lat +. 23.5) < 1e-9); + check "geo radius is read" (g.Cepis.raio_m = 120); + check "street coordinate is precise" (Cepis.is_precise g) + | _ -> check "geo present" false) + +let test_geo_municipality () = + with_server (fun srv client -> + respond srv "/01001000" + [ + reply 200 + (se_json_with + {|"geo":{"lat":-23.5,"lon":-46.6,"raio_m":22000,"precisao":"localidade"}|}); + ]; + match Cepis.Client.lookup client "01001000" with + | Ok { Cepis.geo = Some g; _ } -> + check "municipality coordinate is not precise" + (not (Cepis.is_precise g)) + | _ -> check "municipality coordinate" false) + +let test_malformed_geo () = + with_server (fun srv client -> + respond srv "/01001000" + [ reply 200 (se_json_with {|"geo":{"lat":"not a number"}|}) ]; + match Cepis.Client.lookup client "01001000" with + | Ok a -> + check "malformed geo is dropped" (a.Cepis.geo = None); + check "malformed geo keeps the address" + (a.Cepis.localidade = "São Paulo") + | Error _ -> check "malformed geo" false) + +let test_unknown_field () = + with_server (fun srv client -> + respond srv "/01001000" + [ reply 200 (se_json_with {|"campo_do_futuro":"value"|}) ]; + match Cepis.Client.lookup client "01001000" with + | Ok a -> + check "unknown field is preserved in raw" + (List.assoc_opt "campo_do_futuro" a.Cepis.raw + = Some (`String "value")) + | Error _ -> check "unknown field" false) + +let test_not_found () = + with_server (fun srv client -> + respond srv "/99999999" + [ reply 404 {|{"erro":"cep_nao_encontrado","mensagem":"gone"}|} ]; + is_error "404 becomes Cep_not_found" + (function Cepis.Cep_not_found _ -> true | _ -> false) + (Cepis.Client.lookup client "99999999"); + check "404 is not retried" (count srv "/99999999" = 1)) + +let test_local_validation_makes_no_request () = + with_server (fun srv client -> + is_error "malformed CEP is rejected locally" + (function Cepis.Invalid_cep _ -> true | _ -> false) + (Cepis.Client.lookup client "123"); + check "malformed CEP never leaves the machine" (calls srv = 0)) + +let test_api_400 () = + with_server (fun srv client -> + respond srv "/00000000" + [ + reply 400 {|{"erro":"cep_invalido","mensagem":"rejected by the API"}|}; + ]; + is_error "API 400 becomes Invalid_cep with the API message" + (function + | Cepis.Invalid_cep m -> m = "rejected by the API" | _ -> false) + (Cepis.Client.lookup client "00000000"); + check "400 is not retried" (count srv "/00000000" = 1)) + +let test_not_json () = + with_server (fun srv client -> + respond srv "/01001000" [ reply 200 "<html>captive portal</html>" ]; + is_error "unparseable body becomes Invalid_response" + (function Cepis.Invalid_response _ -> true | _ -> false) + (Cepis.Client.lookup client "01001000")) + +let test_retry_then_success () = + with_server (fun srv client -> + respond srv "/01001000" + [ reply 500 {|{"erro":"interno"}|}; reply 200 se_json ]; + (match Cepis.Client.lookup client "01001000" with + | Ok a -> check "retry then success" (a.Cepis.localidade = "São Paulo") + | Error _ -> check "retry then success" false); + check "500 was retried once" (count srv "/01001000" = 2)) + +let test_retry_exhausted () = + with_server (fun srv client -> + respond srv "/01001000" [ reply 503 {|{"erro":"interno"}|} ]; + is_error "exhausted attempts become Server_error" + (function + | Cepis.Server_error { status; _ } -> status = 503 | _ -> false) + (Cepis.Client.lookup client "01001000"); + check "three attempts is the default" (count srv "/01001000" = 3)) + +let test_max_attempts_one () = + let srv = start () in + Fun.protect + ~finally:(fun () -> stop srv) + (fun () -> + let client = + Cepis.Client.create ~base_url:(url srv) ~max_attempts:1 ~timeout:5.0 () + in + respond srv "/01001000" [ reply 500 "{}" ]; + is_error "max_attempts:1 still reports the error" + (function Cepis.Server_error _ -> true | _ -> false) + (Cepis.Client.lookup client "01001000"); + check "max_attempts:1 disables retrying" (count srv "/01001000" = 1)) + +let test_rate_limited () = + with_server (fun srv client -> + respond srv "/01001000" [ reply ~hdrs:[ ("Retry-After", "7") ] 429 "{}" ]; + is_error "429 becomes Rate_limited carrying retry_after" + (function + | Cepis.Rate_limited { retry_after = Some s; _ } -> + Float.abs (s -. 7.) < 1e-9 + | _ -> false) + (Cepis.Client.lookup client "01001000")) + +let test_retry_after_http_date () = + with_server (fun srv client -> + respond srv "/01001000" + [ + reply + ~hdrs:[ ("Retry-After", "Wed, 21 Oct 2026 07:28:00 GMT") ] + 429 "{}"; + ]; + is_error "Retry-After as an HTTP date is understood" + (function + | Cepis.Rate_limited { retry_after = Some _; _ } -> true | _ -> false) + (Cepis.Client.lookup client "01001000")) + +let test_retry_after_past_date () = + with_server (fun srv client -> + respond srv "/01001000" + [ + reply + ~hdrs:[ ("Retry-After", "Wed, 21 Oct 1998 07:28:00 GMT") ] + 429 "{}"; + ]; + is_error "an HTTP date already past asks for no wait" + (function + | Cepis.Rate_limited { retry_after = Some s; _ } -> s = 0. + | _ -> false) + (Cepis.Client.lookup client "01001000")) + +let test_retry_after_cap () = + with_server (fun srv client -> + respond srv "/01001000" + [ reply ~hdrs:[ ("Retry-After", "3600") ] 429 "{}" ]; + let started = Unix.gettimeofday () in + ignore (Cepis.Client.lookup client "01001000"); + check "an absurd Retry-After is capped" + (Unix.gettimeofday () -. started < 5.)) + +let test_network_error () = + let client = + Cepis.Client.create ~base_url:"http://127.0.0.1:1" ~max_attempts:2 + ~backoff_base:0.001 ~timeout:1.0 () + in + is_error "a refused connection becomes Network_error" + (function Cepis.Network_error _ -> true | _ -> false) + (Cepis.Client.lookup client "01001000") + +let test_total_timeout () = + let srv = start () in + Fun.protect + ~finally:(fun () -> stop srv) + (fun () -> + let client = + Cepis.Client.create ~base_url:(url srv) ~max_attempts:50 + ~backoff_base:0.05 ~backoff_max:0.05 ~total_timeout:0.3 () + in + respond srv "/01001000" [ reply 500 "{}" ]; + let started = Unix.gettimeofday () in + is_error "total_timeout still reports the last failure" + (function Cepis.Server_error _ -> true | _ -> false) + (Cepis.Client.lookup client "01001000"); + check "total_timeout bounds the whole call" + (Unix.gettimeofday () -. started < 3.); + check "total_timeout cuts the attempts short" (count srv "/01001000" < 50)) + +let test_batch_order () = + with_server (fun srv client -> + respond srv "/csv?ceps=01001000%2C99999999%2C20040020" + [ + reply 200 + (csv + [ + "01001000,Praça da Sé,lado ímpar,,Sé,São Paulo,SP,São \ + Paulo,Sudeste,3550308,1004,11,7107"; + "99999999,,,,,,,,,,,,"; + "20040020,Avenida Rio Branco,,,Centro,Rio de Janeiro,RJ,Rio \ + de Janeiro,Sudeste,3304557,,21,6001"; + ]); + ]; + match + Cepis.Client.lookup_many client [ "01001000"; "99999999"; "20040020" ] + with + | Error _ -> check "batch order" false + | Ok rows -> ( + check "batch keeps the input length" (List.length rows = 3); + (match List.nth rows 0 with + | Some a -> + check "batch resolves the first" (a.Cepis.localidade = "São Paulo") + | None -> check "batch resolves the first" false); + check "a missing CEP is None at its position" (List.nth rows 1 = None); + match List.nth rows 2 with + | Some a -> check "batch resolves the third" (a.Cepis.uf = "RJ") + | None -> check "batch resolves the third" false)) + +let test_batch_no_geo () = + with_server (fun srv client -> + respond srv "/csv?ceps=01001000" + [ + reply 200 + (csv + [ + "01001000,Praça da Sé,,,Sé,São Paulo,SP,São \ + Paulo,Sudeste,3550308,1004,11,7107"; + ]); + ]; + match Cepis.Client.lookup_many client [ "01001000" ] with + | Ok [ Some a ] -> check "batches carry no geo" (a.Cepis.geo = None) + | _ -> check "batches carry no geo" false) + +let test_batch_quoted_comma () = + with_server (fun srv client -> + respond srv "/csv?ceps=01001000" + [ + reply 200 + (csv + [ + {|01001000,"Rua Um, Dois",,,Centro,São Paulo,SP,São Paulo,Sudeste,1,,11,1|}; + ]); + ]; + match Cepis.Client.lookup_many client [ "01001000" ] with + | Ok [ Some a ] -> + check "a quoted comma is parsed" (a.Cepis.logradouro = "Rua Um, Dois") + | _ -> check "a quoted comma is parsed" false) + +let test_batch_empty () = + with_server (fun srv client -> + check "an empty batch returns an empty list" + (Cepis.Client.lookup_many client [] = Ok []); + check "an empty batch makes no request" (calls srv = 0)) + +let test_batch_chunking () = + with_server (fun srv client -> + let ceps = List.init 501 (fun i -> Printf.sprintf "%08d" i) in + let row c = Printf.sprintf "%s,,,,,X,SP,São Paulo,Sudeste,1,,11,1" c in + let requests = ref 0 in + srv.handler <- + Some + (fun _ -> + incr requests; + let rows = + if !requests = 1 then + List.filteri (fun i _ -> i < 500) ceps |> List.map row + else List.filteri (fun i _ -> i >= 500) ceps |> List.map row + in + reply 200 (csv rows)); + match Cepis.Client.lookup_many client ceps with + | Error _ -> check "batch chunking" false + | Ok rows -> + check "501 CEPs become two requests" (!requests = 2); + check "chunked results keep the input length" (List.length rows = 501)) + +let test_batch_truncated () = + with_server (fun srv client -> + respond srv "/csv?ceps=01001000%2C20040020" + [ + reply 200 + (csv [ "01001000,,,,,São Paulo,SP,São Paulo,Sudeste,1,,11,1" ]); + ]; + match Cepis.Client.lookup_many client [ "01001000"; "20040020" ] with + | Ok rows -> + check "a short response is padded, not shifted" + (List.length rows = 2 && List.nth rows 1 = None) + | Error _ -> check "a short response is padded, not shifted" false) + +let test_health () = + with_server (fun srv client -> + respond srv "/health" + [ + reply 200 + {|{"status":"ok","dne":"26071","ceps":1596168,"geo":894489,"base_gerada_em":"2026-07-24T03:48:28Z"}|}; + ]; + match Cepis.Client.health client with + | Ok h -> + check "health reports ok" (Cepis.is_ok h); + check "health reports the database" (h.Cepis.dne = "26071"); + check "health counts the CEPs" (h.Cepis.ceps = 1596168) + | Error _ -> check "health" false) + +let test_health_degraded () = + with_server (fun srv client -> + respond srv "/health" + [ reply 503 {|{"status":"degradado","dne":"","ceps":0,"geo":0}|} ]; + match Cepis.Client.health client with + | Ok h -> + check "a degraded API is reported, not an error" (not (Cepis.is_ok h)) + | Error _ -> check "a degraded API is reported, not an error" false) + +let test_configuration () = + check "a trailing slash is stripped" + (Cepis.Client.base_url (Cepis.Client.create ~base_url:"http://x/" ()) + = "http://x"); + check "the user agent identifies the library" + (let ua = Cepis.Client.user_agent (Cepis.Client.create ()) in + String.length ua > 12 && String.sub ua 0 12 = "cepis-ocaml/"); + check "max_attempts below 1 is refused" + (match Cepis.Client.create ~max_attempts:0 () with + | _ -> false + | exception Invalid_argument _ -> true); + check "a non-positive timeout is refused" + (match Cepis.Client.create ~timeout:0. () with + | _ -> false + | exception Invalid_argument _ -> true) + +let () = + test_normalisation (); + test_successful_lookup (); + test_geo_present (); + test_geo_municipality (); + test_malformed_geo (); + test_unknown_field (); + test_not_found (); + test_local_validation_makes_no_request (); + test_api_400 (); + test_not_json (); + test_retry_then_success (); + test_retry_exhausted (); + test_max_attempts_one (); + test_rate_limited (); + test_retry_after_http_date (); + test_retry_after_past_date (); + test_retry_after_cap (); + test_network_error (); + test_total_timeout (); + test_batch_order (); + test_batch_no_geo (); + test_batch_quoted_comma (); + test_batch_empty (); + test_batch_chunking (); + test_batch_truncated (); + test_health (); + test_health_degraded (); + test_configuration (); + Printf.printf "\n%d checks, %d failure(s)\n%!" !total !failures; + if !failures > 0 then exit 1 |