summaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorMurilo Ijanc <[email protected]>2026-07-26 12:45:04 -0300
committerMurilo Ijanc <[email protected]>2026-07-26 12:45:04 -0300
commitcf5597871327dbff2c7c743672d696e7ff340c42 (patch)
tree2502272b9042d9bc980b20a8a3f308b7c5e7fe87 /src
downloadpascal-cf5597871327dbff2c7c743672d696e7ff340c42.tar.gz
Initial importv0.1.0
Diffstat (limited to 'src')
-rw-r--r--src/Cepis.pas1275
-rw-r--r--src/CepisHttp.pas178
2 files changed, 1453 insertions, 0 deletions
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.