diff options
Diffstat (limited to 'src/cepis.f90')
| -rw-r--r-- | src/cepis.f90 | 693 |
1 files changed, 693 insertions, 0 deletions
diff --git a/src/cepis.f90 b/src/cepis.f90 new file mode 100644 index 0000000..27e2c6d --- /dev/null +++ b/src/cepis.f90 @@ -0,0 +1,693 @@ +!> Fortran client for the public CEP API at https://cep.is +!> +!> Official Correios data (DNE), refreshed every two weeks. +!> +!> ```fortran +!> use cepis +!> type(cepis_address) :: address +!> integer :: status +!> character(len=:), allocatable :: message +!> +!> call cepis_lookup('01001-000', address, status, message) +!> if (status == CEPIS_OK) print *, address%logradouro, address%uf +!> ``` +!> +!> Every fallible call reports through `status` and `message` rather than +!> stopping the program. `status` is one of the `CEPIS_*` parameters in +!> `cepis_errors`; `message` is always allocated. +!> +!> A `cepis_client` holds the configuration and keeps no state between calls. +!> The module-level `cepis_lookup`, `cepis_lookup_many` and +!> `cepis_check_health` use one shared default client, which is not safe to use +!> from two threads at once — build your own client per thread if you need +!> that. +module cepis + use, intrinsic :: iso_fortran_env, only: real64, int64 + use cepis_errors + use cepis_strings, only: url_encode, strip, from_integer + use cepis_json, only: json_document, json_parse, JSON_OBJECT + use cepis_csv, only: csv_table, csv_parse + use cepis_http, only: http_response, http_get, http_sleep, http_monotonic + use cepis_models + implicit none + private + + public :: CEPIS_OK + public :: CEPIS_ERR_INVALID_CEP + public :: CEPIS_ERR_NOT_FOUND + public :: CEPIS_ERR_RATE_LIMITED + public :: CEPIS_ERR_SERVER + public :: CEPIS_ERR_NETWORK + public :: CEPIS_ERR_INVALID_RESPONSE + public :: CEPIS_ERR_CONFIG + public :: cepis_status_name + + public :: cepis_geo + public :: cepis_address + public :: cepis_health + public :: cepis_client + + public :: cepis_client_init + public :: cepis_lookup + public :: cepis_lookup_many + public :: cepis_check_health + public :: cepis_normalize_cep + public :: cepis_format_cep + + !> Library version. + character(len=*), parameter, public :: CEPIS_VERSION = '0.1.0' + + !> Default API endpoint. + character(len=*), parameter, public :: CEPIS_DEFAULT_BASE_URL = 'https://cep.is' + + !> Most CEPs the API accepts in one batch request. + integer, parameter, public :: CEPIS_MAX_BATCH = 500 + + character(len=*), parameter :: ACCEPT_HEADER = 'application/json, text/csv;q=0.9, */*;q=0.1' + + !> Client for the cep.is API. + !> + !> A default-initialised `type(cepis_client)` is already usable and talks to + !> `https://cep.is`. Use `cepis_client_init` to change anything, which also + !> validates the values. + type :: cepis_client + !> Where the API lives. Point it at a local instance or at a test + !> server. It is the only setting that usually changes between + !> environments. A trailing slash is stripped, so it cannot produce + !> doubled separators that some proxies normalise and others 404. + character(len=:), allocatable :: base_url + !> Overrides the `User-Agent`. The default identifies the library and + !> its version, which is what lets the server diagnose an old client + !> misbehaving. + character(len=:), allocatable :: user_agent + !> Seconds to wait **per socket operation**: it caps the connect phase + !> and aborts a transfer that stalls for that long. It is not a cap on + !> the whole call — that is `total_timeout`. + real(real64) :: timeout = 10.0_real64 + !> 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. + integer :: max_attempts = 3 + !> 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. + real(real64) :: backoff_base = 0.5_real64 + !> 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 caller for an hour. + real(real64) :: backoff_max = 8.0_real64 + !> Cap on the whole call, attempts and waits included. `0` leaves + !> `max_attempts` as the only bound. Set it in code serving a web + !> request: without it the worst case is `max_attempts * timeout` plus + !> the sum of the backoffs. + real(real64) :: total_timeout = 0.0_real64 + contains + !> Look up a single CEP. + procedure :: lookup => client_lookup + !> Look up many CEPs in one batch. + procedure :: lookup_many => client_lookup_many + !> Query `GET /health`. + procedure :: health => client_health + !> The base URL in use, trailing slash stripped. + procedure :: url => client_url + !> The `User-Agent` in use. + procedure :: agent => client_agent + end type cepis_client + + type(cepis_client), save :: default_client + logical, save :: seeded = .false. + +contains + + !> Build a client, validating every value. + !> + !> Omitted arguments keep their defaults: `https://cep.is`, 10 s per socket + !> operation, 3 attempts, 0.5 s backoff base, 8 s backoff cap, no total + !> timeout. + subroutine cepis_client_init(client, status, message, base_url, user_agent, & + timeout, max_attempts, backoff_base, & + backoff_max, total_timeout) + type(cepis_client), intent(out) :: client + integer, intent(out) :: status + character(len=:), allocatable, intent(out) :: message + character(len=*), intent(in), optional :: base_url + character(len=*), intent(in), optional :: user_agent + real(real64), intent(in), optional :: timeout + integer, intent(in), optional :: max_attempts + real(real64), intent(in), optional :: backoff_base + real(real64), intent(in), optional :: backoff_max + real(real64), intent(in), optional :: total_timeout + character(len=:), allocatable :: trimmed + integer :: last + + status = CEPIS_OK + message = '' + + client%base_url = CEPIS_DEFAULT_BASE_URL + client%user_agent = 'cepis-fortran/'//CEPIS_VERSION//' (+https://cep.is)' + + if (present(base_url)) then + trimmed = strip(base_url) + last = len(trimmed) + do while (last > 0) + if (trimmed(last:last) /= '/') exit + last = last - 1 + end do + if (last <= 0) then + status = CEPIS_ERR_CONFIG + message = 'base_url must not be empty' + return + end if + client%base_url = trimmed(1:last) + end if + + if (present(user_agent)) then + if (len(strip(user_agent)) == 0) then + status = CEPIS_ERR_CONFIG + message = 'user_agent must not be empty' + return + end if + client%user_agent = strip(user_agent) + end if + + if (present(timeout)) then + if (timeout <= 0.0_real64) then + status = CEPIS_ERR_CONFIG + message = 'timeout must be > 0' + return + end if + client%timeout = timeout + end if + + if (present(max_attempts)) then + if (max_attempts < 1) then + status = CEPIS_ERR_CONFIG + message = 'max_attempts must be >= 1' + return + end if + client%max_attempts = max_attempts + end if + + if (present(backoff_base)) then + if (backoff_base < 0.0_real64) then + status = CEPIS_ERR_CONFIG + message = 'backoff_base must be >= 0' + return + end if + client%backoff_base = backoff_base + end if + + if (present(backoff_max)) then + if (backoff_max < 0.0_real64) then + status = CEPIS_ERR_CONFIG + message = 'backoff_max must be >= 0' + return + end if + client%backoff_max = backoff_max + end if + + if (present(total_timeout)) then + if (total_timeout < 0.0_real64) then + status = CEPIS_ERR_CONFIG + message = 'total_timeout must be >= 0' + return + end if + client%total_timeout = total_timeout + end if + end subroutine cepis_client_init + + pure function client_url(self) result(text) + class(cepis_client), intent(in) :: self + character(len=:), allocatable :: text + + if (allocated(self%base_url)) then + text = self%base_url + else + text = CEPIS_DEFAULT_BASE_URL + end if + end function client_url + + pure function client_agent(self) result(text) + class(cepis_client), intent(in) :: self + character(len=:), allocatable :: text + + if (allocated(self%user_agent)) then + text = self%user_agent + else + text = 'cepis-fortran/'//CEPIS_VERSION//' (+https://cep.is)' + end if + end function client_agent + + !> Return the CEP's 8 digits, accepting the mask. + !> + !> `01001-000`, `01001000` and ` 01001-000 ` all become `01001000`. + !> + !> 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. + subroutine cepis_normalize_cep(value, digits, status, message) + character(len=*), intent(in) :: value + character(len=:), allocatable, intent(out) :: digits + integer, intent(out) :: status + character(len=:), allocatable, intent(out) :: message + integer :: i + + digits = '' + do i = 1, len(value) + select case (value(i:i)) + case ('0':'9') + digits = digits//value(i:i) + case (' ', '-', '.', char(9)) + cycle + case default + status = CEPIS_ERR_INVALID_CEP + message = 'CEP must be 8 digits, got '''//strip(value)//'''' + digits = '' + return + end select + end do + + if (len(digits) /= 8) then + status = CEPIS_ERR_INVALID_CEP + message = 'CEP must be 8 digits, got '''//strip(value)//'''' + digits = '' + return + end if + + status = CEPIS_OK + message = '' + end subroutine cepis_normalize_cep + + !> Look up a single CEP. + !> + !> A 400 from the API is surfaced as `CEPIS_ERR_INVALID_CEP` carrying the + !> API's own message: the format already passed local validation, so the + !> server knows something this client does not. + !> + !> This is the only call that carries `has_geo` and `geo`. + subroutine client_lookup(self, cep, address, status, message, http_status, retry_after) + class(cepis_client), intent(in) :: self + character(len=*), intent(in) :: cep + type(cepis_address), intent(out) :: address + integer, intent(out) :: status + character(len=:), allocatable, intent(out) :: message + integer, intent(out), optional :: http_status + real(real64), intent(out), optional :: retry_after + character(len=:), allocatable :: digits + type(http_response) :: response + type(json_document) :: doc + logical :: ok + + call address_clear(address) + if (present(http_status)) http_status = 0 + if (present(retry_after)) retry_after = -1.0_real64 + + call cepis_normalize_cep(cep, digits, status, message) + if (status /= CEPIS_OK) return + + call request(self, '/'//digits, .false., response, status, message, & + http_status, retry_after) + if (status /= CEPIS_OK) return + + if (present(http_status)) http_status = response%status + + if (response%status == 404) then + status = CEPIS_ERR_NOT_FOUND + message = 'CEP '//digits//' does not exist in the DNE database' + return + end if + + if (response%status == 400) then + status = CEPIS_ERR_INVALID_CEP + message = api_message(response%body, 'CEP '//digits//' rejected') + return + end if + + call read_object(response%body, doc, ok, message) + if (.not. ok) then + status = CEPIS_ERR_INVALID_RESPONSE + return + end if + + call address_from_json(doc, doc%root, response%body, address) + status = CEPIS_OK + message = '' + end subroutine client_lookup + + !> Look up many CEPs in one batch. + !> + !> `addresses` has **the same length and the same order** as `ceps`. A CEP + !> that does not exist comes back with `found = .false.` at its position — + !> it does not vanish from the array, and it is not an error. 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 is + !> `found = .false.` for the same reason; call `cepis_normalize_cep` first + !> if you need to know which one it was. + !> + !> Trailing blanks in each element are ignored, so a literal array such as + !> `['01001000', '99999999']` works as written. + !> + !> Input is chunked into blocks of `CEPIS_MAX_BATCH` automatically. Do not + !> loop over `lookup` instead: a loop of 500 calls pays 500 round trips, + !> this pays one. + !> + !> **The batch carries no coordinate.** The endpoint behind it is CSV, and + !> the CSV has no `geo` column. Every address returned here has + !> `has_geo = .false.`, including for CEPs that do have one. Need `geo`? + !> Use `lookup`, one at a time. + subroutine client_lookup_many(self, ceps, addresses, status, message, & + http_status, retry_after) + class(cepis_client), intent(in) :: self + character(len=*), intent(in) :: ceps(:) + type(cepis_address), allocatable, intent(out) :: addresses(:) + integer, intent(out) :: status + character(len=:), allocatable, intent(out) :: message + integer, intent(out), optional :: http_status + real(real64), intent(out), optional :: retry_after + integer :: total, first, last, i + + status = CEPIS_OK + message = '' + if (present(http_status)) http_status = 0 + if (present(retry_after)) retry_after = -1.0_real64 + + total = size(ceps) + allocate (addresses(total)) + do i = 1, total + call address_clear(addresses(i)) + addresses(i)%cep = strip(ceps(i)) + end do + if (total == 0) return + + first = 1 + do while (first <= total) + last = min(first + CEPIS_MAX_BATCH - 1, total) + call lookup_chunk(self, ceps, first, last, addresses, status, & + message, http_status, retry_after) + if (status /= CEPIS_OK) return + first = last + 1 + end do + end subroutine client_lookup_many + + !> Query `GET /health`: does the API answer, and with which database. + !> + !> Does not fail for an API reporting itself degraded — that arrives in + !> `health%status`, and checking health is exactly when you want the + !> diagnosis rather than an error. Network failures still fail. + subroutine client_health(self, health, status, message, http_status, retry_after) + class(cepis_client), intent(in) :: self + type(cepis_health), intent(out) :: health + integer, intent(out) :: status + character(len=:), allocatable, intent(out) :: message + integer, intent(out), optional :: http_status + real(real64), intent(out), optional :: retry_after + type(http_response) :: response + type(json_document) :: doc + logical :: ok + + health%status = '' + health%dne = '' + health%base_gerada_em = '' + if (present(http_status)) http_status = 0 + if (present(retry_after)) retry_after = -1.0_real64 + + call request(self, '/health', .true., response, status, message, & + http_status, retry_after) + if (status /= CEPIS_OK) return + + if (present(http_status)) http_status = response%status + + call read_object(response%body, doc, ok, message) + if (.not. ok) then + status = CEPIS_ERR_INVALID_RESPONSE + return + end if + + call health_from_json(doc, doc%root, health) + status = CEPIS_OK + message = '' + end subroutine client_health + + subroutine lookup_chunk(self, ceps, first, last, addresses, status, & + message, http_status, retry_after) + class(cepis_client), intent(in) :: self + character(len=*), intent(in) :: ceps(:) + integer, intent(in) :: first + integer, intent(in) :: last + type(cepis_address), intent(inout) :: addresses(:) + integer, intent(out) :: status + character(len=:), allocatable, intent(out) :: message + integer, intent(out), optional :: http_status + real(real64), intent(out), optional :: retry_after + type(http_response) :: response + type(csv_table) :: table + character(len=:), allocatable :: query + logical :: ok + integer :: i, row + + query = '' + do i = first, last + if (i > first) query = query//'%2C' + query = query//url_encode(strip(ceps(i))) + end do + + call request(self, '/csv?ceps='//query, .false., response, status, & + message, http_status, retry_after) + if (status /= CEPIS_OK) return + + if (present(http_status)) http_status = response%status + + call csv_parse(response%body, table, ok, message) + if (ok) ok = table%height() >= 1 + if (ok) ok = table%column('cep') > 0 + if (.not. ok) then + status = CEPIS_ERR_INVALID_RESPONSE + if (len(message) == 0) message = 'the batch response is not the expected CSV' + return + end if + + do i = first, last + row = 1 + (i - first) + 1 + if (row > table%height()) exit + if (len(strip(table%cell(row, 'localidade'))) == 0) cycle + call address_from_row(table, row, addresses(i)) + end do + + status = CEPIS_OK + message = '' + end subroutine lookup_chunk + + subroutine address_from_row(table, row, address) + type(csv_table), intent(in) :: table + integer, intent(in) :: row + type(cepis_address), intent(inout) :: address + + address%found = .true. + address%cep = table%cell(row, 'cep') + address%logradouro = table%cell(row, 'logradouro') + address%complemento = table%cell(row, 'complemento') + address%unidade = table%cell(row, 'unidade') + address%bairro = table%cell(row, 'bairro') + address%localidade = table%cell(row, 'localidade') + address%uf = table%cell(row, 'uf') + address%estado = table%cell(row, 'estado') + address%regiao = table%cell(row, 'regiao') + address%ibge = table%cell(row, 'ibge') + address%gia = table%cell(row, 'gia') + address%ddd = table%cell(row, 'ddd') + address%siafi = table%cell(row, 'siafi') + address%has_geo = .false. + address%raw = '' + end subroutine address_from_row + + subroutine request(self, path, accept_unavailable, response, status, & + message, http_status, retry_after) + class(cepis_client), intent(in) :: self + character(len=*), intent(in) :: path + logical, intent(in) :: accept_unavailable + type(http_response), intent(out) :: response + integer, intent(out) :: status + character(len=:), allocatable, intent(out) :: message + integer, intent(out), optional :: http_status + real(real64), intent(out), optional :: retry_after + character(len=:), allocatable :: url, detail + real(real64) :: deadline, wait, remaining, last_retry_after + integer :: attempt, last_status + logical :: ok + + url = self%url()//path + status = CEPIS_OK + message = '' + last_status = 0 + last_retry_after = -1.0_real64 + detail = '' + + deadline = -1.0_real64 + if (self%total_timeout > 0.0_real64) deadline = http_monotonic() + self%total_timeout + + do attempt = 1, self%max_attempts + if (deadline > 0.0_real64) then + if (http_monotonic() >= deadline) exit + end if + + call http_get(url, self%agent(), ACCEPT_HEADER, self%timeout, & + response, ok, detail) + + if (ok) then + if (response%status == 200) return + if (accept_unavailable .and. response%status == 503) return + if (.not. retriable(response%status)) return + last_status = response%status + last_retry_after = response%retry_after + detail = '' + else + last_status = 0 + last_retry_after = -1.0_real64 + end if + + if (attempt == self%max_attempts) exit + + wait = backoff(self, attempt, last_retry_after) + if (deadline > 0.0_real64) then + remaining = deadline - http_monotonic() + if (remaining <= 0.0_real64) exit + wait = min(wait, remaining) + end if + call http_sleep(wait) + end do + + if (present(http_status)) http_status = last_status + if (present(retry_after)) retry_after = last_retry_after + + if (last_status == 429) then + status = CEPIS_ERR_RATE_LIMITED + message = 'rate limit reached at '//url//' (after '// & + from_integer(int(self%max_attempts, int64))//' attempt(s))' + else if (last_status /= 0) then + status = CEPIS_ERR_SERVER + message = 'the API answered '//from_integer(int(last_status, int64))// & + ' at '//url//' (after '// & + from_integer(int(self%max_attempts, int64))//' attempt(s))' + else + status = CEPIS_ERR_NETWORK + message = 'could not reach '//url//' (after '// & + from_integer(int(self%max_attempts, int64))//' attempt(s)): '//detail + end if + end subroutine request + + pure function retriable(http_status) result(yes) + integer, intent(in) :: http_status + logical :: yes + + select case (http_status) + case (429, 500, 502, 503, 504) + yes = .true. + case default + yes = .false. + end select + end function retriable + + function backoff(self, attempt, retry_after) result(wait) + class(cepis_client), intent(in) :: self + integer, intent(in) :: attempt + real(real64), intent(in) :: retry_after + real(real64) :: wait, ceiling_value, draw + + if (retry_after >= 0.0_real64) then + wait = min(retry_after, self%backoff_max) + return + end if + + if (.not. seeded) then + call random_init(.false., .false.) + seeded = .true. + end if + + ceiling_value = min(self%backoff_base*2.0_real64**(attempt - 1), self%backoff_max) + call random_number(draw) + wait = draw*ceiling_value + end function backoff + + subroutine read_object(body, doc, ok, message) + character(len=*), intent(in) :: body + type(json_document), intent(out) :: doc + logical, intent(out) :: ok + character(len=:), allocatable, intent(out) :: message + character(len=:), allocatable :: detail + integer :: shown + + call json_parse(body, doc, ok, detail) + if (.not. ok) then + shown = min(len(body), 120) + message = 'response is not valid JSON — something between you and '// & + 'the API is answering instead of it: '''//body(1:shown)// & + ''' ('//detail//')' + return + end if + + if (doc%kind_of(doc%root) /= JSON_OBJECT) then + ok = .false. + message = 'expected a JSON object at the top level' + return + end if + + message = '' + end subroutine read_object + + function api_message(body, fallback) result(text) + character(len=*), intent(in) :: body + character(len=*), intent(in) :: fallback + character(len=:), allocatable :: text + type(json_document) :: doc + character(len=:), allocatable :: detail + logical :: ok + + text = fallback + call json_parse(body, doc, ok, detail) + if (.not. ok) return + if (doc%kind_of(doc%root) /= JSON_OBJECT) return + detail = doc%field_text(doc%root, 'mensagem') + if (len(detail) > 0) text = detail + end function api_message + + subroutine ensure_default() + if (.not. allocated(default_client%base_url)) then + default_client%base_url = CEPIS_DEFAULT_BASE_URL + default_client%user_agent = 'cepis-fortran/'//CEPIS_VERSION//' (+https://cep.is)' + end if + end subroutine ensure_default + + !> `lookup` on a shared default client pointed at `https://cep.is`. + subroutine cepis_lookup(cep, address, status, message) + character(len=*), intent(in) :: cep + type(cepis_address), intent(out) :: address + integer, intent(out) :: status + character(len=:), allocatable, intent(out) :: message + + call ensure_default() + call default_client%lookup(cep, address, status, message) + end subroutine cepis_lookup + + !> `lookup_many` on a shared default client pointed at `https://cep.is`. + subroutine cepis_lookup_many(ceps, addresses, status, message) + character(len=*), intent(in) :: ceps(:) + type(cepis_address), allocatable, intent(out) :: addresses(:) + integer, intent(out) :: status + character(len=:), allocatable, intent(out) :: message + + call ensure_default() + call default_client%lookup_many(ceps, addresses, status, message) + end subroutine cepis_lookup_many + + !> `health` on a shared default client pointed at `https://cep.is`. + subroutine cepis_check_health(health, status, message) + type(cepis_health), intent(out) :: health + integer, intent(out) :: status + character(len=:), allocatable, intent(out) :: message + + call ensure_default() + call default_client%health(health, status, message) + end subroutine cepis_check_health + +end module cepis |