R/utils.R

In nanonext: NNG (Nanomsg Next Gen) Lightweight Messaging Library

# Copyright (C) 2022-2025 Hibiki AI Limited <info@hibiki-ai.com>
#
# This file is part of nanonext.
#
# nanonext is free software: you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.
#
# nanonext is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with
# nanonext. If not, see <https://www.gnu.org/licenses/>.

# nanonext - Utilities ---------------------------------------------------------

#' NNG Library Version
#'
#' Returns the versions of the 'libnng' and 'libmbedtls' libraries used by the
#' package.
#'
#' @return A character vector of length 2.
#'
#' @examples
#' nng_version()
#'
#' @export
#'
nng_version <- function() .Call(rnng_version)

#' Translate Error Codes
#'
#' Translate integer exit codes generated by the NNG library. All package
#' functions return an integer exit code on error rather than the expected
#' return value. These are classed 'errorValue' and may be checked by
#' [is_error_value()].
#'
#' @param xc integer exit code to translate.
#'
#' @return A character string comprising the error code and error message
#'   separated by `'|'`.
#'
#' @examples
#' nng_error(1L)
#'
#' @export
#'
nng_error <- function(xc) .Call(rnng_strerror, xc)

#' Clock Utility
#'
#' Provides the number of elapsed milliseconds since an arbitrary reference time
#' in the past. The reference time will be the same for a given session, but may
#' differ between sessions.
#'
#' A convenience function for building concurrent applications. The resolution
#' of the clock depends on the underlying system timing facilities and may not
#' be particularly fine-grained. This utility should however be faster than
#' using `Sys.time()`.
#'
#' @return A double.
#'
#' @examples
#' time <- mclock(); msleep(100); mclock() - time
#'
#' @export
#'
mclock <- function() .Call(rnng_clock)

#' Sleep Utility
#'
#' Sleep function. May block for longer than requested, with the actual wait
#' time determined by the capabilities of the underlying system.
#'
#' Non-integer values for `time` are coerced to integer. Negative, logical and
#' other non-numeric values are ignored, causing the function to return
#' immediately.
#'
#' Note that unlike `Sys.sleep()`, this function is not user-interruptible by
#' sending SIGINT e.g. with ctrl + c.
#'
#' @param time integer number of milliseconds to block the caller.
#'
#' @return Invisible NULL.
#'
#' @examples
#' time <- mclock(); msleep(100); mclock() - time
#'
#' @export
#'
msleep <- function(time) invisible(.Call(rnng_sleep, time))

#' Random Data Generation
#'
#' Strictly not for use in statistical analysis. Non-reproducible and with
#' unknown statistical properties. Provides an alternative source of randomness
#' from the Mbed TLS library for purposes such as cryptographic key generation.
#' Mbed TLS uses a block-cipher in counter mode operation, as defined in
#' NIST SP800-90A: *Recommendation for Random Number Generation Using
#' Deterministic Random Bit Generators*. The implementation uses AES-256 as the
#' underlying block cipher, with a derivation function, and an entropy collector
#' combining entropy from multiple sources including at least one strong entropy
#' source.
#'
#' @param n \[default 1L\] integer random bytes to generate (from 0 to 1024),
#'   coerced to integer if required. If a vector, the first element is taken.
#' @param convert \[default TRUE\] logical `FALSE` to return a raw vector, or
#'   `TRUE` to return the hex representation of the bytes as a character string.
#'
#' @return A length `n` raw vector, or length one vector of `2n` random
#'   characters, depending on the value of `convert` supplied.
#'
#' @note Results obtained are independent of and do not alter the state of R's
#'   own pseudo-random number generators.
#'
#' @examples
#' random()
#' random(8L)
#' random(n = 8L, convert = FALSE)
#'
#' @export
#'
random <- function(n = 1L, convert = TRUE) .Call(rnng_random, n, convert)

#' Parse URL
#'
#' Parses a character string containing an RFC 3986 compliant URL as per NNG.
#'
#' @param url character string containing a URL.
#'
#' @return A named character vector of length 10, comprising:
#'  \itemize{
#'     \item `rawurl` - the unparsed URL string.
#'     \item `scheme` - the URL scheme, such as "http" or "inproc" (always lower
#'     case).
#'     \item `userinfo` - the username and password if supplied in the URL
#'     string.
#'     \item `host` - the full host part of the URL, including the port if
#'     present (separated by a colon).
#'     \item `hostname` - the name of the host.
#'     \item `port` - the port (if not specified, the default port if defined by
#'     the scheme).
#'     \item `path` - the path, typically used with HTTP or WebSocket.
#'     \item `query` - the query info (typically following ? in the URL).
#'     \item `fragment` - used for specifying an anchor, the part after # in a
#'     URL.
#'     \item `requri` - the full Request-URI (path\[?query\]\[#fragment\]).
#'  }
#'  Values that cannot be determined are represented by an empty string `""`.
#'
#' @examples
#' parse_url("https://user:password@w3.org:8080/type/path?q=info#intro")
#' parse_url("tcp://192.168.0.2:5555")
#'
#' @export
#'
parse_url <- function(url) .Call(rnng_url_parse, url)

#' Validators
#'
#' Validator functions for object types created by \pkg{nanonext}.
#'
#' Is the object an Aio (inheriting from class 'sendAio' or 'recvAio').
#'
#' Is the object an object inheriting from class 'nano' i.e. a nanoSocket,
#' nanoContext, nanoStream, nanoListener, nanoDialer, nanoMonitor or nano
#' Object.
#'
#' Is the object an ncurlSession (object of class 'ncurlSession').
#'
#' Is the object a Condition Variable (object of class 'conditionVariable').
#'
#' @param x an object.
#'
#' @return Logical value TRUE or FALSE.
#'
#' @examples
#' nc <- call_aio(ncurl_aio("https://postman-echo.com/get", timeout = 1000L))
#' is_aio(nc)
#'
#' @export
#'
is_aio <- function(x) inherits(x, c("recvAio", "sendAio"))

#' @examples
#' s <- socket()
#' is_nano(s)
#' n <- nano()
#' is_nano(n)
#' close(s)
#' n$close()
#'
#' @rdname is_aio
#' @export
#'
is_nano <- function(x) inherits(x, c("nano", "nanoObject"))

#' @examples
#' s <- ncurl_session("https://postman-echo.com/get", timeout = 1000L)
#' is_ncurl_session(s)
#' if (is_ncurl_session(s)) close(s)
#'
#' @rdname is_aio
#' @export
#'
is_ncurl_session <- function(x) inherits(x, "ncurlSession")

#' Error Validators
#'
#' Validator functions for error value types created by \pkg{nanonext}.
#'
#' Is the object an error value generated by the package. All non-success
#' integer return values are classed 'errorValue' to be distinguishable from
#' integer message values. Includes error values returned after a timeout etc.
#'
#' Is the object a nul byte.
#'
#' @param x an object.
#'
#' @return Logical value TRUE or FALSE.
#'
#' @examples
#' s <- socket()
#' r <- recv_aio(s, timeout = 10)
#' call_aio(r)$data
#' close(s)
#' r$data == 5L
#' is_error_value(r$data)
#' is_error_value(5L)
#'
#' @export
#'
is_error_value <- function(x) .Call(rnng_is_error_value, x)

#' @examples
#' is_nul_byte(as.raw(0L))
#' is_nul_byte(raw(length = 1L))
#' is_nul_byte(writeBin("", con = raw()))
#' is_nul_byte(0L)
#' is_nul_byte(NULL)
#' is_nul_byte(NA)
#'
#' @rdname is_error_value
#' @export
#'
is_nul_byte <- function(x) .Call(rnng_is_nul_byte, x)

#' Translate HTTP Status Codes
#'
#' Provides an explanation for HTTP response status codes (in the range 100 to
#' 599). If the status code is not defined as per RFC 9110,
#' `"Unknown HTTP Status"` is returned - this may be a custom code used by the
#' server.
#'
#' @param x numeric HTTP status code to translate.
#'
#' @return A character vector comprising the status code and explanation
#'   separated by `'|'`.
#'
#' @examples
#' status_code(200)
#' status_code(404)
#'
#' @export
#'
status_code <- function(x) .Call(rnng_status_code, x)

#' Create Serialization Configuration
#'
#' Returns a serialization configuration, which may be set on a Socket for
#' custom serialization and unserialization of non-system reference objects,
#' allowing these to be sent and received between different R sessions. This
#' utilises the 'refhook' system of R native serialization. Once set, the
#' functions apply to all send and receive operations performed in mode
#' `"serial"` over the Socket or Context created from the Socket.
#'
#' @param class character string of the class of object custom serialization
#'   functions are applied to, e.g. 'ArrowTabular' or 'torch_tensor'.
#' @param sfunc a function that accepts a reference object inheriting from
#'   `class` (or a list of such objects) and returns a raw vector.
#' @param ufunc a function that accepts a raw vector and returns a reference
#'   object (or list of such objects).
#' @param vec \[default FALSE\] whether or not the serialization functions are
#'   vectorized. If `FALSE`, they should accept and return reference objects
#'   individually e.g. `arrow::write_to_raw` and `arrow::read_ipc_stream`. If
#'   `TRUE`, they should accept and return a list of reference objects, e.g.
#'   `torch::torch_serialize` and `torch::torch_load`.
#'
#' @return A list comprising the configuration. This should be set on a Socket
#'   using [opt<-()] with option name `"serial"`.
#'
#' @examples
#' cfg <- serial_config("test_cls", function(x) serialize(x, NULL), unserialize)
#' cfg
#'
#' s <- socket()
#' opt(s, "serial") <- cfg
#'
#' # provide an empty list to remove registered functions
#' opt(s, "serial") <- list()
#'
#' close(s)
#'
#' @export
#'
serial_config <- function(class, sfunc, ufunc, vec = FALSE)
  .Call(rnng_serial_config, class, sfunc, ufunc, vec)

#' Set Serialization Marker
#'
#' Internal package function.
#'
#' @param x logical value.
#'
#' @return The logical value `x` supplied.
#'
#' @keywords internal
#' @export
#'
.mark <- function(x = TRUE) .Call(rnng_set_marker, x)

#' Advances the RNG State
#'
#' Internal package function.
#'
#' @return NULL.
#'
#' @keywords internal
#' @export
#'
.advance <- function() .Call(rnng_advance_rng_state)

#' Interrupt Switch
#'
#' Sets whether async receive completions trigger an interrupt.
#' Internal package function.
#'
#' @param x logical value.
#'
#' @return The logical value `x` supplied.
#'
#' @keywords internal
#' @export
#'
.interrupt <- function(x = TRUE) .Call(rnng_interrupt_switch, x)

#' Internal Package Function
#'
#' Only present for cleaning up after running examples and tests. Do not attempt
#' to run the examples.
#'
#' @examples
#' if (Sys.info()[["sysname"]] == "Linux") {
#'   rm(list = ls())
#'   gc()
#'   .Call(nanonext:::rnng_thread_shutdown)
#'   Sys.sleep(1L)
#'   .Call(nanonext:::rnng_fini)
#' }
#'
#' @keywords internal
#'
zzz <- function() {}