summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMurilo Ijanc <[email protected]>2026-07-26 12:42:28 -0300
committerMurilo Ijanc <[email protected]>2026-07-26 12:42:28 -0300
commitae9ad8a4c61b793f6859c84dac80b1c1b04b7b68 (patch)
tree62271e7672dfc58f59dda2ea4dc539c89a1ea5ca
downloadlisp-e70c29ecac7aee94b167621bca6289a27fe64d14.tar.gz
Initial importv0.1.0
-rw-r--r--.gitignore9
-rw-r--r--LICENSE15
-rw-r--r--Makefile51
-rw-r--r--README.md221
-rw-r--r--cepis.asd29
-rw-r--r--src/client.lisp403
-rw-r--r--src/csv.lisp60
-rw-r--r--src/errors.lisp73
-rw-r--r--src/models.lisp147
-rw-r--r--src/package.lisp100
-rw-r--r--tests/package.lisp3
-rw-r--r--tests/server.lisp156
-rw-r--r--tests/suite.lisp259
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
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..5e9104d
--- /dev/null
+++ b/LICENSE
@@ -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))