diff options
| author | Murilo Ijanc <[email protected]> | 2026-07-26 12:42:28 -0300 |
|---|---|---|
| committer | Murilo Ijanc <[email protected]> | 2026-07-26 12:42:28 -0300 |
| commit | ae9ad8a4c61b793f6859c84dac80b1c1b04b7b68 (patch) | |
| tree | 62271e7672dfc58f59dda2ea4dc539c89a1ea5ca | |
| download | lisp-ae9ad8a4c61b793f6859c84dac80b1c1b04b7b68.tar.gz | |
Initial importv0.1.0
| -rw-r--r-- | .gitignore | 9 | ||||
| -rw-r--r-- | LICENSE | 15 | ||||
| -rw-r--r-- | Makefile | 51 | ||||
| -rw-r--r-- | README.md | 221 | ||||
| -rw-r--r-- | cepis.asd | 29 | ||||
| -rw-r--r-- | src/client.lisp | 403 | ||||
| -rw-r--r-- | src/csv.lisp | 60 | ||||
| -rw-r--r-- | src/errors.lisp | 73 | ||||
| -rw-r--r-- | src/models.lisp | 147 | ||||
| -rw-r--r-- | src/package.lisp | 100 | ||||
| -rw-r--r-- | tests/package.lisp | 3 | ||||
| -rw-r--r-- | tests/server.lisp | 156 | ||||
| -rw-r--r-- | tests/suite.lisp | 259 |
13 files changed, 1526 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..188708a --- /dev/null +++ b/.gitignore @@ -0,0 +1,9 @@ +*.fasl +*.fas +*.lib +*.x86f +*.dx64fsl +*.abcl +.cache/ +.qlot/ +system-index.txt @@ -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..7b8356b --- /dev/null +++ b/Makefile @@ -0,0 +1,51 @@ +# Development tasks. Everything runs through SBCL in script mode; Quicklisp +# resolves the dependencies, so it must be installed and loaded by your +# ~/.sbclrc (which is what `(ql:add-to-init-file)` does). +# +# make list the targets +# make test run the suite against a local HTTP server +# make lint compile everything from scratch, fail on any warning +# make build compile and load the library +SBCL ?= sbcl + +DEPS := "dexador" "com.inuoe.jzon" "babel" "fiveam" "usocket" "bordeaux-threads" + +LISP := $(SBCL) --non-interactive \ + --eval '(require :asdf)' \ + --eval '(push (uiop:getcwd) asdf:*central-registry*)' + +CACHE := $(HOME)/.cache/common-lisp + +.DEFAULT_GOAL := help +.PHONY: help test lint build check clean + +help: + @echo 'Targets:' + @echo ' test run the test suite' + @echo ' lint recompile from scratch, failing on any warning (read-only)' + @echo ' build compile and load the library' + @echo ' check lint + test + build, in that order' + @echo ' clean remove compiled files and this project'"'"'s ASDF cache' + +test: + $(LISP) \ + --eval '(ql:quickload "cepis/tests" :silent t)' \ + --eval '(uiop:quit (if (cepis/tests:run-tests) 0 1))' + +# The dependencies are loaded outside the handler so that their own warnings, +# on the first compile of a fresh Quicklisp, are not counted as ours. The +# redefinition warnings that are skipped are the ones SBCL emits for a macro +# compiled and then loaded in the same image, which say nothing about the code. +LINT_FORM := (let ((warnings 0)) (handler-bind ((warning (lambda (condition) (unless (typep condition (quote sb-kernel:redefinition-warning)) (incf warnings) (format *error-output* "~&~a~%" condition))))) (asdf:load-system "cepis/tests" :force (list "cepis" "cepis/tests"))) (uiop:quit (if (plusp warnings) 1 0))) + +lint: + $(LISP) --eval '(ql:quickload (list $(DEPS)) :silent t)' --eval '$(LINT_FORM)' + +build: + $(LISP) --eval '(ql:quickload "cepis" :silent t)' --eval '(asdf:make "cepis")' + +check: lint test build + +clean: + find . \( -name '*.fasl' -o -name '*.fas' -o -name '*.lib' \) -delete + rm -rf $(CACHE)/*/$(patsubst /%,%,$(CURDIR)) diff --git a/README.md b/README.md new file mode 100644 index 0000000..4baa530 --- /dev/null +++ b/README.md @@ -0,0 +1,221 @@ +# cepis + +Common Lisp client for the [public CEP API at cep.is](https://cep.is). +Official Correios data (DNE), refreshed every two weeks. Developed and tested +on SBCL. + +```lisp +(let ((address (cepis:lookup "01001-000"))) + (format t "~a ~a ~a~%" + (cepis:address-logradouro address) + (cepis:address-localidade address) + (cepis:address-uf address))) +;; Praça da Sé São Paulo SP +``` + +## Installation + +Clone it where ASDF can find it, for instance `~/common-lisp/`, then load it +with Quicklisp so the dependencies come along: + +```sh +git clone https://git.cep.is/lisp.git ~/common-lisp/cepis +``` + +```lisp +(ql:quickload "cepis") +``` + +Three dependencies: +[`dexador`](https://github.com/fukamachi/dexador) for HTTP, because the +standard has no client and dexador is the maintained, synchronous, TLS-capable +one; [`com.inuoe.jzon`](https://github.com/Zulu-Inuoe/jzon) for JSON, because +it is the strictest of the current parsers and does not invent its own reader +syntax; and [`babel`](https://github.com/cl-babel/babel) to decode UTF-8 +bodies. The batch endpoint's CSV is read by a small RFC 4180 reader included +here — less total weight than pulling a CSV library in for one call. + +## Usage + +### A single lookup + +`lookup` accepts the CEP masked or unmasked and returns an `address`: + +```lisp +(defvar *a* (cepis:lookup "01310-100")) + +(cepis:address-logradouro *a*) ; "Avenida Paulista" +(cepis:address-localidade *a*) ; "São Paulo" +(cepis:address-uf *a*) ; "SP" +(cepis:address-ibge *a*) ; "3550308" +(cepis:address-cep *a*) ; "01310100" (always unmasked) +(cepis:address-formatted-cep *a*) ; "01310-100" +``` + +Fields the database does not have for that CEP come back as empty strings, +never `nil`. The slot names are the API's own, in Portuguese, with Lisp's +hyphenation where the JSON has an underscore: `raio_m` is read with +`geo-raio-m`. + +### Coordinates + +About 57% of CEPs have a coordinate. When they do not, `address-geo` is `nil`: + +```lisp +(let ((geo (cepis:address-geo *a*))) + (when geo + (list (cepis:geo-lat geo) ; -23.567202d0 + (cepis:geo-lon geo) ; -46.649659d0 + (cepis:geo-raio-m geo) ; 1084 + (cepis:geo-precisao geo)))) ; "logradouro" +``` + +**Check `geo-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 | + +`geo-precise-p` is the shorthand for `precisao` being `"logradouro"`: + +```lisp +(let ((geo (cepis:address-geo *a*))) + (if (and geo (cepis:geo-precise-p geo)) + (shipping-from (cepis:geo-lat geo) (cepis:geo-lon geo)) + (shipping-from-municipality (cepis:address-ibge *a*)))) +``` + +### Many CEPs at once + +Do not loop over `lookup`. Use `lookup-many`, which resolves up to 500 CEPs +per request: + +```lisp +(let ((ceps '("01001000" "99999999" "20040020"))) + (loop for cep in ceps + for address in (cepis:lookup-many ceps) + do (format t "~a: ~a~%" + cep + (if address (cepis:address-localidade address) "not found")))) +``` + +The returned list has **the same length and the same order** as the input. A +CEP that does not exist, or is malformed, is `nil` at its position — it does +not vanish, and it does not signal. + +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 +> `address-geo` of `nil`, including for CEPs that do have one. Need the +> coordinate? 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: + +```lisp +(let ((h (cepis:health))) + (cepis:health-ok-p h) ; T + (cepis:health-dne h) ; "26071" identifier of the fortnightly database + (cepis:health-ceps h) ; 1596168 + (cepis:health-base-gerada-em h)); "2026-07-24T03:48:28Z" +``` + +An API reporting itself degraded does not signal — that arrives in +`health-status`. + +## Configuration + +For anything beyond the defaults, build a `client` and reuse it. It keeps no +state between calls and is safe to share across threads: + +```lisp +(defvar *cep* + (cepis:make-client + :base-url "https://cep.is" ; point at another instance + :timeout 10.0 ; seconds per socket operation + :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 nil)) ; cap on the whole call, attempts included + +(cepis:lookup "01001000" :client *cep*) +``` + +Retries cover 429, 5xx and network failures, with exponential backoff and +jitter; 400 and 404 are never retried. `timeout` bounds each socket operation, +not the whole call — that is what `total-timeout` is for. See the docstring of +`make-client` for the details of each parameter. + +`lookup`, `lookup-many` and `health` use the shared client in `cepis:*client*` +when no `:client` is given. Do not mutate it: it applies process-wide, +including to third-party libraries that also use this package. 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`: + +```lisp +(cepis:make-client :base-url "http://localhost:8080") +``` + +## Errors + +Everything derives from `cepis-error`, so one handler catches any failure. +Below that, the split is by **the decision you have to make**, not by the HTTP +status that caused it: + +| condition | when | does retrying help? | +| --- | --- | --- | +| `invalid-cep` | not 8 digits | no | +| `cep-not-found` | well-formed, not in the database | no | +| `rate-limited` | 429 | yes, later | +| `server-error` | 5xx | yes, later | +| `network-error` | DNS, connection, timeout, TLS | yes, later | +| `invalid-response` | unintelligible response | probably not | + +```lisp +(handler-case (cepis:lookup cep-from-form) + (cepis:cep-not-found () + :ask-for-another-cep) + (cepis:cepis-error () + :reschedule)) +``` + +`error-message` returns the description of any of them; `server-error-status` +and `rate-limited-retry-after` carry the extra facts their callers need. + +`invalid-cep` is also a `parse-error` and `cep-not-found` a `cell-error`, so +code already handling those standard types during input validation keeps +working without knowing this library exists — and `cell-error-name` gives back +the CEP that was not found. + +`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 + +Everything runs through `make`, which drives SBCL in script mode. Quicklisp +must be installed and loaded from your `~/.sbclrc`: + +```sh +make # list the targets +make test # run the suite +make lint # recompile from scratch, failing on any warning +make build # compile and load the library +make check # lint, then test, then build +``` + +The suite stands up a real HTTP server on a loopback port and points a client +at it with `:base-url`. Nothing is stubbed and no test touches the network. + +## Licence + +ISC. See [LICENSE](LICENSE). diff --git a/cepis.asd b/cepis.asd new file mode 100644 index 0000000..7813f59 --- /dev/null +++ b/cepis.asd @@ -0,0 +1,29 @@ +(defsystem "cepis" + :version "0.1.0" + :author "Murilo Ijanc <[email protected]>" + :license "ISC" + :description "Client for the public CEP API at cep.is." + :homepage "https://cep.is" + :depends-on ("dexador" "com.inuoe.jzon" "babel") + :serial t + :components ((:module "src" + :components ((:file "package") + (:file "errors") + (:file "models") + (:file "csv") + (:file "client")))) + :in-order-to ((test-op (test-op "cepis/tests")))) + +(defsystem "cepis/tests" + :author "Murilo Ijanc <[email protected]>" + :license "ISC" + :description "Test suite for cepis." + :depends-on ("cepis" "fiveam" "usocket" "bordeaux-threads" "babel") + :serial t + :components ((:module "tests" + :components ((:file "package") + (:file "server") + (:file "suite")))) + :perform (test-op (op system) + (unless (symbol-call :fiveam :run! (find-symbol* :cepis :cepis/tests)) + (error "cepis test suite failed")))) diff --git a/src/client.lisp b/src/client.lisp new file mode 100644 index 0000000..2965c86 --- /dev/null +++ b/src/client.lisp @@ -0,0 +1,403 @@ +(in-package #:cepis) + +(defparameter +version+ "0.1.0" + "Version of this library, as it appears in the default User-Agent.") + +(defparameter +default-url+ "https://cep.is" + "Where the API lives unless a client says otherwise.") + +(defconstant +max-batch+ 500 + "Most CEPs the API accepts in a single batch request.") + +(defparameter +retriable-status+ '(429 500 502 503 504) + "Statuses worth another attempt. 400 and 404 are deliberately absent: both +are definitive answers about the request, so retrying returns the same thing +more slowly while burning someone else's quota.") + +(defparameter +months+ + '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec") + "Month abbreviations of an HTTP date, in order.") + +(defun monotonic-now () + "Seconds from an arbitrary origin, for measuring elapsed time." + (/ (get-internal-real-time) (float internal-time-units-per-second 1.0d0))) + +(defun digits-only-p (string) + "True when STRING is made exclusively of ASCII digits." + (and (plusp (length string)) + (every (lambda (character) (char<= #\0 character #\9)) string))) + +(defun normalize-cep (value) + "Return the CEP's 8 digits, accepting the mask. + +\"01001-000\", \"01001000\" and \" 01001-000 \" all become \"01001000\". + +Signals `invalid-cep' unless exactly 8 digits remain. This runs 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." + (unless (stringp value) + (error 'invalid-cep + :message (format nil "CEP must be a string, got ~a" (type-of value)))) + (let ((cleaned (remove-if (lambda (character) + (member character '(#\- #\. #\Space #\Tab #\Newline #\Return))) + value))) + (unless (and (= (length cleaned) 8) (digits-only-p cleaned)) + (error 'invalid-cep + :message (format nil "CEP must be 8 digits, got ~s" value))) + cleaned)) + +(defun url-encode (value) + "Percent-encode VALUE for use inside a query string." + (with-output-to-string (out) + (loop for byte across (babel:string-to-octets (princ-to-string value) :encoding :utf-8) + for character = (code-char byte) + do (if (or (char<= #\a character #\z) + (char<= #\A character #\Z) + (char<= #\0 character #\9) + (find character "-._~")) + (write-char character out) + (format out "%~2,'0X" byte))))) + +(defun body-text (body) + "Decode a response body to a string, replacing anything that is not UTF-8." + (cond ((null body) "") + ((stringp body) body) + (t (babel:octets-to-string (coerce body '(vector (unsigned-byte 8))) + :encoding :utf-8 + :errorp nil)))) + +(defun parse-http-date (value) + "Parse an HTTP date such as \"Wed, 21 Oct 2026 07:28:00 GMT\" into a universal +time, or NIL when it does not look like one." + (let ((parts (remove "" (uiop:split-string value :separator " ,") :test #'string=))) + (when (>= (length parts) 5) + (destructuring-bind (weekday day month year clock &rest rest) parts + (declare (ignore weekday rest)) + (let ((month-index (position month +months+ :test #'string-equal)) + (clock-parts (uiop:split-string clock :separator ":"))) + (when (and month-index (= (length clock-parts) 3)) + (ignore-errors + (encode-universal-time (parse-integer (third clock-parts)) + (parse-integer (second clock-parts)) + (parse-integer (first clock-parts)) + (parse-integer day) + (1+ month-index) + (parse-integer year) + 0)))))))) + +(defun retry-after-seconds (value) + "Parse the Retry-After header in both RFC 9110 forms. + +It may arrive as a number of seconds (\"120\") or as an HTTP date (\"Wed, 21 +Oct 2026 07:28:00 GMT\"). Handling only the first is the common bug, and it +makes a client ignore exactly the wait request that matters most." + (when (and (stringp value) (plusp (length (string-trim " " value)))) + (let* ((trimmed (string-trim " " value)) + (seconds (ignore-errors (parse-integer trimmed)))) + (if seconds + (max 0 seconds) + (let ((date (parse-http-date trimmed))) + (when date + (max 0 (- date (get-universal-time))))))))) + +(defun header-value (headers name) + "The value of header NAME, which dexador gives us downcased in a hash table." + (when (hash-table-p headers) + (gethash name headers))) + +(defclass client () + ((base-url :initarg :base-url + :initform +default-url+ + :reader client-base-url + :documentation "Where the API lives. A trailing slash is stripped.") + (timeout :initarg :timeout + :initform 10.0 + :reader client-timeout + :documentation "Seconds allowed per socket operation.") + (max-attempts :initarg :max-attempts + :initform 3 + :reader client-max-attempts + :documentation "Attempts in total, counting the first.") + (backoff-base :initarg :backoff-base + :initform 0.5 + :reader client-backoff-base + :documentation "Base of the exponential wait, in seconds.") + (backoff-max :initarg :backoff-max + :initform 8.0 + :reader client-backoff-max + :documentation "Cap on each individual wait, in seconds.") + (total-timeout :initarg :total-timeout + :initform nil + :reader client-total-timeout + :documentation "Cap on the whole call, or NIL for no cap.") + (user-agent :initarg :user-agent + :initform nil + :reader client-user-agent + :documentation "What the client calls itself.")) + (:documentation + "Configuration for talking to the API. Build one with `make-client'. + +Reuse one instance: the configuration is not mutated and no function keeps +state between calls, so it is safe to share across threads.")) + +(defmethod initialize-instance :after ((client client) &key) + (with-slots (base-url timeout max-attempts user-agent) client + (unless (and (integerp max-attempts) (>= max-attempts 1)) + (error "max-attempts must be an integer >= 1, got ~s" max-attempts)) + (unless (and (realp timeout) (plusp timeout)) + (error "timeout must be > 0, got ~s" timeout)) + (setf base-url (string-right-trim "/" base-url)) + (unless user-agent + (setf user-agent (format nil "cepis-lisp/~a (+https://cep.is)" +version+))))) + +(defun make-client (&rest initargs + &key base-url timeout max-attempts backoff-base backoff-max + total-timeout user-agent) + "Build a `client'. + +BASE-URL is where the API lives, \"https://cep.is\" by default. 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. + +TIMEOUT is the seconds allowed per socket operation — connect, and each read. +It is not a cap on the whole call; that cap is TOTAL-TIMEOUT, which counts +attempts and waits alike and defaults to NIL, meaning MAX-ATTEMPTS is the only +bound. Set it in code serving a web request. + +MAX-ATTEMPTS is how many attempts in total, counting the first; 1 disables +retrying. The default of 3 covers the common case, one transient failure, +without turning a real outage into a long wait. + +BACKOFF-BASE is the base of the exponential wait, in seconds: the actual wait +is drawn from [0, base * 2^(n-1)], 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. BACKOFF-MAX caps each +individual wait, a server-sent Retry-After included, so a misconfigured proxy +answering \"Retry-After: 3600\" cannot park the caller for an hour. + +USER-AGENT overrides the User-Agent header. The default identifies the library +and its version, which is what lets the server diagnose an old client +misbehaving." + (declare (ignorable base-url timeout max-attempts backoff-base backoff-max + total-timeout user-agent)) + (apply #'make-instance 'client initargs)) + +(defvar *client* (make-client) + "The client used when no :client argument is given. + +Built once, because a `client' keeps no state between calls and is thread +safe. Do not mutate it: it applies process-wide, including to third-party +libraries that also use this package. Anyone needing different settings should +build their own with `make-client'.") + +(defun backoff-delay (client attempt retry-after) + "How long to wait before the next attempt. + +The server's Retry-After wins over the local calculation when present: it +knows when it will be back, we are guessing. It still goes through the +`client-backoff-max' cap. Otherwise the wait is drawn from [0, ceiling] rather +than being the ceiling." + (if retry-after + (min retry-after (client-backoff-max client)) + (let ((ceiling (min (* (client-backoff-base client) (expt 2 (1- attempt))) + (client-backoff-max client)))) + (if (plusp ceiling) (random ceiling) 0)))) + +(defun perform-request (client url) + "One attempt at GET URL. + +Returns (values :response status body headers) for anything the server +answered, and (values :network condition) when the request never completed." + (handler-case + (multiple-value-bind (body status headers) + (dex:get url + :headers (list (cons "User-Agent" (client-user-agent client)) + (cons "Accept" "application/json, text/csv;q=0.9, */*;q=0.1") + (cons "Accept-Encoding" "identity")) + :force-binary t + :connect-timeout (client-timeout client) + :read-timeout (client-timeout client)) + (values :response status body headers)) + (dex:http-request-failed (condition) + (values :response + (dex:response-status condition) + (dex:response-body condition) + (dex:response-headers condition))) + (error (condition) + (values :network condition)))) + +(defun request (client path &key (accepted-status '(200))) + "Perform the GET, with retries. Returns (values status body headers). + +Definitive error statuses (400, 404) come back normally, for the caller to +turn into the right condition — only transient failures become conditions +here, and only once the attempts are exhausted." + (let* ((url (concatenate 'string (client-base-url client) path)) + (attempts (client-max-attempts client)) + (total-timeout (client-total-timeout client)) + (deadline (when total-timeout (+ (monotonic-now) total-timeout))) + (last-status nil) + (last-retry-after nil) + (last-condition nil)) + (loop for attempt from 1 to attempts + do (when (and deadline (>= (monotonic-now) deadline)) + (return)) + (multiple-value-bind (kind status body headers) (perform-request client url) + (if (eq kind :network) + (setf last-condition status + last-status nil + last-retry-after nil) + (progn + (when (or (member status accepted-status) + (not (member status +retriable-status+))) + (return-from request (values status body headers))) + (setf last-status status + last-retry-after (retry-after-seconds + (header-value headers "retry-after")) + last-condition nil)))) + (when (= attempt attempts) + (return)) + (let ((wait (backoff-delay client attempt last-retry-after))) + (when deadline + (let ((remaining (- deadline (monotonic-now)))) + (when (<= remaining 0) + (return)) + (setf wait (min wait remaining)))) + (sleep wait))) + (cond ((eql last-status 429) + (error 'rate-limited + :message (format nil "rate limit reached at ~a (after ~d attempt(s))" + url attempts) + :retry-after last-retry-after)) + (last-status + (error 'server-error + :message (format nil "the API answered ~d at ~a (after ~d attempt(s))" + last-status url attempts) + :status last-status)) + (t + (error 'network-error + :message (format nil "could not reach ~a (after ~d attempt(s)): ~a" + url attempts last-condition)))))) + +(defun parse-json-object (body) + "Decode a JSON object body, or signal `invalid-response'." + (let* ((text (body-text body)) + (data (handler-case (com.inuoe.jzon:parse text) + (error () + (error 'invalid-response + :message (format nil "response is not valid JSON — something ~ +between you and the API is answering instead of it: ~s" + (subseq text 0 (min 120 (length text))))))))) + (unless (hash-table-p data) + (error 'invalid-response + :message (format nil "expected a JSON object, got ~a" (type-of data)))) + data)) + +(defun api-message (body fallback) + "Pull \"mensagem\" out of an error body, falling back to FALLBACK." + (handler-case + (let ((data (com.inuoe.jzon:parse (body-text body)))) + (if (hash-table-p data) + (let ((message (gethash "mensagem" data))) + (if (and (stringp message) (plusp (length message))) + message + fallback)) + fallback)) + (error () fallback))) + +(defun lookup (cep &key (client *client*)) + "Look up a single CEP and return an `address'. + + (address-localidade (lookup \"01001-000\")) => \"São Paulo\" + +A 400 from the API is surfaced as `invalid-cep' carrying the API's own +message: the format already passed local validation, so the server knows +something this client does not. + +Signals `invalid-cep' when the CEP is not 8 digits, without making a request; +`cep-not-found' when it is well-formed but not in the database; `rate-limited' +on 429 and `server-error' on 5xx after every attempt; `network-error' when the +request never completed; `invalid-response' when the body cannot be read." + (let ((number (normalize-cep cep))) + (multiple-value-bind (status body) + (request client (concatenate 'string "/" number)) + (case status + (404 (error 'cep-not-found + :name number + :message (format nil "CEP ~a does not exist in the DNE database" + number))) + (400 (error 'invalid-cep + :message (api-message body (format nil "CEP ~a rejected" number)))) + (t (address-from-json (parse-json-object body))))))) + +(defun chunk-list (list size) + "Split LIST into consecutive lists of at most SIZE elements." + (let ((rest list) + (chunks '())) + (loop while rest + do (push (loop repeat size + while rest + collect (pop rest)) + chunks)) + (nreverse chunks))) + +(defun fit-length (list count) + "Pad LIST with NILs, or truncate it, so that it has exactly COUNT elements." + (let ((size (length list))) + (cond ((= size count) list) + ((> size count) (subseq list 0 count)) + (t (append list (make-list (- count size) :initial-element nil)))))) + +(defun lookup-chunk (client ceps) + "Resolve at most `+max-batch+' CEPs in a single request. + +A blank CSV row means \"not found\": the API fills only the cep column and +leaves the rest empty, precisely so it does not misalign whoever is consuming +the batch in a spreadsheet. + +The API guarantees one row per requested CEP. Should that ever fail to hold — +a proxy truncating, a cut response — the result is padded to the input length +rather than returned short, because a shifted list silently pairs the wrong +address with the wrong CEP." + (let ((path (format nil "/csv?ceps=~{~a~^%2C~}" (mapcar #'url-encode ceps)))) + (multiple-value-bind (status body) (request client path) + (declare (ignore status)) + (let* ((rows (parse-csv (body-text body))) + (header (first rows)) + (addresses (loop for row in (rest rows) + for table = (csv-row-table header row) + collect (when (plusp (length (string-trim " " + (json-string table "localidade")))) + (address-from-json table))))) + (fit-length addresses (length ceps)))))) + +(defun lookup-many (ceps &key (client *client*)) + "Look up many CEPs in one batch. + +Returns a list of the same length and in the same order as CEPS. A CEP that +does not exist becomes NIL at its position — it does not vanish from the list, +and it does not signal. 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 becomes NIL for the same reason; validate with +`normalize-cep' first if you need to know which one it was. + +Input is chunked into blocks of 500, the API's limit, automatically. + +Beware: the batch carries no coordinate. The endpoint behind it is CSV, and +the CSV has no geo column. Every `address' returned here has `address-geo' of +NIL, including for CEPs that do have one. Need the coordinate? Use `lookup', +one at a time." + (loop for chunk in (chunk-list ceps +max-batch+) + append (lookup-chunk client chunk))) + +(defun health (&key (client *client*)) + "Query GET /health: does the API answer, and with which database. + +Does not signal for an API reporting itself degraded — that arrives in +`health-status', and checking health is exactly when you want the diagnosis +rather than a condition. Network failures still signal." + (multiple-value-bind (status body) + (request client "/health" :accepted-status '(200 503)) + (declare (ignore status)) + (health-from-json (parse-json-object body)))) diff --git a/src/csv.lisp b/src/csv.lisp new file mode 100644 index 0000000..4c6297b --- /dev/null +++ b/src/csv.lisp @@ -0,0 +1,60 @@ +(in-package #:cepis) + +(defun parse-csv (text) + "Parse TEXT as RFC 4180 CSV and return a list of rows, each a list of strings. + +Values may be double-quoted, in which case they may contain commas, newlines +and doubled quotes; that is why the batch endpoint cannot be read by splitting +on commas. A byte order mark and CRLF line endings are both tolerated." + (let ((rows '()) + (row '()) + (buffer (make-string-output-stream)) + (in-quotes nil) + (dirty nil) + (index 0) + (end (length text))) + (labels ((flush-field () + (push (get-output-stream-string buffer) row)) + (flush-row () + (flush-field) + (push (nreverse row) rows) + (setf row '() + dirty nil))) + (when (and (plusp end) (char= (char text 0) (code-char #xFEFF))) + (incf index)) + (loop while (< index end) + do (let ((character (char text index))) + (cond (in-quotes + (cond ((not (char= character #\")) + (write-char character buffer)) + ((and (< (1+ index) end) (char= (char text (1+ index)) #\")) + (write-char #\" buffer) + (incf index)) + (t (setf in-quotes nil)))) + ((char= character #\") + (setf in-quotes t + dirty t)) + ((char= character #\,) + (flush-field) + (setf dirty t)) + ((char= character #\Newline) + (flush-row)) + ((char= character #\Return)) + (t + (write-char character buffer) + (setf dirty t)))) + (incf index)) + (when (or dirty row) + (flush-row)) + (nreverse rows)))) + +(defun csv-row-table (header row) + "Zip HEADER and ROW into a hash table, so a CSV row reads like a JSON object. + +Columns the row does not reach are filled with the empty string, which is what +the API sends for a field it does not have." + (let ((table (make-hash-table :test #'equal))) + (loop for column in header + for rest = row then (cdr rest) + do (setf (gethash column table) (or (car rest) ""))) + table)) diff --git a/src/errors.lisp b/src/errors.lisp new file mode 100644 index 0000000..525ac67 --- /dev/null +++ b/src/errors.lisp @@ -0,0 +1,73 @@ +(in-package #:cepis) + +(define-condition cepis-error (error) + ((message :initarg :message + :initform "" + :reader error-message + :documentation "The human-readable description of the failure.")) + (:report (lambda (condition stream) + (write-string (error-message condition) stream))) + (:documentation + "Base of every error this library signals. Handle it to catch any failure. + +Below it the split is by the decision the caller has to make, not by the HTTP +status that caused it. `invalid-cep' and `cep-not-found' are problems with the +request: retrying is pointless, the same CEP will fail again. `network-error', +`server-error' and `rate-limited' are problems with transport: retrying may +help, and the client already retried on its own before signalling any of +them.")) + +(define-condition invalid-cep (cepis-error parse-error) + () + (:documentation + "The CEP is not 8 digits. + +Deliberately also a `parse-error': turning a string into a CEP is a parse, and +code that already handles `parse-error' while validating input keeps working +without knowing this library exists. + +Usually signalled without a request ever being made — the client checks the +format before going to the network.")) + +(define-condition cep-not-found (cepis-error cell-error) + () + (:documentation + "The CEP is well-formed but does not exist in the DNE database. + +Also a `cell-error', which is the closest thing the standard has to a failed +key lookup: `cell-error-name' returns the CEP that was not found.")) + +(define-condition network-error (cepis-error) + () + (:documentation + "The request never completed: DNS, refused connection, timeout, TLS. + +Signalled only after every configured attempt has failed.")) + +(define-condition server-error (cepis-error) + ((status :initarg :status + :initform 0 + :reader server-error-status + :documentation "The HTTP status seen on the last attempt.")) + (:documentation "The API answered 5xx on every attempt.")) + +(define-condition rate-limited (cepis-error) + ((retry-after :initarg :retry-after + :initform nil + :reader rate-limited-retry-after + :documentation + "What the server asked for, in seconds, or NIL if it did not say.")) + (:documentation + "The API (or the edge in front of it) answered 429. + +The client already honoured `rate-limited-retry-after' across the attempts it +made; it is exposed here for callers who want to reschedule the work.")) + +(define-condition invalid-response (cepis-error) + () + (:documentation + "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.")) diff --git a/src/models.lisp b/src/models.lisp new file mode 100644 index 0000000..8905ae1 --- /dev/null +++ b/src/models.lisp @@ -0,0 +1,147 @@ +(in-package #:cepis) + +(defstruct (geo (:copier nil)) + "The CEP's coordinate, when the database has one. + +The point is the 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 `geo-precisao' before using the point for distance: + +- \"logradouro\": the point is a stretch of street. `geo-raio-m' lands around + 100-150 m. Good for maps and for distance. +- \"localidade\": the CEP is the whole municipality (a city-wide general CEP), + and the point is its centroid. `geo-raio-m' runs from 7 km to 40 km. + Computing shipping from this is wrong by tens of kilometres. + +`geo-raio-m' is the radius containing 90% of that CEP's addresses. It exists +precisely so that error cannot pass unnoticed. The slot is the JSON's `raio_m' +with Lisp's hyphenation." + (lat 0.0d0 :type double-float :read-only t) + (lon 0.0d0 :type double-float :read-only t) + (raio-m 0 :type integer :read-only t) + (precisao "" :type string :read-only t)) + +(defun geo-precise-p (geo) + "True when the coordinate points at a street, not at a municipality. + +Shorthand for (string= (geo-precisao geo) \"logradouro\"), which is the check +to make before using the point to measure distance." + (string= (geo-precisao geo) "logradouro")) + +(defstruct (address (:copier nil)) + "A CEP and everything the database knows about it. + +Fields the database does not have for that CEP come back as empty strings, +never NIL — that is what the API returns, and changing it here would create a +difference between reading the JSON and reading this library. + +`address-geo' is the exception: it is NIL when there is no coordinate. There +the difference is real, because the API omits the whole field in that case +(about 43% of CEPs) rather than sending null. + +`address-raw' holds the response exactly as it arrived, as the hash table the +JSON parser produced, so a field the API grows before this library is updated +is not lost." + (cep "" :type string :read-only t) + (logradouro "" :type string :read-only t) + (complemento "" :type string :read-only t) + (unidade "" :type string :read-only t) + (bairro "" :type string :read-only t) + (localidade "" :type string :read-only t) + (uf "" :type string :read-only t) + (estado "" :type string :read-only t) + (regiao "" :type string :read-only t) + (ibge "" :type string :read-only t) + (gia "" :type string :read-only t) + (ddd "" :type string :read-only t) + (siafi "" :type string :read-only t) + (geo nil :type (or null geo) :read-only t) + (raw nil :type (or null hash-table) :read-only t)) + +(defun address-formatted-cep (address) + "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 format string in every +project that uses this." + (let ((cep (address-cep address))) + (if (= (length cep) 8) + (format nil "~a-~a" (subseq cep 0 5) (subseq cep 5)) + cep))) + +(defstruct (health (:copier nil)) + "The response of GET /health. + +Good for two things: checking that the API answers, and knowing which version +of the database is live. The DNE database changes every two weeks; +`health-dne' identifies it." + (status "" :type string :read-only t) + (dne "" :type string :read-only t) + (ceps 0 :type integer :read-only t) + (geo 0 :type integer :read-only t) + (base-gerada-em "" :type string :read-only t)) + +(defun health-ok-p (health) + "True when the API reports itself healthy." + (string= (health-status health) "ok")) + +(defun json-string (table key) + "The value of KEY in TABLE as a string, or \"\" when it is absent or not a scalar." + (let ((value (gethash key table))) + (cond ((stringp value) value) + ((integerp value) (format nil "~d" value)) + ((realp value) (princ-to-string value)) + (t "")))) + +(defun json-integer (table key) + "The value of KEY in TABLE as an integer, or 0 when it is absent or not a number." + (let ((value (gethash key table))) + (if (realp value) (round value) 0))) + +(defun geo-from-json (value) + "Build a `geo' from the parsed \"geo\" block, or NIL when it is absent or malformed. + +A malformed block yields NIL rather than propagating the error: it is not +worth losing the whole address over, since the rest of the response is still +useful." + (when (hash-table-p value) + (let ((lat (gethash "lat" value)) + (lon (gethash "lon" value)) + (raio-m (gethash "raio_m" value)) + (precisao (gethash "precisao" value))) + (when (and (realp lat) (realp lon) (realp raio-m) (stringp precisao)) + (make-geo :lat (coerce lat 'double-float) + :lon (coerce lon 'double-float) + :raio-m (round raio-m) + :precisao precisao))))) + +(defun address-from-json (data) + "Build an `address' from the hash table the JSON parser produced. + +Unknown fields are ignored during construction but preserved in +`address-raw'. A new field in the API therefore cannot break this library." + (make-address :cep (json-string data "cep") + :logradouro (json-string data "logradouro") + :complemento (json-string data "complemento") + :unidade (json-string data "unidade") + :bairro (json-string data "bairro") + :localidade (json-string data "localidade") + :uf (json-string data "uf") + :estado (json-string data "estado") + :regiao (json-string data "regiao") + :ibge (json-string data "ibge") + :gia (json-string data "gia") + :ddd (json-string data "ddd") + :siafi (json-string data "siafi") + :geo (geo-from-json (gethash "geo" data)) + :raw data)) + +(defun health-from-json (data) + "Build a `health' from the hash table the JSON parser produced." + (make-health :status (json-string data "status") + :dne (json-string data "dne") + :ceps (json-integer data "ceps") + :geo (json-integer data "geo") + :base-gerada-em (json-string data "base_gerada_em"))) diff --git a/src/package.lisp b/src/package.lisp new file mode 100644 index 0000000..20d6f32 --- /dev/null +++ b/src/package.lisp @@ -0,0 +1,100 @@ +(defpackage #:cepis + (:use #:common-lisp) + (:documentation + "Common Lisp client for the public CEP API at https://cep.is. + +Quick use — the functions take the client as a keyword argument, defaulting +to the shared client in `*client*': + + (cepis:lookup \"01001-000\") + +In an application, build a client once and pass it explicitly: + + (defvar *cep* (cepis:make-client :timeout 5 :total-timeout 15)) + (cepis:lookup \"01001000\" :client *cep*) + +Pointing at a local instance (the API repo brings one up with `just up'): + + (cepis:make-client :base-url \"http://localhost:8080\") + +Errors are conditions split by the decision the caller has to make — whether +retrying helps or not. Everything derives from `cepis-error': + + (handler-case (cepis:lookup cep) + (cepis:cep-not-found () :ask-again) + (cepis:cepis-error () :retry-later)) + +Note on field names: the API surface is English, but the data fields keep the +API's own Portuguese names (`logradouro', `bairro', `localidade'). What you +read in the JSON is what you access on the object; the only adaptation is +Lisp's hyphenation, so the JSON `raio_m' is the slot `raio-m', read with +`geo-raio-m'.") + (:export + #:+default-url+ + #:+max-batch+ + #:+version+ + + #:cepis-error + #:invalid-cep + #:cep-not-found + #:network-error + #:server-error + #:rate-limited + #:invalid-response + #:error-message + #:server-error-status + #:rate-limited-retry-after + + #:geo + #:geo-p + #:make-geo + #:geo-lat + #:geo-lon + #:geo-raio-m + #:geo-precisao + #:geo-precise-p + + #:address + #:address-p + #:make-address + #:address-cep + #:address-logradouro + #:address-complemento + #:address-unidade + #:address-bairro + #:address-localidade + #:address-uf + #:address-estado + #:address-regiao + #:address-ibge + #:address-gia + #:address-ddd + #:address-siafi + #:address-geo + #:address-raw + #:address-formatted-cep + + #:health + #:health-p + #:make-health + #:health-status + #:health-dne + #:health-ceps + #:health-geo + #:health-base-gerada-em + #:health-ok-p + + #:client + #:make-client + #:client-base-url + #:client-timeout + #:client-max-attempts + #:client-backoff-base + #:client-backoff-max + #:client-total-timeout + #:client-user-agent + #:*client* + + #:normalize-cep + #:lookup + #:lookup-many)) diff --git a/tests/package.lisp b/tests/package.lisp new file mode 100644 index 0000000..62113e3 --- /dev/null +++ b/tests/package.lisp @@ -0,0 +1,3 @@ +(defpackage #:cepis/tests + (:use #:common-lisp #:fiveam #:cepis) + (:export #:cepis #:run-tests)) diff --git a/tests/server.lisp b/tests/server.lisp new file mode 100644 index 0000000..7725485 --- /dev/null +++ b/tests/server.lisp @@ -0,0 +1,156 @@ +(in-package #:cepis/tests) + +(defstruct (fake-server (:constructor %make-fake-server)) + "A throwaway HTTP server on a random loopback port. + +The suite points a client at it with :base-url, so the code path exercised is +the one that runs in production, request construction and error body reading +included. Nothing is stubbed and no test touches the network." + socket + thread + port + (routes (make-hash-table :test #'equal)) + (calls '()) + (handler nil) + (lock (bt:make-lock)) + (running t)) + +(defun reason-phrase (status) + (case status + (200 "OK") + (400 "Bad Request") + (404 "Not Found") + (429 "Too Many Requests") + (500 "Internal Server Error") + (503 "Service Unavailable") + (t "Status"))) + +(defun reply (status body &optional headers) + "A response the fake server can send: status line, body, extra headers." + (list status body headers)) + +(defun respond (server path response) + "Register RESPONSE for PATH. + +RESPONSE is one `reply', or a list of them headed by :sequence — in which case +each request consumes the next one, which is how retrying is tested. The last +entry repeats once the list runs out." + (setf (gethash path (fake-server-routes server)) response)) + +(defun next-response (server path) + "Record the call and return the response registered for PATH." + (bt:with-lock-held ((fake-server-lock server)) + (push path (fake-server-calls server)) + (let ((handler (fake-server-handler server))) + (if handler + (funcall handler path) + (let ((response (gethash path (fake-server-routes server)))) + (cond ((null response) + (reply 404 "{\"erro\":\"cep_nao_encontrado\"}")) + ((eq (first response) :sequence) + (let ((remaining (rest response))) + (when (rest remaining) + (setf (gethash path (fake-server-routes server)) + (cons :sequence (rest remaining)))) + (first remaining))) + (t response))))))) + +(defun call-count (server prefix) + "How many requests so far began with PREFIX." + (bt:with-lock-held ((fake-server-lock server)) + (count-if (lambda (path) + (and (>= (length path) (length prefix)) + (string= prefix path :end2 (length prefix)))) + (fake-server-calls server)))) + +(defun total-calls (server) + (bt:with-lock-held ((fake-server-lock server)) + (length (fake-server-calls server)))) + +(defun read-http-line (stream) + "Read one CRLF-terminated line of a request, or NIL at end of input." + (let ((line (make-string-output-stream)) + (any nil)) + (loop for byte = (read-byte stream nil nil) + do (cond ((null byte) (return)) + ((= byte 10) (setf any t) (return)) + ((= byte 13)) + (t (setf any t) (write-char (code-char byte) line)))) + (when any + (get-output-stream-string line)))) + +(defun write-http-response (stream status body headers) + (let* ((data (babel:string-to-octets body :encoding :utf-8)) + (head (with-output-to-string (out) + (format out "HTTP/1.1 ~d ~a~c~c" status (reason-phrase status) + #\Return #\Newline) + (loop for (name . value) in headers + do (format out "~a: ~a~c~c" name value #\Return #\Newline)) + (format out "Content-Length: ~d~c~c" (length data) #\Return #\Newline) + (format out "Connection: close~c~c~c~c" + #\Return #\Newline #\Return #\Newline)))) + (write-sequence (babel:string-to-octets head :encoding :latin-1) stream) + (write-sequence data stream) + (finish-output stream))) + +(defun handle-connection (server connection) + (let ((stream (usocket:socket-stream connection))) + (let ((request-line (read-http-line stream))) + (when request-line + (loop for header = (read-http-line stream) + while (and header (plusp (length header)))) + (let* ((parts (uiop:split-string request-line :separator " ")) + (path (or (second parts) "/"))) + (destructuring-bind (status body &optional headers) + (next-response server path) + (write-http-response stream status body headers))))))) + +(defun serve-loop (server) + (loop while (fake-server-running server) + do (when (usocket:wait-for-input (fake-server-socket server) + :timeout 0.05 :ready-only t) + (let ((connection (ignore-errors + (usocket:socket-accept (fake-server-socket server) + :element-type '(unsigned-byte 8))))) + (when connection + (bt:make-thread + (lambda () + (unwind-protect + (ignore-errors (handle-connection server connection)) + (ignore-errors (usocket:socket-close connection)))) + :name "cepis-test-connection")))))) + +(defun start-fake-server () + (let* ((socket (usocket:socket-listen "127.0.0.1" 0 + :reuse-address t + :element-type '(unsigned-byte 8))) + (server (%make-fake-server :socket socket + :port (usocket:get-local-port socket)))) + (setf (fake-server-thread server) + (bt:make-thread (lambda () (serve-loop server)) :name "cepis-test-server")) + server)) + +(defun stop-fake-server (server) + (setf (fake-server-running server) nil) + (ignore-errors (bt:join-thread (fake-server-thread server))) + (ignore-errors (usocket:socket-close (fake-server-socket server)))) + +(defun fake-server-url (server) + (format nil "http://127.0.0.1:~d" (fake-server-port server))) + +(defmacro with-fake-server ((server client &rest client-args) &body body) + "Run BODY with SERVER listening and CLIENT pointed at it. + +The backoff is near zero because what is under test is the retry logic, not +the ability of `sleep' to sleep." + `(let ((,server (start-fake-server))) + (unwind-protect + (let ((,client (apply #'make-client + :base-url (fake-server-url ,server) + (append (list ,@client-args) + (list :timeout 5.0 + :backoff-base 0.001 + :backoff-max 0.01))))) + (declare (ignorable ,client)) + ,@body) + (stop-fake-server ,server)))) diff --git a/tests/suite.lisp b/tests/suite.lisp new file mode 100644 index 0000000..4ef0c5f --- /dev/null +++ b/tests/suite.lisp @@ -0,0 +1,259 @@ +(in-package #:cepis/tests) + +(def-suite cepis + :description "The whole cepis suite, run against a local HTTP server.") + +(in-suite cepis) + +(defparameter +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\"") + +(defparameter +csv-header+ + "cep,logradouro,complemento,unidade,bairro,localidade,uf,estado,regiao,ibge,gia,ddd,siafi") + +(defun se-json (&rest extra-fields) + "The fixture address, with EXTRA-FIELDS spliced in as raw JSON members." + (format nil "{~a~{,~a~}}" +se-fields+ extra-fields)) + +(defun csv-body (&rest rows) + (format nil "~a~%~{~a~%~}" +csv-header+ rows)) + +(defmacro signalled-message (condition-type &body body) + "Run BODY and return the message of the CONDITION-TYPE it signals, or NIL." + `(handler-case (progn ,@body nil) + (,condition-type (condition) (error-message condition)))) + +(test normalisation-accepts-masked-and-unmasked + (dolist (value '("01001000" "01001-000" " 01001-000 " "01001.000")) + (is (string= "01001000" (normalize-cep value))))) + +(test normalisation-rejects-bad-format + (dolist (value '("" "123" "0100100a" "010010000" "abcdefgh")) + (signals invalid-cep (normalize-cep value)))) + +(test normalisation-rejects-wrong-type + (signals invalid-cep (normalize-cep 1001000))) + +(test normalisation-is-a-parse-error + (signals parse-error (normalize-cep "123"))) + +(test successful-lookup + (with-fake-server (server client) + (respond server "/01001000" (reply 200 (se-json))) + (let ((address (lookup "01001-000" :client client))) + (is (string= "São Paulo" (address-localidade address))) + (is (string= "SP" (address-uf address))) + (is (string= "01001-000" (address-formatted-cep address))) + (is (null (address-geo address)))))) + +(test reads-the-coordinate-when-present + (with-fake-server (server client) + (respond server "/01310100" + (reply 200 (se-json "\"geo\":{\"lat\":-23.5,\"lon\":-46.6,\"raio_m\":120,\"precisao\":\"logradouro\"}"))) + (let ((geo (address-geo (lookup "01310100" :client client)))) + (is (< (abs (- -23.5d0 (geo-lat geo))) 1d-9)) + (is (= 120 (geo-raio-m geo))) + (is (geo-precise-p geo))))) + +(test municipality-coordinate-is-not-precise + (with-fake-server (server client) + (respond server "/01001000" + (reply 200 (se-json "\"geo\":{\"lat\":-23.5,\"lon\":-46.6,\"raio_m\":22000,\"precisao\":\"localidade\"}"))) + (let ((geo (address-geo (lookup "01001000" :client client)))) + (is (not (geo-precise-p geo)))))) + +(test malformed-geo-does-not-lose-the-address + (with-fake-server (server client) + (respond server "/01001000" (reply 200 (se-json "\"geo\":{\"lat\":\"not a number\"}"))) + (let ((address (lookup "01001000" :client client))) + (is (null (address-geo address))) + (is (string= "São Paulo" (address-localidade address)))))) + +(test new-api-field-does-not-break + (with-fake-server (server client) + (respond server "/01001000" (reply 200 (se-json "\"campo_do_futuro\":\"value\""))) + (let ((address (lookup "01001000" :client client))) + (is (string= "value" (gethash "campo_do_futuro" (address-raw address))))))) + +(test not-found + (with-fake-server (server client) + (respond server "/99999999" + (reply 404 "{\"erro\":\"cep_nao_encontrado\",\"mensagem\":\"gone\"}")) + (signals cep-not-found (lookup "99999999" :client client)) + (handler-case (lookup "99999999" :client client) + (cep-not-found (condition) + (is (string= "99999999" (cell-error-name condition))))))) + +(test not-found-is-not-retried + (with-fake-server (server client) + (respond server "/99999999" (reply 404 "{\"erro\":\"cep_nao_encontrado\"}")) + (signals cep-not-found (lookup "99999999" :client client)) + (is (= 1 (call-count server "/99999999"))))) + +(test invalid-cep-never-leaves-the-machine + (with-fake-server (server client) + (signals invalid-cep (lookup "123" :client client)) + (is (zerop (total-calls server))))) + +(test api-400-becomes-invalid-cep + (with-fake-server (server client) + (respond server "/00000000" + (reply 400 "{\"erro\":\"cep_invalido\",\"mensagem\":\"rejected by the API\"}")) + (is (search "rejected by the API" + (or (signalled-message invalid-cep (lookup "00000000" :client client)) ""))))) + +(test response-that-is-not-json + (with-fake-server (server client) + (respond server "/01001000" (reply 200 "<html>captive portal</html>")) + (signals invalid-response (lookup "01001000" :client client)))) + +(test retries-on-500-then-succeeds + (with-fake-server (server client) + (respond server "/01001000" + (list :sequence + (reply 500 "{\"erro\":\"interno\"}") + (reply 200 (se-json)))) + (is (string= "São Paulo" (address-localidade (lookup "01001000" :client client)))) + (is (= 2 (call-count server "/01001000"))))) + +(test exhausts-attempts-then-signals + (with-fake-server (server client) + (respond server "/01001000" (reply 503 "{\"erro\":\"interno\"}")) + (handler-case (progn (lookup "01001000" :client client) (fail "expected a server-error")) + (server-error (condition) + (is (= 503 (server-error-status condition))))) + (is (= 3 (call-count server "/01001000"))))) + +(test max-attempts-one-disables-retry + (with-fake-server (server client :max-attempts 1) + (respond server "/01001000" (reply 500 "{}")) + (signals server-error (lookup "01001000" :client client)) + (is (= 1 (call-count server "/01001000"))))) + +(test 429-becomes-rate-limited-with-retry-after + (with-fake-server (server client) + (respond server "/01001000" (reply 429 "{}" '(("Retry-After" . "7")))) + (handler-case (progn (lookup "01001000" :client client) (fail "expected a rate-limited")) + (rate-limited (condition) + (is (= 7 (rate-limited-retry-after condition))))))) + +(test retry-after-honours-the-cap + (with-fake-server (server client) + (respond server "/01001000" (reply 429 "{}" '(("Retry-After" . "3600")))) + (let ((started (get-internal-real-time))) + (signals rate-limited (lookup "01001000" :client client)) + (is (< (/ (- (get-internal-real-time) started) + internal-time-units-per-second) + 5))))) + +(test network-error-when-nothing-listens + (let ((client (make-client :base-url "http://127.0.0.1:1" + :max-attempts 2 + :backoff-base 0.001 + :backoff-max 0.01 + :timeout 1.0))) + (signals network-error (lookup "01001000" :client client)))) + +(test total-timeout-bounds-the-whole-call + (with-fake-server (server client + :max-attempts 50 :backoff-base 0.05 + :backoff-max 0.05 :total-timeout 0.3) + (respond server "/01001000" (reply 500 "{}")) + (let ((started (get-internal-real-time))) + (signals server-error (lookup "01001000" :client client)) + (is (< (/ (- (get-internal-real-time) started) + internal-time-units-per-second) + 5)) + (is (< (call-count server "/01001000") 50))))) + +(test batch-preserves-order-and-marks-missing + (with-fake-server (server client) + (respond server "/csv?ceps=01001000%2C99999999%2C20040020" + (reply 200 (csv-body + "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"))) + (let ((result (lookup-many '("01001000" "99999999" "20040020") :client client))) + (is (= 3 (length result))) + (is (string= "São Paulo" (address-localidade (first result)))) + (is (null (second result))) + (is (string= "RJ" (address-uf (third result))))))) + +(test batch-field-with-comma-is-parsed + (with-fake-server (server client) + (respond server "/csv?ceps=01001000" + (reply 200 (csv-body + "01001000,\"Rua Um, Dois\",,,Centro,São Paulo,SP,São Paulo,Sudeste,1,,11,1"))) + (let ((result (lookup-many '("01001000") :client client))) + (is (string= "Rua Um, Dois" (address-logradouro (first result))))))) + +(test batch-carries-no-coordinate + (with-fake-server (server client) + (respond server "/csv?ceps=01001000" + (reply 200 (csv-body + "01001000,Praça da Sé,,,Sé,São Paulo,SP,São Paulo,Sudeste,1,,11,1"))) + (is (null (address-geo (first (lookup-many '("01001000") :client client))))))) + +(test batch-empty-list-makes-no-request + (with-fake-server (server client) + (is (null (lookup-many '() :client client))) + (is (zerop (total-calls server))))) + +(test batch-chunks-above-the-api-limit + (with-fake-server (server client) + (let ((ceps (loop for index from 0 below 501 collect (format nil "~8,'0d" index))) + (calls 0)) + (setf (fake-server-handler server) + (lambda (path) + (declare (ignore path)) + (incf calls) + (reply 200 (apply #'csv-body + (mapcar (lambda (cep) + (format nil "~a,,,,,X,SP,São Paulo,Sudeste,1,,11,1" cep)) + (if (= calls 1) + (subseq ceps 0 500) + (subseq ceps 500))))))) + (let ((result (lookup-many ceps :client client))) + (is (= 2 calls)) + (is (= 501 (length result))))))) + +(test batch-truncated-response-does-not-shift + (with-fake-server (server client) + (respond server "/csv?ceps=01001000%2C20040020" + (reply 200 (csv-body + "01001000,,,,,São Paulo,SP,São Paulo,Sudeste,1,,11,1"))) + (let ((result (lookup-many '("01001000" "20040020") :client client))) + (is (= 2 (length result))) + (is (null (second result)))))) + +(test reads-health + (with-fake-server (server client) + (respond server "/health" + (reply 200 "{\"status\":\"ok\",\"dne\":\"26071\",\"ceps\":1596168,\"geo\":894489,\"base_gerada_em\":\"2026-07-24T03:48:28Z\"}")) + (let ((health (health :client client))) + (is (health-ok-p health)) + (is (string= "26071" (health-dne health))) + (is (= 1596168 (health-ceps health))) + (is (string= "2026-07-24T03:48:28Z" (health-base-gerada-em health)))))) + +(test degraded-health-does-not-signal + (with-fake-server (server client) + (respond server "/health" + (reply 503 "{\"status\":\"degradado\",\"dne\":\"\",\"ceps\":0,\"geo\":0}")) + (let ((health (health :client client))) + (is (not (health-ok-p health))) + (is (= 1 (call-count server "/health")))))) + +(test trailing-slash-is-not-duplicated + (is (string= "http://x" (client-base-url (make-client :base-url "http://x/"))))) + +(test invalid-parameters-are-rejected + (signals error (make-client :max-attempts 0)) + (signals error (make-client :timeout 0))) + +(test user-agent-identifies-the-library + (is (search "cepis-lisp/" (client-user-agent (make-client))))) + +(defun run-tests () + "Run the whole suite. Returns true when every test passed." + (run! 'cepis)) |