diff options
| author | Murilo Ijanc <[email protected]> | 2026-07-26 12:45:04 -0300 |
|---|---|---|
| committer | Murilo Ijanc <[email protected]> | 2026-07-26 12:45:04 -0300 |
| commit | cf5597871327dbff2c7c743672d696e7ff340c42 (patch) | |
| tree | 2502272b9042d9bc980b20a8a3f308b7c5e7fe87 | |
| download | pascal-1142e26bb81ef5e809b0ed7bd09d622cc87d31ed.tar.gz | |
Initial importv0.1.0
| -rw-r--r-- | .gitignore | 18 | ||||
| -rw-r--r-- | LICENSE | 15 | ||||
| -rw-r--r-- | Makefile | 42 | ||||
| -rw-r--r-- | README.md | 266 | ||||
| -rw-r--r-- | src/Cepis.pas | 1275 | ||||
| -rw-r--r-- | src/CepisHttp.pas | 178 | ||||
| -rw-r--r-- | tests/TestCepis.pas | 1161 |
7 files changed, 2955 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..d5bb80f --- /dev/null +++ b/.gitignore @@ -0,0 +1,18 @@ +build/ +lib/ +backup/ +*.ppu +*.ppl +*.o +*.or +*.a +*.so +*.dbg +*.compiled +*.bak +*.exe +*.dll +*.res +*.dcu +*.lps +__history/ @@ -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..9ec6301 --- /dev/null +++ b/Makefile @@ -0,0 +1,42 @@ +FPC ?= fpc +SRCDIR := src +TESTDIR := tests +BUILDDIR := build +UNITDIR := $(BUILDDIR)/units +LINTDIR := $(BUILDDIR)/lint +TESTBIN := $(BUILDDIR)/testcepis + +FPCFLAGS ?= -O2 -vewn -Fu$(SRCDIR) +LINTFLAGS ?= -Sew -vewnh -Fu$(SRCDIR) + +.DEFAULT_GOAL := help +.PHONY: help build test lint check clean + +help: + @echo 'Targets:' + @echo ' build compile the units into $(UNITDIR)' + @echo ' test compile and run the suite against a local HTTP server' + @echo ' lint compile with warnings as errors, into a scratch dir' + @echo ' check lint + test + build, in that order' + @echo ' clean remove $(BUILDDIR)' + @echo + @echo 'Override the compiler with e.g. make build FPC=ppcx64' + +build: + @mkdir -p $(UNITDIR) + $(FPC) $(FPCFLAGS) -FU$(UNITDIR) $(SRCDIR)/Cepis.pas + +test: + @mkdir -p $(UNITDIR) + $(FPC) $(FPCFLAGS) -FU$(UNITDIR) -FE$(BUILDDIR) -otestcepis $(TESTDIR)/TestCepis.pas + ./$(TESTBIN) --all --format=plain + +lint: + @mkdir -p $(LINTDIR) + $(FPC) $(LINTFLAGS) -FU$(LINTDIR) $(SRCDIR)/Cepis.pas + $(FPC) $(LINTFLAGS) -FU$(LINTDIR) -FE$(LINTDIR) -otestcepis $(TESTDIR)/TestCepis.pas + +check: lint test build + +clean: + rm -rf $(BUILDDIR) diff --git a/README.md b/README.md new file mode 100644 index 0000000..3129bd8 --- /dev/null +++ b/README.md @@ -0,0 +1,266 @@ +# cepis + +Object Pascal client for the [public CEP API at cep.is](https://cep.is). +Official Correios data (DNE), refreshed every two weeks. + +```pascal +uses Cepis; + +var + Address: TCepisAddress; +begin + Address := CepisLookup('01001-000'); + try + WriteLn(Address.Logradouro, ' ', Address.Localidade, ' ', Address.UF); + // Praça da Sé São Paulo SP + finally + Address.Free; + end; +end. +``` + +## Installation + +There is nothing to build and no package manager involved. Copy the repository +somewhere and put `src/` on the unit search path: + +```sh +git clone https://git.cep.is/pascal.git +fpc -Fu/path/to/cepis-pascal/src yourprogram.pas +``` + +Requires Free Pascal 3.2 or newer. Only units that ship with the compiler are +used: `fphttpclient`, `opensslsockets`, `fpjson`, `jsonparser` and +`csvdocument`. + +### HTTPS needs OpenSSL + +`fphttpclient` loads OpenSSL at run time, so an `https://` base URL — which is +the default — needs `libssl` and `libcrypto` reachable by the dynamic loader +under a name FPC looks for. On Debian and Ubuntu that means `libssl-dev` +installed, which provides the unversioned `libssl.so` and `libcrypto.so` +symlinks; on other systems install the equivalent development package. + +Without them every request fails with `ECepisNetworkError: Could not +initialize OpenSSL library`. Plain `http://` needs nothing. + +### Delphi + +Developed and tested with Free Pascal. The HTTP call is isolated in +`CepisHttp.pas`, which has a `System.Net.HttpClient` branch for Delphi; the +JSON and CSV parsing in `Cepis.pas` uses the FCL units above and would need the +`System.JSON` equivalents. The Delphi branch has never been compiled. + +## Ownership + +Every object a method returns belongs to the caller, who frees it, with two +exceptions: + +| object | freed by | +| --- | --- | +| `TCepisAddress` from `Lookup` | you | +| `TCepisAddressList` from `LookupMany` | you — and freeing it frees the addresses inside | +| `TCepisHealth` from `Health` | you | +| `TCepisGeo` on an address | its address | +| the client behind `CepisLookup` and friends | the `Cepis` unit, at finalisation | + +`TCepisAddressList.Extract` and `TCepisAddress.ExtractGeo` hand ownership over +when you need one item to outlive its container. + +## Usage + +### A single lookup + +`Lookup` accepts the CEP masked or unmasked and returns a `TCepisAddress`: + +```pascal +Address := CepisLookup('01310-100'); + +Address.Logradouro; // 'Avenida Paulista' +Address.Localidade; // 'São Paulo' +Address.UF; // 'SP' +Address.Ibge; // '3550308' +Address.Cep; // '01310100' (always unmasked) +Address.FormattedCEP; // '01310-100' +``` + +Fields the database does not have for that CEP come back as empty strings, +never `nil`. Strings are UTF-8. + +### Coordinates + +About 57% of CEPs have a coordinate. When they do not, `Geo` is `nil`: + +```pascal +if Address.Geo <> nil then +begin + WriteLn(Address.Geo.Lat:0:6, ' ', Address.Geo.Lon:0:6); // -23.567202 -46.649659 + WriteLn(Address.Geo.RaioM); // 1084 + WriteLn(Address.Geo.Precisao); // logradouro +end; +``` + +**Check `Precisao` before computing distance.** There are two kinds of point, +and the difference between them is tens of kilometres: + +| `Precisao` | typical radius | what the point is | +| --- | --- | --- | +| `logradouro` | 110–140 m | the stretch of street — good for maps and distance | +| `localidade` | 7–40 km | the municipality centroid: the CEP *is* the whole city | + +`Address.Geo.IsPrecise` is the shorthand for `Precisao = 'logradouro'`: + +```pascal +if (Address.Geo <> nil) and Address.Geo.IsPrecise then + Cost := ShippingFrom(Address.Geo.Lat, Address.Geo.Lon) +else + Cost := ShippingFromMunicipality(Address.Ibge); +``` + +### Many CEPs at once + +Do not loop over `Lookup`. Use `LookupMany`, which resolves up to 500 CEPs per +request: + +```pascal +var + Ceps: array[0..2] of string = ('01001000', '99999999', '20040020'); + Result: TCepisAddressList; + I: Integer; +begin + Result := CepisLookupMany(Ceps); + try + for I := 0 to Result.Count - 1 do + if Result[I] = nil then + WriteLn(Ceps[I], ': not found') + else + WriteLn(Ceps[I], ': ', Result[I].Localidade); + finally + Result.Free; + end; +end; +``` + +The 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 raise. + +Input longer than 500 is chunked automatically. + +> **Batches carry no coordinate.** The endpoint behind them is CSV, and the CSV +> has no `geo` column. Every address from `LookupMany` has `Geo = nil`, +> including for CEPs that do have one. Need `Geo`? Use `Lookup`, one at a time. + +### API health + +Useful for two things: checking the API answers, and knowing **which version of +the database** is live: + +```pascal +Health := CepisHealth; +try + Health.Ok; // True + Health.Dne; // '26071' identifier of the fortnightly database + Health.Ceps; // 1596168 + Health.BaseGeradaEm; // '2026-07-24T03:48:28Z' +finally + Health.Free; +end; +``` + +An API reporting itself degraded does not raise — that arrives in +`Health.Status`. + +## Configuration + +For anything beyond the defaults, build a `TCepisClient` and reuse it. It keeps +no state between calls: + +```pascal +Client := TCepisClient.Create; +try + Client.BaseURL := 'https://cep.is'; // point at another instance + Client.Timeout := 10.0; // seconds per socket operation + Client.MaxAttempts := 3; // counting the first; 1 disables retrying + Client.BackoffBase := 0.5; // base of the exponential wait + Client.BackoffMax := 8.0; // cap on each wait + Client.TotalTimeout := 0; // cap on the whole call; 0 means none + Client.UserAgent := 'myapp/1.0'; + + Address := Client.Lookup('01001000'); + ... +finally + Client.Free; +end; +``` + +Retries cover 429, 5xx and network failures, with exponential backoff and +jitter; 400 and 404 are never retried. + +`CepisLookup`, `CepisLookupMany` and `CepisHealth` share one default client. Do +not reconfigure it: it applies process-wide, including to other code in the same +program that uses this unit. Need different settings? Build your own. + +### Pointing at a local instance + +`BaseURL` is the only property that usually changes between environments. The +API repo brings a local instance up with `just up`: + +```pascal +Client.BaseURL := 'http://localhost:8080'; +``` + +## Errors + +Everything derives from `ECepis`. Below that, the split is by **the decision you +have to make**, not by the HTTP status that caused it: + +| error | when | does retrying help? | +| --- | --- | --- | +| `ECepisInvalidCEP` | not 8 digits | no | +| `ECepisNotFound` | well-formed, not in the database | no | +| `ECepisRateLimited` | 429; carries `RetryAfter` | yes, later | +| `ECepisServerError` | 5xx; carries `Status` | yes, later | +| `ECepisNetworkError` | DNS, connection, timeout, TLS | yes, later | +| `ECepisInvalidResponse` | unintelligible response | probably not | + +```pascal +try + Address := CepisLookup(CepFromForm); +except + on E: ECepisNotFound do + ; // ask the user for another CEP + on E: ECepis do + ; // transient failure: reschedule +end; +``` + +`CepisNormalizeCEP` strips the mask and validates the 8 digits on its own, for +code that wants to check before it asks: + +```pascal +Number := CepisNormalizeCEP(' 01001-000 '); // '01001000' +``` + +`ECepisInvalidResponse` 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 shells out to `fpc`: + +```sh +make # list the targets +make test # compile and run the suite against a local HTTP server +make lint # compile with warnings as errors, touches nothing +make build # compile the units into build/units +make check # lint, then test, then build +``` + +The suite stands up a real HTTP server on loopback and points `BaseURL` at it. +It needs no network. + +## Licence + +ISC. See [LICENSE](LICENSE). diff --git a/src/Cepis.pas b/src/Cepis.pas new file mode 100644 index 0000000..7b628e9 --- /dev/null +++ b/src/Cepis.pas @@ -0,0 +1,1275 @@ +{ + Object Pascal client for the public CEP API at https://cep.is - official + Correios data (DNE), refreshed every two weeks. + + Quick use, through the shared default client: + + Address := CepisLookup('01001-000'); + try + WriteLn(Address.Localidade, ' ', Address.UF); + finally + Address.Free; + end; + + In an application, build a TCepisClient once and reuse it. It keeps no state + between calls. + + Ownership, in one sentence: every object this unit hands back belongs to the + caller, who frees it - except the geo block, which belongs to its address, + and the default client, which belongs to this unit. + + 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. +} +unit Cepis; + +{$IFDEF FPC} + {$MODE OBJFPC} + {$H+} +{$ENDIF} + +interface + +uses + SysUtils, Classes; + +const + { Version of this library, as it appears in the default User-Agent. } + CepisVersion = '0.1.0'; + + { Where the API lives when nothing else is configured. } + CepisDefaultURL = 'https://cep.is'; + + { CEPs the API accepts in one batch request. Larger input is chunked. } + CepisMaxBatch = 500; + +type + { + Base of every error this unit raises. Catch it to handle any failure. + + Below it, the split is by the decision the caller has to make, not by the + HTTP status that caused it. ECepisInvalidCEP and ECepisNotFound are + problems with the request: retrying is pointless. ECepisNetworkError, + ECepisServerError and ECepisRateLimited are problems with transport, and + the client already retried on its own before raising any of them. + + Object Pascal has single inheritance, so - unlike the Python original, + where the CEP errors are also ValueError and KeyError - these hook into no + second hierarchy. + } + ECepis = class(Exception); + + { + The CEP is not 8 digits. + + Usually raised without a request ever being made: the format is checked + before anything goes to the network. Also raised when the API itself + answers 400, in which case the message is the API's own. + } + ECepisInvalidCEP = class(ECepis); + + { + The CEP is well formed but does not exist in the DNE database. + } + ECepisNotFound = class(ECepis); + + { + The request never completed: DNS, refused connection, timeout, TLS. + + Raised only after every configured attempt has failed. + } + ECepisNetworkError = class(ECepis); + + { + 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. + } + ECepisInvalidResponse = class(ECepis); + + { + The API, or the edge in front of it, answered 429 on every attempt. + } + ECepisRateLimited = class(ECepis) + private + FRetryAfter: Double; + public + constructor Create(const AMessage: string; ARetryAfter: Double); reintroduce; + + { + Seconds the server asked to be left alone, or a negative value if it did + not say. The client already honoured it across the attempts it made; it + is exposed here for callers who want to reschedule the work. + } + property RetryAfter: Double read FRetryAfter; + end; + + { + The API answered 5xx on every attempt. + } + ECepisServerError = class(ECepis) + private + FStatus: Integer; + public + constructor Create(const AMessage: string; AStatus: Integer); reintroduce; + + { HTTP status seen on the last attempt. } + property Status: Integer read FStatus; + end; + + { + 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 Precisao before using Lat/Lon for distance: + + - 'logradouro': the point is a stretch of street. RaioM 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. RaioM runs from 7 km to 40 km. + Computing shipping from this is wrong by tens of kilometres. + + Owned by the TCepisAddress that carries it, and freed with it. Use + TCepisAddress.ExtractGeo to take ownership. + } + TCepisGeo = class(TPersistent) + private + FLat: Double; + FLon: Double; + FRaioM: Integer; + FPrecisao: string; + function GetIsPrecise: Boolean; + public + constructor Create(ALat, ALon: Double; ARaioM: Integer; + const APrecisao: string); + + { + True when the coordinate points at a street, not a municipality. + + Shorthand for Precisao = 'logradouro', which is the check to make before + using the point to measure distance. + } + property IsPrecise: Boolean read GetIsPrecise; + published + { Latitude, in degrees. } + property Lat: Double read FLat; + + { Longitude, in degrees. } + property Lon: Double read FLon; + + { + Radius, in metres, containing 90% of that CEP's addresses. It exists + precisely so the error in Lat/Lon cannot pass unnoticed. + } + property RaioM: Integer read FRaioM; + + { Either 'logradouro' or 'localidade'. See IsPrecise. } + property Precisao: string read FPrecisao; + end; + + { + 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. + + 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. + + The caller owns every instance returned by TCepisClient.Lookup and must + free it. Instances inside a TCepisAddressList belong to that list. + } + TCepisAddress = class(TPersistent) + private + FCep: string; + FLogradouro: string; + FComplemento: string; + FUnidade: string; + FBairro: string; + FLocalidade: string; + FUF: string; + FEstado: string; + FRegiao: string; + FIbge: string; + FGia: string; + FDdd: string; + FSiafi: string; + FGeo: TCepisGeo; + FRaw: string; + function GetFormattedCEP: string; + public + { Frees the Geo block, if any. } + destructor Destroy; override; + + { + Hand the coordinate over to the caller, who becomes responsible for + freeing it. Geo is nil afterwards. Returns nil when there was none. + } + function ExtractGeo: TCepisGeo; + + { + Read a field straight out of Raw by name, as text. + + Escape hatch for a field the API grew before this library was updated. + Returns an empty string when Raw is empty (batch results) or the field is + absent. Parses Raw on every call, so do not put it in a tight loop. + } + function RawField(const AName: string): string; + + { + The CEP with its mask: '01001-000'. + + The API always returns it unmasked; formatting is presentation, and it + lives here so it does not become a repeated Format call in every project. + } + property FormattedCEP: string read GetFormattedCEP; + published + { The 8 digits, unmasked. } + property Cep: string read FCep; + + { Street name, when the CEP is a street rather than a whole locality. } + property Logradouro: string read FLogradouro; + + { Free-text qualifier of the street range, e.g. 'lado impar'. } + property Complemento: string read FComplemento; + + { Name of the large-volume recipient, for CEPs that identify one. } + property Unidade: string read FUnidade; + + { Neighbourhood. } + property Bairro: string read FBairro; + + { Municipality. } + property Localidade: string read FLocalidade; + + { Two-letter state code, e.g. 'SP'. } + property UF: string read FUF; + + { State name in full, e.g. 'Sao Paulo'. } + property Estado: string read FEstado; + + { Region of the country, e.g. 'Sudeste'. } + property Regiao: string read FRegiao; + + { IBGE municipality code - the key to join against census data. } + property Ibge: string read FIbge; + + { GIA code, Sao Paulo state tax administration. Often empty. } + property Gia: string read FGia; + + { Area code for telephone numbers. } + property Ddd: string read FDdd; + + { SIAFI code, federal administration. } + property Siafi: string read FSiafi; + + { + The coordinate, or nil when the database has none for this CEP. + + Always nil for an address that came out of a batch: see + TCepisClient.LookupMany. + } + property Geo: TCepisGeo read FGeo; + + { + The response body exactly as it arrived, uninterpreted, so a field the + API grows before this library is updated is not lost. Empty for addresses + that came out of a batch, whose source is CSV. See RawField. + } + property Raw: string read FRaw; + end; + + { + Addresses in the order they were requested, with a nil where the CEP was + not found. + + Owns its entries: freeing the list frees every address in it. Use Extract + to keep one alive past the list. + } + TCepisAddressList = class + private + FItems: array of TCepisAddress; + FCount: Integer; + function GetItem(AIndex: Integer): TCepisAddress; + public + { Frees every address still in the list. } + destructor Destroy; override; + + { Append an address, or nil for a CEP that was not found. } + procedure Add(AAddress: TCepisAddress); + + { + Remove the address at AIndex from the list's ownership and return it. The + position keeps its place and becomes nil. Returns nil if it already was. + } + function Extract(AIndex: Integer): TCepisAddress; + + { The address at AIndex, or nil. Still owned by the list. } + property Items[AIndex: Integer]: TCepisAddress read GetItem; default; + + { Always equal to the number of CEPs that were requested. } + property Count: Integer read FCount; + end; + + { + The answer 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; + Dne identifies it. + + The caller owns every instance returned by TCepisClient.Health. + } + TCepisHealth = class(TPersistent) + private + FStatus: string; + FDne: string; + FCeps: Int64; + FGeo: Int64; + FBaseGeradaEm: string; + FRaw: string; + function GetOk: Boolean; + public + { True when the API reports itself healthy. } + property Ok: Boolean read GetOk; + published + { 'ok' when healthy, something else when degraded. } + property Status: string read FStatus; + + { Identifier of the fortnightly DNE database currently loaded. } + property Dne: string read FDne; + + { How many CEPs the database holds. } + property Ceps: Int64 read FCeps; + + { How many of those carry a coordinate. } + property Geo: Int64 read FGeo; + + { When the database was generated, ISO 8601 in UTC. } + property BaseGeradaEm: string read FBaseGeradaEm; + + { The response body exactly as it arrived. } + property Raw: string read FRaw; + end; + + { + Client for the cep.is API. + + Reuse one instance. It keeps no state between calls, so as long as nothing + writes to its properties while a request is in flight it is safe to share + across threads. + } + TCepisClient = class + private + FBaseURL: string; + FTimeout: Double; + FMaxAttempts: Integer; + FBackoffBase: Double; + FBackoffMax: Double; + FTotalTimeout: Double; + FUserAgent: string; + procedure SetBaseURL(const AValue: string); + procedure SetTimeout(const AValue: Double); + procedure SetMaxAttempts(AValue: Integer); + function Backoff(AAttempt: Integer; ARetryAfter: Double): Double; + procedure Request(const APath: string; AExtraAccepted: Integer; + out AStatus: Integer; out ABody: string); + procedure LookupChunk(const ACeps: array of string; AStart, ACount: Integer; + AList: TCepisAddressList); + public + { Builds a client aimed at CepisDefaultURL with the documented defaults. } + constructor Create; + + { + Look up a single CEP, masked or unmasked. + + The caller owns the returned address and must free it. + + Raises ECepisInvalidCEP when the CEP is not 8 digits, without making any + request; ECepisNotFound when it is well formed but absent from the + database; ECepisRateLimited, ECepisServerError or ECepisNetworkError once + the attempts are exhausted; ECepisInvalidResponse when a success status + carries a body that is not a JSON object. + } + function Lookup(const ACep: string): TCepisAddress; + + { + Look up many CEPs in one batch. + + The returned list has the same length and the same order as the input. A + CEP that does not exist becomes nil at its position - it does not vanish + from the list, and it does not raise. That is the right difference from + Lookup: in a batch of a thousand, one bad CEP must not cost the other + nine hundred and ninety-nine. A malformed CEP also becomes nil, for the + same reason. To know which one was malformed, validate first with + CepisNormalizeCEP. + + Input longer than CepisMaxBatch is chunked into several requests + automatically. + + The caller owns the returned list and must free it; freeing it frees the + addresses in it. + + Batches carry no coordinate. The endpoint behind them is CSV, and the CSV + has no geo column. Every address returned here has Geo = nil, including + for CEPs that do have one. Need Geo? Use Lookup, one at a time. + } + function LookupMany(const ACeps: array of string): TCepisAddressList; + + { + Query GET /health: does the API answer, and with which database. + + Does not raise for an API reporting itself degraded - that arrives in + TCepisHealth.Status, and checking health is exactly when you want the + diagnosis rather than an exception. Network failures still raise. + + The caller owns the returned object and must free it. + } + function Health: TCepisHealth; + + { + Where the API lives. + + Point it at a local instance or at a test server. It is the only property + that usually changes between environments. A trailing slash is stripped, + so it cannot produce doubled separators that some proxies normalise and + others 404. + + An https URL needs OpenSSL available at run time; see the README. + } + property BaseURL: string read FBaseURL write SetBaseURL; + + { + Seconds to wait per socket operation - the connect, and each read. This + is not a cap on the whole call. That cap is TotalTimeout. Must be > 0. + } + property Timeout: Double read FTimeout write SetTimeout; + + { + 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. Must be >= 1. + } + property MaxAttempts: Integer read FMaxAttempts write SetMaxAttempts; + + { + 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. + } + property BackoffBase: Double read FBackoffBase write FBackoffBase; + + { + Cap on each individual wait, in seconds. It applies to a server-sent + Retry-After too, or a `Retry-After: 3600` from a misconfigured proxy + would park the thread for an hour. + } + property BackoffMax: Double read FBackoffMax write FBackoffMax; + + { + Cap on the whole call, attempts and waits included, in seconds. Zero or + less leaves MaxAttempts as the only bound. Set it in code serving a web + request: without it the worst case is MaxAttempts * Timeout plus the sum + of the backoffs. + } + property TotalTimeout: Double read FTotalTimeout write FTotalTimeout; + + { + Overrides the User-Agent. The default identifies the library and its + version, which is what lets the server diagnose an old client + misbehaving. + } + property UserAgent: string read FUserAgent write FUserAgent; + end; + +{ + Return the CEP's 8 digits, accepting the mask. + + '01001-000', '01001000' and ' 01001-000 ' all become '01001000'. + + Raises ECepisInvalidCEP unless exactly 8 digits remain. The client runs this + 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. +} +function CepisNormalizeCEP(const AValue: string): string; + +{ + The client behind CepisLookup, CepisLookupMany and CepisHealth. + + Created on first use and freed when the unit is finalised - do not free it. + Do not reconfigure it either: it applies process-wide, including to other + code in the same program that uses this unit. Anyone needing different + settings should build their own TCepisClient. +} +function CepisDefaultClient: TCepisClient; + +{ Shorthand for CepisDefaultClient.Lookup. The caller frees the result. } +function CepisLookup(const ACep: string): TCepisAddress; + +{ + Shorthand for CepisDefaultClient.LookupMany - read that one, especially the + warning that batches carry no coordinate. The caller frees the result. +} +function CepisLookupMany(const ACeps: array of string): TCepisAddressList; + +{ Shorthand for CepisDefaultClient.Health. The caller frees the result. } +function CepisHealth: TCepisHealth; + +implementation + +uses + Math, DateUtils, fpjson, jsonparser, csvdocument, CepisHttp; + +const + AcceptHeader = 'application/json, text/csv;q=0.9, */*;q=0.1'; + UTF8BOM = #$EF#$BB#$BF; + RetriableStatus: array[0..4] of Integer = (429, 500, 502, 503, 504); + MonthNames: array[1..12] of string = ('jan', 'feb', 'mar', 'apr', 'may', + 'jun', 'jul', 'aug', 'sep', 'oct', 'nov', 'dec'); + +function IsRetriable(AStatus: Integer): Boolean; +var + I: Integer; +begin + for I := Low(RetriableStatus) to High(RetriableStatus) do + if RetriableStatus[I] = AStatus then + Exit(True); + Result := False; +end; + +function MonotonicMS: QWord; +begin +{$IFDEF FPC} + Result := GetTickCount64; +{$ELSE} + Result := TThread.GetTickCount64; +{$ENDIF} +end; + +function NowUTC: TDateTime; +begin +{$IFDEF FPC} + Result := LocalTimeToUniversal(Now); +{$ELSE} + Result := TTimeZone.Local.ToUniversalTime(Now); +{$ENDIF} +end; + +function PlainFormat: TFormatSettings; +begin + Result := DefaultFormatSettings; + Result.DecimalSeparator := '.'; + Result.ThousandSeparator := #0; +end; + +function PercentEncode(const AValue: string): string; +var + I: Integer; + C: Char; +begin + Result := ''; + for I := 1 to Length(AValue) do + begin + C := AValue[I]; + if ((C >= 'A') and (C <= 'Z')) or ((C >= 'a') and (C <= 'z')) or + ((C >= '0') and (C <= '9')) or (C = '-') or (C = '_') or (C = '.') or + (C = '~') then + Result := Result + C + else + Result := Result + '%' + IntToHex(Ord(C), 2); + end; +end; + +function SplitWords(const AValue: string): TStringList; +var + I: Integer; + Current: string; +begin + Result := TStringList.Create; + Current := ''; + for I := 1 to Length(AValue) do + if AValue[I] in [' ', #9, ':', ','] then + begin + if Current <> '' then + Result.Add(Current); + Current := ''; + end + else + Current := Current + AValue[I]; + if Current <> '' then + Result.Add(Current); +end; + +function MonthFromName(const AName: string): Integer; +var + I: Integer; + Wanted: string; +begin + Wanted := LowerCase(Copy(AName, 1, 3)); + for I := 1 to 12 do + if MonthNames[I] = Wanted then + Exit(I); + Result := 0; +end; + +function ParseHTTPDate(const AValue: string; out ADate: TDateTime): Boolean; +var + Words: TStringList; + Day, Month, Year, Hour, Minute, Second, I: Integer; +begin + Result := False; + ADate := 0; + Words := SplitWords(AValue); + try + for I := 0 to Words.Count - 4 do + begin + Day := StrToIntDef(Words[I], -1); + Month := MonthFromName(Words[I + 1]); + Year := StrToIntDef(Words[I + 2], -1); + if (Day < 1) or (Day > 31) or (Month = 0) or (Year < 0) then + Continue; + if Year < 100 then + Inc(Year, 2000); + if I + 5 > Words.Count - 1 then + Exit; + Hour := StrToIntDef(Words[I + 3], -1); + Minute := StrToIntDef(Words[I + 4], -1); + Second := StrToIntDef(Words[I + 5], -1); + if (Hour < 0) or (Minute < 0) or (Second < 0) then + Exit; + Result := TryEncodeDate(Year, Month, Day, ADate); + if Result then + ADate := ADate + EncodeTime(Hour, Minute, Second, 0); + Exit; + end; + finally + Words.Free; + end; +end; + +function ParseRetryAfter(const AValue: string): Double; +var + Text: string; + Seconds: Double; + Target: TDateTime; +begin + Result := -1; + Text := Trim(AValue); + if Text = '' then + Exit; + if TryStrToFloat(Text, Seconds, PlainFormat) then + begin + if Seconds < 0 then + Seconds := 0; + Exit(Seconds); + end; + if not ParseHTTPDate(Text, Target) then + Exit; + Result := (Target - NowUTC) * SecsPerDay; + if Result < 0 then + Result := 0; +end; + +function KeepBytes(const AValue: RawByteString): string; +begin + Result := ''; + SetLength(Result, Length(AValue)); + if Length(AValue) > 0 then + Move(AValue[1], Result[1], Length(AValue)); +end; + +function ParseJSONLoose(const ABody: string): TJSONData; +var + Parser: TJSONParser; +begin + Result := nil; + if ABody = '' then + Exit; + Parser := TJSONParser.Create(RawByteString(ABody), []); + try + try + Result := Parser.Parse; + except + on E: Exception do + Result := nil; + end; + finally + Parser.Free; + end; +end; + +function ParseJSONObject(const ABody: string): TJSONObject; +var + Data: TJSONData; + Preview: string; +begin + Preview := Copy(ABody, 1, 120); + Data := ParseJSONLoose(ABody); + if Data = nil then + raise ECepisInvalidResponse.Create('response is not valid JSON - ' + + 'something between you and the API is answering instead of it: ' + + Preview); + if not (Data is TJSONObject) then + begin + Data.Free; + raise ECepisInvalidResponse.Create('expected a JSON object, got: ' + + Preview); + end; + Result := TJSONObject(Data); +end; + +function JSONString(AObject: TJSONObject; const AName: string): string; +var + Item: TJSONData; +begin + Result := ''; + if AObject = nil then + Exit; + Item := AObject.Find(AName); + if (Item = nil) or (Item.JSONType in [jtNull, jtArray, jtObject]) then + Exit; + Result := KeepBytes(Item.AsString); +end; + +function JSONInt64(AObject: TJSONObject; const AName: string): Int64; +var + Item: TJSONData; +begin + Result := 0; + if AObject = nil then + Exit; + Item := AObject.Find(AName); + if Item = nil then + Exit; + try + Result := Item.AsInt64; + except + on E: Exception do + Result := 0; + end; +end; + +function GeoFromJSON(AObject: TJSONObject): TCepisGeo; +var + Block: TJSONData; + Geo: TJSONObject; + Lat, Lon: Double; + RaioM: Integer; + Precisao: string; +begin + Result := nil; + Block := AObject.Find('geo'); + if not (Block is TJSONObject) then + Exit; + Geo := TJSONObject(Block); + try + Lat := Geo.Floats['lat']; + Lon := Geo.Floats['lon']; + RaioM := Geo.Integers['raio_m']; + Precisao := KeepBytes(Geo.Strings['precisao']); + except + on E: Exception do + Exit; + end; + Result := TCepisGeo.Create(Lat, Lon, RaioM, Precisao); +end; + +function AddressFromJSON(AObject: TJSONObject; const ARaw: string): TCepisAddress; +begin + Result := TCepisAddress.Create; + Result.FCep := JSONString(AObject, 'cep'); + Result.FLogradouro := JSONString(AObject, 'logradouro'); + Result.FComplemento := JSONString(AObject, 'complemento'); + Result.FUnidade := JSONString(AObject, 'unidade'); + Result.FBairro := JSONString(AObject, 'bairro'); + Result.FLocalidade := JSONString(AObject, 'localidade'); + Result.FUF := JSONString(AObject, 'uf'); + Result.FEstado := JSONString(AObject, 'estado'); + Result.FRegiao := JSONString(AObject, 'regiao'); + Result.FIbge := JSONString(AObject, 'ibge'); + Result.FGia := JSONString(AObject, 'gia'); + Result.FDdd := JSONString(AObject, 'ddd'); + Result.FSiafi := JSONString(AObject, 'siafi'); + Result.FRaw := ARaw; + Result.FGeo := GeoFromJSON(AObject); +end; + +function ErrorMessageOf(const ABody, AFallback: string): string; +var + Data: TJSONData; + Text: string; +begin + Result := AFallback; + Data := ParseJSONLoose(ABody); + if Data = nil then + Exit; + try + if Data is TJSONObject then + begin + Text := JSONString(TJSONObject(Data), 'mensagem'); + if Text <> '' then + Result := Text; + end; + finally + Data.Free; + end; +end; + +constructor ECepisRateLimited.Create(const AMessage: string; + ARetryAfter: Double); +begin + inherited Create(AMessage); + FRetryAfter := ARetryAfter; +end; + +constructor ECepisServerError.Create(const AMessage: string; AStatus: Integer); +begin + inherited Create(AMessage); + FStatus := AStatus; +end; + +constructor TCepisGeo.Create(ALat, ALon: Double; ARaioM: Integer; + const APrecisao: string); +begin + inherited Create; + FLat := ALat; + FLon := ALon; + FRaioM := ARaioM; + FPrecisao := APrecisao; +end; + +function TCepisGeo.GetIsPrecise: Boolean; +begin + Result := FPrecisao = 'logradouro'; +end; + +destructor TCepisAddress.Destroy; +begin + FreeAndNil(FGeo); + inherited Destroy; +end; + +function TCepisAddress.ExtractGeo: TCepisGeo; +begin + Result := FGeo; + FGeo := nil; +end; + +function TCepisAddress.RawField(const AName: string): string; +var + Data: TJSONData; +begin + Result := ''; + if FRaw = '' then + Exit; + Data := ParseJSONLoose(FRaw); + if Data = nil then + Exit; + try + if Data is TJSONObject then + Result := JSONString(TJSONObject(Data), AName); + finally + Data.Free; + end; +end; + +function TCepisAddress.GetFormattedCEP: string; +begin + if Length(FCep) <> 8 then + Exit(FCep); + Result := Copy(FCep, 1, 5) + '-' + Copy(FCep, 6, 3); +end; + +destructor TCepisAddressList.Destroy; +var + I: Integer; +begin + for I := 0 to FCount - 1 do + FItems[I].Free; + SetLength(FItems, 0); + inherited Destroy; +end; + +procedure TCepisAddressList.Add(AAddress: TCepisAddress); +begin + if FCount = Length(FItems) then + SetLength(FItems, (FCount * 2) + 8); + FItems[FCount] := AAddress; + Inc(FCount); +end; + +function TCepisAddressList.Extract(AIndex: Integer): TCepisAddress; +begin + Result := GetItem(AIndex); + FItems[AIndex] := nil; +end; + +function TCepisAddressList.GetItem(AIndex: Integer): TCepisAddress; +begin + if (AIndex < 0) or (AIndex >= FCount) then + raise ECepis.Create(Format('address index %d out of range (count %d)', + [AIndex, FCount])); + Result := FItems[AIndex]; +end; + +function TCepisHealth.GetOk: Boolean; +begin + Result := FStatus = 'ok'; +end; + +constructor TCepisClient.Create; +begin + inherited Create; + FBaseURL := CepisDefaultURL; + FTimeout := 10.0; + FMaxAttempts := 3; + FBackoffBase := 0.5; + FBackoffMax := 8.0; + FTotalTimeout := 0; + FUserAgent := 'cepis-pascal/' + CepisVersion + ' (+https://cep.is)'; +end; + +procedure TCepisClient.SetBaseURL(const AValue: string); +var + Cleaned: string; +begin + Cleaned := Trim(AValue); + while (Cleaned <> '') and (Cleaned[Length(Cleaned)] = '/') do + SetLength(Cleaned, Length(Cleaned) - 1); + FBaseURL := Cleaned; +end; + +procedure TCepisClient.SetTimeout(const AValue: Double); +begin + if AValue <= 0 then + raise ECepis.Create('Timeout must be > 0'); + FTimeout := AValue; +end; + +procedure TCepisClient.SetMaxAttempts(AValue: Integer); +begin + if AValue < 1 then + raise ECepis.Create('MaxAttempts must be >= 1'); + FMaxAttempts := AValue; +end; + +function TCepisClient.Backoff(AAttempt: Integer; ARetryAfter: Double): Double; +var + Ceiling: Double; +begin + if ARetryAfter >= 0 then + begin + Result := ARetryAfter; + if Result > FBackoffMax then + Result := FBackoffMax; + Exit; + end; + Ceiling := FBackoffBase * IntPower(2, AAttempt - 1); + if Ceiling > FBackoffMax then + Ceiling := FBackoffMax; + if Ceiling < 0 then + Ceiling := 0; + Result := Random * Ceiling; +end; + +procedure TCepisClient.Request(const APath: string; AExtraAccepted: Integer; + out AStatus: Integer; out ABody: string); +var + URL: string; + Attempt: Integer; + Deadline: QWord; + UseDeadline: Boolean; + LastStatus: Integer; + LastRetryAfter, Wait, Remaining: Double; + LastError: string; + Response: TCepisHttpResponse; +begin + AStatus := 0; + ABody := ''; + URL := FBaseURL + APath; + UseDeadline := FTotalTimeout > 0; + Deadline := 0; + if UseDeadline then + Deadline := MonotonicMS + Round(FTotalTimeout * 1000); + + LastStatus := 0; + LastRetryAfter := -1; + LastError := 'no attempt was made'; + + for Attempt := 1 to FMaxAttempts do + begin + if UseDeadline and (MonotonicMS >= Deadline) then + Break; + + Response := CepisHttpGet(URL, FUserAgent, AcceptHeader, + Round(FTimeout * 1000)); + + if not Response.Failed then + begin + if (Response.Status = 200) or (Response.Status = AExtraAccepted) or + (not IsRetriable(Response.Status)) then + begin + AStatus := Response.Status; + ABody := Response.Body; + Exit; + end; + LastStatus := Response.Status; + LastRetryAfter := ParseRetryAfter(Response.RetryAfter); + LastError := ''; + end + else + begin + LastStatus := 0; + LastRetryAfter := -1; + LastError := Response.ErrorMessage; + end; + + if Attempt = FMaxAttempts then + Break; + + Wait := Backoff(Attempt, LastRetryAfter); + if UseDeadline then + begin + Remaining := (Int64(Deadline) - Int64(MonotonicMS)) / 1000; + if Remaining <= 0 then + Break; + if Wait > Remaining then + Wait := Remaining; + end; + if Wait > 0 then + Sleep(Round(Wait * 1000)); + end; + + if LastStatus = 429 then + raise ECepisRateLimited.Create(Format( + 'rate limit reached at %s (after %d attempt(s))', [URL, FMaxAttempts]), + LastRetryAfter); + if LastStatus <> 0 then + raise ECepisServerError.Create(Format( + 'the API answered %d at %s (after %d attempt(s))', + [LastStatus, URL, FMaxAttempts]), LastStatus); + raise ECepisNetworkError.Create(Format( + 'could not reach %s (after %d attempt(s)): %s', + [URL, FMaxAttempts, LastError])); +end; + +function TCepisClient.Lookup(const ACep: string): TCepisAddress; +var + Number, Body: string; + Status: Integer; + Payload: TJSONObject; +begin + Number := CepisNormalizeCEP(ACep); + Request('/' + Number, 0, Status, Body); + + if Status = 404 then + raise ECepisNotFound.Create('CEP ' + Number + + ' does not exist in the DNE database'); + if Status = 400 then + raise ECepisInvalidCEP.Create(ErrorMessageOf(Body, + 'CEP ' + Number + ' rejected')); + + Payload := ParseJSONObject(Body); + try + Result := AddressFromJSON(Payload, Body); + finally + Payload.Free; + end; +end; + +procedure TCepisClient.LookupChunk(const ACeps: array of string; + AStart, ACount: Integer; AList: TCepisAddressList); +var + Query, Body: string; + I, Row, Added, Status: Integer; + Document: TCSVDocument; + Address: TCepisAddress; + + function Cell(ARow: Integer; const AColumn: string): string; + var + Col: Integer; + begin + Result := ''; + Col := Document.IndexOfCol(AColumn, 0); + if (Col >= 0) and Document.HasCell(Col, ARow) then + Result := Document.Cells[Col, ARow]; + end; + + function RowIsEmpty(ARow: Integer): Boolean; + var + Col: Integer; + begin + for Col := 0 to Document.ColCount[ARow] - 1 do + if Trim(Document.Cells[Col, ARow]) <> '' then + Exit(False); + Result := True; + end; + +begin + Query := ''; + for I := 0 to ACount - 1 do + begin + if I > 0 then + Query := Query + '%2C'; + Query := Query + PercentEncode(ACeps[AStart + I]); + end; + + Request('/csv?ceps=' + Query, 0, Status, Body); + + if Copy(Body, 1, Length(UTF8BOM)) = UTF8BOM then + Delete(Body, 1, Length(UTF8BOM)); + + Added := 0; + Document := TCSVDocument.Create; + try + Document.CSVText := Body; + for Row := 1 to Document.RowCount - 1 do + begin + if Added = ACount then + Break; + if RowIsEmpty(Row) then + Continue; + if Trim(Cell(Row, 'localidade')) = '' then + begin + AList.Add(nil); + Inc(Added); + Continue; + end; + Address := TCepisAddress.Create; + Address.FCep := Cell(Row, 'cep'); + Address.FLogradouro := Cell(Row, 'logradouro'); + Address.FComplemento := Cell(Row, 'complemento'); + Address.FUnidade := Cell(Row, 'unidade'); + Address.FBairro := Cell(Row, 'bairro'); + Address.FLocalidade := Cell(Row, 'localidade'); + Address.FUF := Cell(Row, 'uf'); + Address.FEstado := Cell(Row, 'estado'); + Address.FRegiao := Cell(Row, 'regiao'); + Address.FIbge := Cell(Row, 'ibge'); + Address.FGia := Cell(Row, 'gia'); + Address.FDdd := Cell(Row, 'ddd'); + Address.FSiafi := Cell(Row, 'siafi'); + AList.Add(Address); + Inc(Added); + end; + finally + Document.Free; + end; + + while Added < ACount do + begin + AList.Add(nil); + Inc(Added); + end; +end; + +function TCepisClient.LookupMany( + const ACeps: array of string): TCepisAddressList; +var + Total, Start, Size: Integer; +begin + Result := TCepisAddressList.Create; + Total := Length(ACeps); + if Total = 0 then + Exit; + try + Start := 0; + while Start < Total do + begin + Size := Total - Start; + if Size > CepisMaxBatch then + Size := CepisMaxBatch; + LookupChunk(ACeps, Start, Size, Result); + Inc(Start, Size); + end; + except + Result.Free; + raise; + end; +end; + +function TCepisClient.Health: TCepisHealth; +var + Body: string; + Status: Integer; + Payload: TJSONObject; +begin + Request('/health', 503, Status, Body); + Payload := ParseJSONObject(Body); + try + Result := TCepisHealth.Create; + Result.FStatus := JSONString(Payload, 'status'); + Result.FDne := JSONString(Payload, 'dne'); + Result.FCeps := JSONInt64(Payload, 'ceps'); + Result.FGeo := JSONInt64(Payload, 'geo'); + Result.FBaseGeradaEm := JSONString(Payload, 'base_gerada_em'); + Result.FRaw := Body; + finally + Payload.Free; + end; +end; + +function CepisNormalizeCEP(const AValue: string): string; +var + I: Integer; + C: Char; + Cleaned: string; +begin + Cleaned := ''; + for I := 1 to Length(AValue) do + begin + C := AValue[I]; + if (C = '-') or (C = '.') or (C = ' ') or (C = #9) then + Continue; + if (C < '0') or (C > '9') then + raise ECepisInvalidCEP.Create('CEP must be 8 digits, got "' + + AValue + '"'); + Cleaned := Cleaned + C; + end; + if Length(Cleaned) <> 8 then + raise ECepisInvalidCEP.Create('CEP must be 8 digits, got "' + + AValue + '"'); + Result := Cleaned; +end; + +var + DefaultClient: TCepisClient = nil; + +function CepisDefaultClient: TCepisClient; +begin + if DefaultClient = nil then + DefaultClient := TCepisClient.Create; + Result := DefaultClient; +end; + +function CepisLookup(const ACep: string): TCepisAddress; +begin + Result := CepisDefaultClient.Lookup(ACep); +end; + +function CepisLookupMany(const ACeps: array of string): TCepisAddressList; +begin + Result := CepisDefaultClient.LookupMany(ACeps); +end; + +function CepisHealth: TCepisHealth; +begin + Result := CepisDefaultClient.Health; +end; + +initialization + Randomize; + +finalization + FreeAndNil(DefaultClient); + +end. diff --git a/src/CepisHttp.pas b/src/CepisHttp.pas new file mode 100644 index 0000000..384612f --- /dev/null +++ b/src/CepisHttp.pas @@ -0,0 +1,178 @@ +{ + CepisHttp - the transport the Cepis unit sits on. + + One function, one GET, no state. Everything above it (retrying, backoff, + turning statuses into exceptions) lives in the Cepis unit, so swapping the + HTTP implementation touches only this file. + + Free Pascal uses `fphttpclient`, which ships with the compiler. HTTPS needs + the `opensslsockets` unit linked in - it is, right here - and OpenSSL + present at run time, which is what makes an `https://` base URL work at all. + + A Delphi branch built on `System.Net.HttpClient` is provided for source + compatibility. It has never been compiled: this library is developed and + tested with Free Pascal. +} +unit CepisHttp; + +{$IFDEF FPC} + {$MODE OBJFPC} + {$H+} +{$ENDIF} + +interface + +uses + SysUtils, Classes; + +type + { + The outcome of one GET. + + `Failed` separates the two kinds of answer. When it is True the request + never completed - DNS, refused connection, timeout, TLS - and only + `ErrorMessage` is meaningful. When it is False the server answered, and + `Status` holds what it answered, including 4xx and 5xx: those are answers, + not failures, and the layer above decides what they mean. + + `Body` carries the response bytes decoded as UTF-8, which is what the API + sends. `RetryAfter` is the raw `Retry-After` header, unparsed, or empty. + } + TCepisHttpResponse = record + Status: Integer; + Body: string; + RetryAfter: string; + Failed: Boolean; + ErrorMessage: string; + end; + +{ + Perform a single GET and describe what came back. + + Never raises: a transport failure comes back as `Failed = True`. Retrying is + the caller's business. + + `ATimeoutMS` bounds each socket operation - the connect, and each read - not + the call as a whole. +} +function CepisHttpGet(const AURL, AUserAgent, AAccept: string; + ATimeoutMS: Integer): TCepisHttpResponse; + +implementation + +uses +{$IFDEF FPC} + fphttpclient, opensslsockets; +{$ELSE} + System.Net.HttpClient, System.Net.URLClient; +{$ENDIF} + +{$IFDEF FPC} + +function CepisHttpGet(const AURL, AUserAgent, AAccept: string; + ATimeoutMS: Integer): TCepisHttpResponse; +var + Client: TFPHTTPClient; + Buffer: TMemoryStream; +begin + Result.Status := 0; + Result.Body := ''; + Result.RetryAfter := ''; + Result.Failed := False; + Result.ErrorMessage := ''; + + Buffer := TMemoryStream.Create; + try + Client := TFPHTTPClient.Create(nil); + try + Client.AllowRedirect := True; + Client.ConnectTimeout := ATimeoutMS; + Client.IOTimeout := ATimeoutMS; + Client.AddHeader('User-Agent', AUserAgent); + Client.AddHeader('Accept', AAccept); + Client.AddHeader('Accept-Encoding', 'identity'); + try + Client.HTTPMethod('GET', AURL, Buffer, []); + Result.Status := Client.ResponseStatusCode; + SetLength(Result.Body, Buffer.Size); + if Buffer.Size > 0 then + Move(Buffer.Memory^, Result.Body[1], Buffer.Size); + if Assigned(Client.ResponseHeaders) then + Result.RetryAfter := + TFPHTTPClient.GetHeader(Client.ResponseHeaders, 'Retry-After'); + except + on E: Exception do + begin + Result.Failed := True; + Result.Status := 0; + Result.Body := ''; + Result.RetryAfter := ''; + Result.ErrorMessage := E.ClassName + ': ' + E.Message; + end; + end; + finally + Client.Free; + end; + finally + Buffer.Free; + end; +end; + +{$ELSE} + +function CepisHttpGet(const AURL, AUserAgent, AAccept: string; + ATimeoutMS: Integer): TCepisHttpResponse; +var + Client: THTTPClient; + Response: IHTTPResponse; + Buffer: TMemoryStream; + Payload: TBytes; +begin + Result.Status := 0; + Result.Body := ''; + Result.RetryAfter := ''; + Result.Failed := False; + Result.ErrorMessage := ''; + + Buffer := TMemoryStream.Create; + try + Client := THTTPClient.Create; + try + Client.ConnectionTimeout := ATimeoutMS; + Client.ResponseTimeout := ATimeoutMS; + Client.UserAgent := AUserAgent; + Client.HandleRedirects := True; + try + Response := Client.Get(AURL, Buffer, + [TNetHeader.Create('Accept', AAccept), + TNetHeader.Create('Accept-Encoding', 'identity')]); + Result.Status := Response.StatusCode; + SetLength(Payload, Buffer.Size); + if Buffer.Size > 0 then + begin + Buffer.Position := 0; + Buffer.ReadBuffer(Payload[0], Buffer.Size); + end; + Result.Body := TEncoding.UTF8.GetString(Payload); + Result.RetryAfter := Response.HeaderValue['Retry-After']; + except + on E: Exception do + begin + Result.Failed := True; + Result.Status := 0; + Result.Body := ''; + Result.RetryAfter := ''; + Result.ErrorMessage := E.ClassName + ': ' + E.Message; + end; + end; + finally + Client.Free; + end; + finally + Buffer.Free; + end; +end; + +{$ENDIF} + +end. diff --git a/tests/TestCepis.pas b/tests/TestCepis.pas new file mode 100644 index 0000000..75a57ee --- /dev/null +++ b/tests/TestCepis.pas @@ -0,0 +1,1161 @@ +{ + Test suite for the Cepis unit. + + Every test brings up a real HTTP server on loopback and points BaseURL at it. + No test touches the network, and nothing about the HTTP layer is mocked: the + code path exercised is the one that runs in production, request construction + and error body reading included. + + It doubles as the test that BaseURL works - if it did not, none of this would + run. + + The fixture field names stay Portuguese because they mirror the API's JSON. +} +program TestCepis; + +{$MODE OBJFPC} +{$H+} + +uses +{$IFDEF UNIX} + cthreads, +{$ENDIF} + Classes, SysUtils, fpcunit, testregistry, consoletestrunner, + fphttpserver, httpdefs, Cepis; + +const + SeAddress = + '{"cep":"01001000","logradouro":"Pra' + #$C3#$A7 + 'a da S' + #$C3#$A9 + + '","complemento":"lado ' + #$C3#$AD + 'mpar","unidade":"","bairro":"S' + + #$C3#$A9 + '","localidade":"S' + #$C3#$A3 + 'o Paulo","uf":"SP",' + + '"estado":"S' + #$C3#$A3 + 'o Paulo","regiao":"Sudeste","ibge":"3550308",' + + '"gia":"1004","ddd":"11","siafi":"7107"'; + + SaoPaulo = 'S' + #$C3#$A3 + 'o Paulo'; + PracaDaSe = 'Pra' + #$C3#$A7 + 'a da S' + #$C3#$A9; + + CsvHeader = 'cep,logradouro,complemento,unidade,bairro,localidade,uf,' + + 'estado,regiao,ibge,gia,ddd,siafi'; + +type + TFakeReply = record + Status: Integer; + Body: string; + HeaderName: string; + HeaderValue: string; + end; + TFakeReplies = array of TFakeReply; + + TFakeHandler = procedure(const APath: string; ACallIndex: Integer; + var AReply: TFakeReply) of object; + + TFakeRoute = class + public + Path: string; + Replies: TFakeReplies; + Cursor: Integer; + end; + + TLocalHttpServer = class(TFPHttpServer) + public + property Address; + end; + + TAcceptThread = class(TThread) + private + FServer: TLocalHttpServer; + protected + procedure Execute; override; + public + constructor Create(AServer: TLocalHttpServer); + end; + + { A throwaway HTTP server on loopback with per-test programmable routes. } + TFakeServer = class + private + FServer: TLocalHttpServer; + FThread: TAcceptThread; + FRoutes: TStringList; + FCalls: TStringList; + FLock: TRTLCriticalSection; + FHandler: TFakeHandler; + FPort: Word; + procedure DoRequest(Sender: TObject; + var ARequest: TFPHTTPConnectionRequest; + var AResponse: TFPHTTPConnectionResponse); + function GetBaseURL: string; + function TryStart(APort: Word): Boolean; + procedure Stop; + function RouteFor(const APath: string): TFakeRoute; + public + constructor Create; + destructor Destroy; override; + procedure Respond(const APath: string; AStatus: Integer; + const ABody: string); + procedure RespondWithHeader(const APath: string; AStatus: Integer; + const ABody, AHeaderName, AHeaderValue: string); + procedure RespondSequence(const APath: string; + const AReplies: array of TFakeReply); + function CallCount(const APrefix: string): Integer; + function TotalCalls: Integer; + property Handler: TFakeHandler read FHandler write FHandler; + property BaseURL: string read GetBaseURL; + end; + + { Fixture: a fake server plus a client whose backoff is near zero. } + TCepisTestCase = class(TTestCase) + protected + FServer: TFakeServer; + FClient: TCepisClient; + procedure SetUp; override; + procedure TearDown; override; + end; + +function Reply(AStatus: Integer; const ABody: string): TFakeReply; +begin + Result.Status := AStatus; + Result.Body := ABody; + Result.HeaderName := ''; + Result.HeaderValue := ''; +end; + +constructor TAcceptThread.Create(AServer: TLocalHttpServer); +begin + FServer := AServer; + FreeOnTerminate := False; + inherited Create(False); +end; + +procedure TAcceptThread.Execute; +begin + try + FServer.Active := True; + except + on E: Exception do + ; + end; +end; + +constructor TFakeServer.Create; +var + Attempt: Integer; +begin + inherited Create; + InitCriticalSection(FLock); + FRoutes := TStringList.Create; + FRoutes.OwnsObjects := True; + FCalls := TStringList.Create; + for Attempt := 1 to 40 do + if TryStart(20000 + Random(30000)) then + begin + FCalls.Clear; + Exit; + end; + raise Exception.Create('could not bind a loopback port for the test server'); +end; + +function TFakeServer.TryStart(APort: Word): Boolean; +var + Probe: TCepisClient; + Waited: Integer; + Health: TCepisHealth; +begin + FPort := APort; + FServer := TLocalHttpServer.Create(nil); + FServer.Address := '127.0.0.1'; + FServer.Port := APort; + FServer.Threaded := True; + FServer.AcceptIdleTimeout := 50; + FServer.OnRequest := @DoRequest; + FThread := TAcceptThread.Create(FServer); + + Probe := TCepisClient.Create; + try + Probe.BaseURL := GetBaseURL; + Probe.MaxAttempts := 1; + Probe.Timeout := 1.0; + Waited := 0; + while Waited < 3000 do + begin + if FThread.Finished then + Break; + try + Health := Probe.Health; + Health.Free; + Exit(True); + except + on E: ECepisNetworkError do + ; + on E: ECepis do + Exit(True); + end; + Sleep(20); + Inc(Waited, 20); + end; + finally + Probe.Free; + end; + + Stop; + Result := False; +end; + +procedure TFakeServer.Stop; +begin + if FServer <> nil then + try + FServer.Active := False; + except + on E: Exception do + ; + end; + if FThread <> nil then + begin + FThread.WaitFor; + FreeAndNil(FThread); + end; + FreeAndNil(FServer); +end; + +destructor TFakeServer.Destroy; +begin + Stop; + FreeAndNil(FRoutes); + FreeAndNil(FCalls); + DoneCriticalSection(FLock); + inherited Destroy; +end; + +function TFakeServer.GetBaseURL: string; +begin + Result := Format('http://127.0.0.1:%d', [FPort]); +end; + +function TFakeServer.RouteFor(const APath: string): TFakeRoute; +var + Index: Integer; +begin + Index := FRoutes.IndexOf(APath); + if Index >= 0 then + Exit(TFakeRoute(FRoutes.Objects[Index])); + Result := TFakeRoute.Create; + Result.Path := APath; + Result.Cursor := 0; + FRoutes.AddObject(APath, Result); +end; + +procedure TFakeServer.Respond(const APath: string; AStatus: Integer; + const ABody: string); +begin + RespondWithHeader(APath, AStatus, ABody, '', ''); +end; + +procedure TFakeServer.RespondWithHeader(const APath: string; AStatus: Integer; + const ABody, AHeaderName, AHeaderValue: string); +var + Route: TFakeRoute; +begin + EnterCriticalSection(FLock); + try + Route := RouteFor(APath); + SetLength(Route.Replies, 1); + Route.Replies[0].Status := AStatus; + Route.Replies[0].Body := ABody; + Route.Replies[0].HeaderName := AHeaderName; + Route.Replies[0].HeaderValue := AHeaderValue; + Route.Cursor := 0; + finally + LeaveCriticalSection(FLock); + end; +end; + +procedure TFakeServer.RespondSequence(const APath: string; + const AReplies: array of TFakeReply); +var + Route: TFakeRoute; + I: Integer; +begin + EnterCriticalSection(FLock); + try + Route := RouteFor(APath); + SetLength(Route.Replies, Length(AReplies)); + for I := 0 to High(AReplies) do + Route.Replies[I] := AReplies[I]; + Route.Cursor := 0; + finally + LeaveCriticalSection(FLock); + end; +end; + +function TFakeServer.CallCount(const APrefix: string): Integer; +var + I: Integer; +begin + Result := 0; + EnterCriticalSection(FLock); + try + for I := 0 to FCalls.Count - 1 do + if Copy(FCalls[I], 1, Length(APrefix)) = APrefix then + Inc(Result); + finally + LeaveCriticalSection(FLock); + end; +end; + +function TFakeServer.TotalCalls: Integer; +begin + EnterCriticalSection(FLock); + try + Result := FCalls.Count; + finally + LeaveCriticalSection(FLock); + end; +end; + +procedure TFakeServer.DoRequest(Sender: TObject; + var ARequest: TFPHTTPConnectionRequest; + var AResponse: TFPHTTPConnectionResponse); +var + Path: string; + Current: TFakeReply; + Route: TFakeRoute; + Index, CallIndex: Integer; +begin + Path := ARequest.URL; + Current := Reply(404, '{"erro":"cep_nao_encontrado"}'); + + EnterCriticalSection(FLock); + try + FCalls.Add(Path); + CallIndex := FCalls.Count; + Index := FRoutes.IndexOf(Path); + if Index >= 0 then + begin + Route := TFakeRoute(FRoutes.Objects[Index]); + if Length(Route.Replies) > 0 then + begin + Current := Route.Replies[Route.Cursor]; + if Route.Cursor < High(Route.Replies) then + Inc(Route.Cursor); + end; + end + else if Assigned(FHandler) then + begin + Current := Reply(200, ''); + FHandler(Path, CallIndex, Current); + end; + finally + LeaveCriticalSection(FLock); + end; + + AResponse.Code := Current.Status; + AResponse.CodeText := 'Test'; + AResponse.ContentType := 'application/json; charset=utf-8'; + if Current.HeaderName <> '' then + AResponse.SetCustomHeader(Current.HeaderName, Current.HeaderValue); + AResponse.Content := Current.Body; +end; + +procedure TCepisTestCase.SetUp; +begin + inherited SetUp; + FServer := TFakeServer.Create; + FClient := TCepisClient.Create; + FClient.BaseURL := FServer.BaseURL; + FClient.Timeout := 5.0; + FClient.BackoffBase := 0.001; + FClient.BackoffMax := 0.01; +end; + +procedure TCepisTestCase.TearDown; +begin + FreeAndNil(FClient); + FreeAndNil(FServer); + inherited TearDown; +end; + +type + TTestNormalisation = class(TTestCase) + published + procedure AcceptsMaskedAndUnmasked; + procedure RejectsBadFormat; + procedure FormatsBack; + end; + +procedure TTestNormalisation.AcceptsMaskedAndUnmasked; +begin + AssertEquals('01001000', CepisNormalizeCEP('01001000')); + AssertEquals('01001000', CepisNormalizeCEP('01001-000')); + AssertEquals('01001000', CepisNormalizeCEP(' 01001-000 ')); + AssertEquals('01001000', CepisNormalizeCEP('01001.000')); +end; + +procedure TTestNormalisation.RejectsBadFormat; +const + Bad: array[0..4] of string = ('', '123', '0100100a', '010010000', 'abcdefgh'); +var + I: Integer; + Raised: Boolean; +begin + for I := Low(Bad) to High(Bad) do + begin + Raised := False; + try + CepisNormalizeCEP(Bad[I]); + except + on E: ECepisInvalidCEP do + Raised := True; + end; + AssertTrue('expected ECepisInvalidCEP for "' + Bad[I] + '"', Raised); + end; +end; + +procedure TTestNormalisation.FormatsBack; +var + Address: TCepisAddress; +begin + Address := TCepisAddress.Create; + try + AssertEquals('', Address.FormattedCEP); + finally + Address.Free; + end; +end; + +type + TTestLookup = class(TCepisTestCase) + published + procedure SuccessfulLookup; + procedure ReadsTheCoordinateWhenPresent; + procedure MunicipalityCoordinateIsNotPrecise; + procedure MalformedGeoDoesNotLoseTheAddress; + procedure NewApiFieldDoesNotBreak; + procedure NotFound; + procedure NotFoundIsNotRetried; + procedure InvalidCepNeverLeavesTheMachine; + procedure Api400BecomesInvalidCep; + procedure ResponseThatIsNotJson; + end; + +procedure TTestLookup.SuccessfulLookup; +var + Address: TCepisAddress; +begin + FServer.Respond('/01001000', 200, SeAddress + '}'); + Address := FClient.Lookup('01001-000'); + try + AssertEquals(SaoPaulo, Address.Localidade); + AssertEquals('SP', Address.UF); + AssertEquals(PracaDaSe, Address.Logradouro); + AssertEquals('01001-000', Address.FormattedCEP); + AssertTrue('geo must be nil when the API omits it', Address.Geo = nil); + finally + Address.Free; + end; +end; + +procedure TTestLookup.ReadsTheCoordinateWhenPresent; +var + Address: TCepisAddress; +begin + FServer.Respond('/01310100', 200, SeAddress + + ',"geo":{"lat":-23.5,"lon":-46.6,"raio_m":120,"precisao":"logradouro"}}'); + Address := FClient.Lookup('01310100'); + try + AssertTrue('geo must be present', Address.Geo <> nil); + AssertEquals(-23.5, Address.Geo.Lat, 0.0001); + AssertEquals(-46.6, Address.Geo.Lon, 0.0001); + AssertEquals(120, Address.Geo.RaioM); + AssertTrue('street-level geo is precise', Address.Geo.IsPrecise); + finally + Address.Free; + end; +end; + +procedure TTestLookup.MunicipalityCoordinateIsNotPrecise; +var + Address: TCepisAddress; +begin + FServer.Respond('/01001000', 200, SeAddress + + ',"geo":{"lat":-23.5,"lon":-46.6,"raio_m":22000,"precisao":"localidade"}}'); + Address := FClient.Lookup('01001000'); + try + AssertTrue('geo must be present', Address.Geo <> nil); + AssertFalse('municipality centroid is not precise', Address.Geo.IsPrecise); + finally + Address.Free; + end; +end; + +procedure TTestLookup.MalformedGeoDoesNotLoseTheAddress; +var + Address: TCepisAddress; +begin + FServer.Respond('/01001000', 200, SeAddress + ',"geo":{"lat":"not a number"}}'); + Address := FClient.Lookup('01001000'); + try + AssertTrue('malformed geo is dropped', Address.Geo = nil); + AssertEquals(SaoPaulo, Address.Localidade); + finally + Address.Free; + end; +end; + +procedure TTestLookup.NewApiFieldDoesNotBreak; +var + Address: TCepisAddress; +begin + FServer.Respond('/01001000', 200, SeAddress + ',"campo_do_futuro":"value"}'); + Address := FClient.Lookup('01001000'); + try + AssertEquals(SaoPaulo, Address.Localidade); + AssertEquals('value', Address.RawField('campo_do_futuro')); + finally + Address.Free; + end; +end; + +procedure TTestLookup.NotFound; +var + Address: TCepisAddress; + Raised: Boolean; + Message: string; +begin + FServer.Respond('/99999999', 404, + '{"erro":"cep_nao_encontrado","mensagem":"gone"}'); + Raised := False; + Message := ''; + Address := nil; + try + Address := FClient.Lookup('99999999'); + except + on E: ECepisNotFound do + begin + Raised := True; + Message := E.Message; + end; + end; + Address.Free; + AssertTrue('expected ECepisNotFound', Raised); + AssertTrue('message must name the CEP', Pos('99999999', Message) > 0); +end; + +procedure TTestLookup.NotFoundIsNotRetried; +var + Address: TCepisAddress; + Raised: Boolean; +begin + FServer.Respond('/99999999', 404, '{"erro":"cep_nao_encontrado"}'); + Raised := False; + Address := nil; + try + Address := FClient.Lookup('99999999'); + except + on E: ECepisNotFound do + Raised := True; + end; + Address.Free; + AssertTrue('expected ECepisNotFound', Raised); + AssertEquals(1, FServer.CallCount('/99999999')); +end; + +procedure TTestLookup.InvalidCepNeverLeavesTheMachine; +var + Address: TCepisAddress; + Raised: Boolean; +begin + Raised := False; + Address := nil; + try + Address := FClient.Lookup('123'); + except + on E: ECepisInvalidCEP do + Raised := True; + end; + Address.Free; + AssertTrue('expected ECepisInvalidCEP', Raised); + AssertEquals(0, FServer.TotalCalls); +end; + +procedure TTestLookup.Api400BecomesInvalidCep; +var + Address: TCepisAddress; + Raised: Boolean; + Message: string; +begin + FServer.Respond('/00000000', 400, + '{"erro":"cep_invalido","mensagem":"rejected by the API"}'); + Raised := False; + Message := ''; + Address := nil; + try + Address := FClient.Lookup('00000000'); + except + on E: ECepisInvalidCEP do + begin + Raised := True; + Message := E.Message; + end; + end; + Address.Free; + AssertTrue('expected ECepisInvalidCEP', Raised); + AssertEquals('rejected by the API', Message); + AssertEquals(1, FServer.CallCount('/00000000')); +end; + +procedure TTestLookup.ResponseThatIsNotJson; +var + Address: TCepisAddress; + Raised: Boolean; +begin + FServer.Respond('/01001000', 200, '<html>captive portal</html>'); + Raised := False; + Address := nil; + try + Address := FClient.Lookup('01001000'); + except + on E: ECepisInvalidResponse do + Raised := True; + end; + Address.Free; + AssertTrue('expected ECepisInvalidResponse', Raised); +end; + +type + TTestRetry = class(TCepisTestCase) + published + procedure RetriesOn500ThenSucceeds; + procedure ExhaustsAttemptsThenRaises; + procedure MaxAttemptsOneDisablesRetry; + procedure RateLimitedCarriesRetryAfter; + procedure RetryAfterHonoursTheCap; + procedure RetryAfterAcceptsAnHttpDate; + procedure NetworkErrorWhenNothingListens; + procedure TotalTimeoutBoundsTheWholeCall; + end; + +procedure TTestRetry.RetriesOn500ThenSucceeds; +var + Address: TCepisAddress; +begin + FServer.RespondSequence('/01001000', + [Reply(500, '{"erro":"interno"}'), Reply(200, SeAddress + '}')]); + Address := FClient.Lookup('01001000'); + try + AssertEquals(SaoPaulo, Address.Localidade); + AssertEquals(2, FServer.CallCount('/01001000')); + finally + Address.Free; + end; +end; + +procedure TTestRetry.ExhaustsAttemptsThenRaises; +var + Address: TCepisAddress; + Status: Integer; + Raised: Boolean; +begin + FServer.Respond('/01001000', 503, '{"erro":"interno"}'); + Raised := False; + Status := 0; + Address := nil; + try + Address := FClient.Lookup('01001000'); + except + on E: ECepisServerError do + begin + Raised := True; + Status := E.Status; + end; + end; + Address.Free; + AssertTrue('expected ECepisServerError', Raised); + AssertEquals(503, Status); + AssertEquals(3, FServer.CallCount('/01001000')); +end; + +procedure TTestRetry.MaxAttemptsOneDisablesRetry; +var + Address: TCepisAddress; + Raised: Boolean; +begin + FClient.MaxAttempts := 1; + FServer.Respond('/01001000', 500, '{}'); + Raised := False; + Address := nil; + try + Address := FClient.Lookup('01001000'); + except + on E: ECepisServerError do + Raised := True; + end; + Address.Free; + AssertTrue('expected ECepisServerError', Raised); + AssertEquals(1, FServer.CallCount('/01001000')); +end; + +procedure TTestRetry.RateLimitedCarriesRetryAfter; +var + Address: TCepisAddress; + Raised: Boolean; + RetryAfter: Double; +begin + FServer.RespondWithHeader('/01001000', 429, '{}', 'Retry-After', '7'); + Raised := False; + RetryAfter := -1; + Address := nil; + try + Address := FClient.Lookup('01001000'); + except + on E: ECepisRateLimited do + begin + Raised := True; + RetryAfter := E.RetryAfter; + end; + end; + Address.Free; + AssertTrue('expected ECepisRateLimited', Raised); + AssertEquals(7.0, RetryAfter, 0.0001); +end; + +procedure TTestRetry.RetryAfterHonoursTheCap; +var + Address: TCepisAddress; + Raised: Boolean; + Started: QWord; +begin + FServer.RespondWithHeader('/01001000', 429, '{}', 'Retry-After', '3600'); + Raised := False; + Address := nil; + Started := GetTickCount64; + try + Address := FClient.Lookup('01001000'); + except + on E: ECepisRateLimited do + Raised := True; + end; + Address.Free; + AssertTrue('expected ECepisRateLimited', Raised); + AssertTrue('an absurd Retry-After must not park the thread', + GetTickCount64 - Started < 5000); +end; + +procedure TTestRetry.RetryAfterAcceptsAnHttpDate; +var + Address: TCepisAddress; + Raised: Boolean; + Started: QWord; +begin + FServer.RespondWithHeader('/01001000', 429, '{}', 'Retry-After', + 'Wed, 21 Oct 2026 07:28:00 GMT'); + Raised := False; + Address := nil; + Started := GetTickCount64; + try + Address := FClient.Lookup('01001000'); + except + on E: ECepisRateLimited do + Raised := True; + end; + Address.Free; + AssertTrue('expected ECepisRateLimited', Raised); + AssertTrue('a date far in the future is still capped', + GetTickCount64 - Started < 5000); +end; + +procedure TTestRetry.NetworkErrorWhenNothingListens; +var + Client: TCepisClient; + Address: TCepisAddress; + Raised: Boolean; +begin + Client := TCepisClient.Create; + try + Client.BaseURL := 'http://127.0.0.1:1'; + Client.MaxAttempts := 2; + Client.BackoffBase := 0.001; + Client.BackoffMax := 0.01; + Client.Timeout := 1.0; + Raised := False; + Address := nil; + try + Address := Client.Lookup('01001000'); + except + on E: ECepisNetworkError do + Raised := True; + end; + Address.Free; + AssertTrue('expected ECepisNetworkError', Raised); + finally + Client.Free; + end; +end; + +procedure TTestRetry.TotalTimeoutBoundsTheWholeCall; +var + Address: TCepisAddress; + Raised: Boolean; + Started: QWord; +begin + FClient.MaxAttempts := 50; + FClient.BackoffBase := 0.05; + FClient.BackoffMax := 0.05; + FClient.TotalTimeout := 0.3; + FServer.Respond('/01001000', 500, '{}'); + Raised := False; + Address := nil; + Started := GetTickCount64; + try + Address := FClient.Lookup('01001000'); + except + on E: ECepisServerError do + Raised := True; + end; + Address.Free; + AssertTrue('expected ECepisServerError', Raised); + AssertTrue('the deadline must cut the run short', + GetTickCount64 - Started < 3000); + AssertTrue('fewer than the 50 configured attempts', + FServer.CallCount('/01001000') < 50); +end; + +type + TTestBatch = class(TCepisTestCase) + private + FChunkCalls: Integer; + procedure ChunkHandler(const APath: string; ACallIndex: Integer; + var AReply: TFakeReply); + published + procedure PreservesOrderAndMarksMissing; + procedure FieldWithCommaIsParsed; + procedure EmptyListMakesNoRequest; + procedure BatchCarriesNoGeo; + procedure ChunksAboveTheApiLimit; + procedure TruncatedResponseDoesNotShift; + end; + +procedure TTestBatch.PreservesOrderAndMarksMissing; +var + Result: TCepisAddressList; +begin + FServer.Respond('/csv?ceps=01001000%2C99999999%2C20040020', 200, + CsvHeader + #10 + + '01001000,' + PracaDaSe + ',lado ' + #$C3#$AD + 'mpar,,S' + #$C3#$A9 + + ',' + SaoPaulo + ',SP,' + SaoPaulo + ',Sudeste,3550308,1004,11,7107' + #10 + + '99999999,,,,,,,,,,,,' + #10 + + '20040020,Avenida Rio Branco,,,Centro,Rio de Janeiro,RJ,Rio de Janeiro,' + + 'Sudeste,3304557,,21,6001' + #10); + Result := FClient.LookupMany(['01001000', '99999999', '20040020']); + try + AssertEquals(3, Result.Count); + AssertTrue('first must be present', Result[0] <> nil); + AssertEquals(SaoPaulo, Result[0].Localidade); + AssertTrue('missing CEP becomes nil at its position', Result[1] = nil); + AssertTrue('third must be present', Result[2] <> nil); + AssertEquals('RJ', Result[2].UF); + finally + Result.Free; + end; +end; + +procedure TTestBatch.FieldWithCommaIsParsed; +var + Result: TCepisAddressList; +begin + FServer.Respond('/csv?ceps=01001000', 200, + CsvHeader + #10 + + '01001000,"Rua Um, Dois",,,Centro,' + SaoPaulo + ',SP,' + SaoPaulo + + ',Sudeste,1,,11,1' + #10); + Result := FClient.LookupMany(['01001000']); + try + AssertEquals(1, Result.Count); + AssertTrue('must be present', Result[0] <> nil); + AssertEquals('Rua Um, Dois', Result[0].Logradouro); + finally + Result.Free; + end; +end; + +procedure TTestBatch.EmptyListMakesNoRequest; +var + Result: TCepisAddressList; + Empty: array of string; +begin + SetLength(Empty, 0); + Result := FClient.LookupMany(Empty); + try + AssertEquals(0, Result.Count); + AssertEquals(0, FServer.TotalCalls); + finally + Result.Free; + end; +end; + +procedure TTestBatch.BatchCarriesNoGeo; +var + Result: TCepisAddressList; +begin + FServer.Respond('/csv?ceps=01001000', 200, + CsvHeader + #10 + + '01001000,' + PracaDaSe + ',,,Centro,' + SaoPaulo + ',SP,' + SaoPaulo + + ',Sudeste,1,,11,1' + #10); + Result := FClient.LookupMany(['01001000']); + try + AssertTrue('must be present', Result[0] <> nil); + AssertTrue('a batch never carries a coordinate', Result[0].Geo = nil); + finally + Result.Free; + end; +end; + +procedure TTestBatch.ChunkHandler(const APath: string; ACallIndex: Integer; + var AReply: TFakeReply); +var + Body: string; + I, First, Last: Integer; +begin + Inc(FChunkCalls); + if FChunkCalls = 1 then + begin + First := 0; + Last := 499; + end + else + begin + First := 500; + Last := 500; + end; + Body := CsvHeader + #10; + for I := First to Last do + Body := Body + Format('%.8d,,,,,X,SP,%s,Sudeste,1,,11,1', [I, SaoPaulo]) + #10; + AReply.Status := 200; + AReply.Body := Body; +end; + +procedure TTestBatch.ChunksAboveTheApiLimit; +var + Ceps: array of string; + Result: TCepisAddressList; + I: Integer; +begin + FChunkCalls := 0; + FServer.Handler := @ChunkHandler; + SetLength(Ceps, 501); + for I := 0 to 500 do + Ceps[I] := Format('%.8d', [I]); + Result := FClient.LookupMany(Ceps); + try + AssertEquals(501, Result.Count); + AssertEquals(2, FChunkCalls); + AssertTrue('last entry present', Result[500] <> nil); + finally + Result.Free; + end; +end; + +procedure TTestBatch.TruncatedResponseDoesNotShift; +var + Result: TCepisAddressList; +begin + FServer.Respond('/csv?ceps=01001000%2C20040020', 200, + CsvHeader + #10 + + '01001000,,,,,' + SaoPaulo + ',SP,' + SaoPaulo + ',Sudeste,1,,11,1' + #10); + Result := FClient.LookupMany(['01001000', '20040020']); + try + AssertEquals(2, Result.Count); + AssertTrue('first must be present', Result[0] <> nil); + AssertTrue('padding beats shifting', Result[1] = nil); + finally + Result.Free; + end; +end; + +type + TTestHealth = class(TCepisTestCase) + published + procedure ReadsHealth; + procedure DegradedDoesNotRaise; + end; + +procedure TTestHealth.ReadsHealth; +var + Health: TCepisHealth; +begin + FServer.Respond('/health', 200, + '{"status":"ok","dne":"26071","ceps":1596168,"geo":894489,' + + '"base_gerada_em":"2026-07-24T03:48:28Z"}'); + Health := FClient.Health; + try + AssertTrue('must report healthy', Health.Ok); + AssertEquals('26071', Health.Dne); + AssertEquals(1596168, Health.Ceps); + AssertEquals(894489, Health.Geo); + AssertEquals('2026-07-24T03:48:28Z', Health.BaseGeradaEm); + finally + Health.Free; + end; +end; + +procedure TTestHealth.DegradedDoesNotRaise; +var + Health: TCepisHealth; +begin + FServer.Respond('/health', 503, + '{"status":"degradado","dne":"","ceps":0,"geo":0}'); + Health := FClient.Health; + try + AssertFalse('degraded is reported, not raised', Health.Ok); + AssertEquals('degradado', Health.Status); + AssertEquals(1, FServer.CallCount('/health')); + finally + Health.Free; + end; +end; + +type + TTestConfiguration = class(TTestCase) + published + procedure TrailingSlashIsNotDuplicated; + procedure InvalidParameters; + procedure UserAgentIdentifiesTheLibrary; + procedure DefaultsAreTheDocumentedOnes; + end; + +procedure TTestConfiguration.TrailingSlashIsNotDuplicated; +var + Client: TCepisClient; +begin + Client := TCepisClient.Create; + try + Client.BaseURL := 'http://x/'; + AssertEquals('http://x', Client.BaseURL); + finally + Client.Free; + end; +end; + +procedure TTestConfiguration.InvalidParameters; +var + Client: TCepisClient; + Raised: Boolean; +begin + Client := TCepisClient.Create; + try + Raised := False; + try + Client.MaxAttempts := 0; + except + on E: ECepis do + Raised := True; + end; + AssertTrue('MaxAttempts = 0 must be rejected', Raised); + + Raised := False; + try + Client.Timeout := 0; + except + on E: ECepis do + Raised := True; + end; + AssertTrue('Timeout = 0 must be rejected', Raised); + finally + Client.Free; + end; +end; + +procedure TTestConfiguration.UserAgentIdentifiesTheLibrary; +var + Client: TCepisClient; +begin + Client := TCepisClient.Create; + try + AssertTrue('User-Agent must name the library', + Pos('cepis-pascal/', Client.UserAgent) = 1); + finally + Client.Free; + end; +end; + +procedure TTestConfiguration.DefaultsAreTheDocumentedOnes; +var + Client: TCepisClient; +begin + Client := TCepisClient.Create; + try + AssertEquals(CepisDefaultURL, Client.BaseURL); + AssertEquals(3, Client.MaxAttempts); + AssertEquals(0.5, Client.BackoffBase, 0.0001); + AssertEquals(8.0, Client.BackoffMax, 0.0001); + AssertEquals(500, CepisMaxBatch); + finally + Client.Free; + end; +end; + +type + TTestOwnership = class(TCepisTestCase) + published + procedure ExtractKeepsAnAddressAlive; + procedure ExtractGeoTransfersTheCoordinate; + end; + +procedure TTestOwnership.ExtractKeepsAnAddressAlive; +var + List: TCepisAddressList; + Kept: TCepisAddress; +begin + FServer.Respond('/csv?ceps=01001000', 200, + CsvHeader + #10 + + '01001000,' + PracaDaSe + ',,,Centro,' + SaoPaulo + ',SP,' + SaoPaulo + + ',Sudeste,1,,11,1' + #10); + List := FClient.LookupMany(['01001000']); + Kept := List.Extract(0); + try + AssertTrue('list no longer owns it', List[0] = nil); + List.Free; + AssertEquals(SaoPaulo, Kept.Localidade); + finally + Kept.Free; + end; +end; + +procedure TTestOwnership.ExtractGeoTransfersTheCoordinate; +var + Address: TCepisAddress; + Geo: TCepisGeo; +begin + FServer.Respond('/01310100', 200, SeAddress + + ',"geo":{"lat":-23.5,"lon":-46.6,"raio_m":120,"precisao":"logradouro"}}'); + Address := FClient.Lookup('01310100'); + Geo := Address.ExtractGeo; + try + AssertTrue('address no longer owns it', Address.Geo = nil); + Address.Free; + AssertEquals(120, Geo.RaioM); + finally + Geo.Free; + end; +end; + +var + Runner: TTestRunner; + +begin + Randomize; + RegisterTest(TTestNormalisation); + RegisterTest(TTestLookup); + RegisterTest(TTestRetry); + RegisterTest(TTestBatch); + RegisterTest(TTestHealth); + RegisterTest(TTestConfiguration); + RegisterTest(TTestOwnership); + + Runner := TTestRunner.Create(nil); + try + Runner.Initialize; + Runner.Title := 'cepis test suite'; + Runner.Run; + finally + Runner.Free; + end; +end. |