path: root/src/cepis.f90

!> 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_faixa
    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.2.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`.
    !>
    !> A 404 is `CEPIS_ERR_NOT_FOUND` and `address%found` stays `.false.`, but
    !> the API may still say which municipality the CEP *would* have belonged
    !> to. When it does, `address%has_faixa` is `.true.` and `address%faixa`
    !> names it — see `cepis_faixa`. It is context for the failure, never an
    !> address: the call still failed and the CEP still does not exist.
    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'
            call address_faixa_from_body(response%body, address)
            if (address%has_faixa) then
                message = message//' — its band belongs to '//address%faixa%localidade
                if (len(address%faixa%uf) > 0) message = message//'/'//address%faixa%uf
            end if
            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. The same goes for `has_faixa`: the CSV has
    !> no `faixa` column either, so a CEP the batch did not resolve is simply
    !> `found = .false.` with nothing said about where it would have been.
    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