path: root/src/client.lisp

(in-package #:cepis)

(defparameter +version+ "0.2.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 error-faixa (body)
  "The \"faixa\" block of an error body as a `faixa', or NIL when there is none.

Every failure to read it is NIL: a body that is not JSON, a `faixa' that is not
an object, an API too old to send the field. A not-found is a definitive answer
about the request, and a field that only says which municipality the CEP would
have belonged to must never be able to turn it into an `invalid-response'."
  (handler-case
      (let ((data (com.inuoe.jzon:parse (body-text body))))
        (when (hash-table-p data)
          (faixa-from-json (gethash "faixa" data))))
    (error () nil)))

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

A `cep-not-found' may carry a `faixa' in `cep-not-found-faixa': the
municipality that owns the band the CEP falls in, when the API knows one. It is
context for the error and nothing more — the answer is still a 404, and the
band is sparse, so it says which city to ask about, never which CEPs are valid.

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
                    :faixa (error-faixa body)
                    :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))))