# Copyright (C) 2022-2024 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.
#'
#' @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
#'     \code{\link{is_error_value}}.
#'
#' @param xc integer exit code to translate.
#'
#' @return A character vector.
#'
#' @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.
#'
#' @details 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 \code{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.
#'
#' @param time integer number of milliseconds to block the caller.
#'
#' @return Invisible NULL.
#'
#' @details Non-integer values for 'time' are coerced to integer, and the
#'     absolute value is taken (the sign is ignored). Non-numeric values are
#'     ignored, causing the function to return immediately.
#'
#'     Note that unlike \code{\link{Sys.sleep}}, this function is not
#'     user-interruptible by sending SIGINT e.g. with ctrl + c.
#'
#' @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: \emph{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).
#' @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.
#'
#' @details If 'n' is non-integer, it will be coerced to integer; if a vector,
#'     only the first element will be used.
#'
#' @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 \code{rawurl} - the unparsed URL string.
#'     \item \code{scheme} - the URL scheme, such as "http" or "inproc"
#'     (always lower case).
#'     \item \code{userinfo} - the username and password if supplied in the
#'     URL string.
#'     \item \code{host} - the full host part of the URL, including the port
#'     if present (separated by a colon).
#'     \item \code{hostname} - the name of the host.
#'     \item \code{port} - the port (if not specified, the default port if
#'     defined by the scheme).
#'     \item \code{path} - the path, typically used with HTTP or WebSocket.
#'     \item \code{query} - the query info (typically following ? in the URL).
#'     \item \code{fragment} - used for specifying an anchor, the part after #
#'     in a URL.
#'     \item \code{requri} - the full Request-URI (path[?query][#fragment]).
#'     }
#'     Values that cannot be determined are represented by an empty string
#'     \code{''}.
#'
#' @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 \{nanonext\}.
#'
#' @param x an object.
#'
#' @return Logical value TRUE or FALSE.
#'
#' @details 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, or nano Object.
#'
#' @examples
#' sock <- socket(listen = "inproc://isaio")
#' r <- recv_aio(sock)
#' s <- send_aio(sock, "test")
#' is_aio(r)
#' is_aio(s)
#' close(sock)
#'
#' @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"))

#' Error Validators
#'
#' Validator functions for error value types created by \pkg{nanonext}.
#'
#' @param x an object.
#'
#' @return Logical value TRUE or FALSE.
#'
#' @details 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.
#'
#' @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, 'Non-standard
#'     Response' is returned, which may be a custom code used by the server.
#'
#' @param x numeric HTTP status code to translate.
#'
#' @return A character vector.
#'
#' @examples
#' status_code(200)
#' status_code(404)
#'
#' @export
#'
status_code <- function(x) .Call(rnng_status_code, x)

#' Concatenate Strings
#'
#' A fast implementation that combines two character values into a single string.
#'
#' @param a character value.
#' @param b character value.
#'
#' @return A character string.
#'
#' @details If either 'a' or 'b' is a vector of length greater than 1, only the
#'     first element of each is concatenated.
#'
#' @examples
#' strcat("hello ", "world!")
#'
#' @export
#'
strcat <- function(a, b) .Call(rnng_strcat, a, b)

#' Configure Next Mode
#'
#' Configures send mode 'next' by registering functions for custom serialization
#'     and unserialization of external pointer reference objects, allowing these
#'     to be sent and received between different R sessions.
#'
#' @param refhook \strong{either} a list or pairlist of two functions: the
#'     signature for the first must accept a list of external pointer objects
#'     and return a raw vector, e.g. \code{torch::torch_serialize}, and the
#'     second must accept a raw vector and return a list of external pointer
#'     objects, e.g. \code{torch::torch_load},\cr \strong{or else} NULL to reset.
#' @param mark [default FALSE] (for advanced use only) logical value, whether to
#'     mark serialized data with a special bit.
#'
#' @return A pairlist comprising the currently-registered 'refhook' functions.
#'
#' @details Calling this function without any arguments returns the pairlist of
#'     currently-registered 'refhook' functions (and resets 'mark' to FALSE).
#'
#' @examples
#' g <- next_config(refhook = list(function(x) serialize(x, NULL), unserialize))
#' next_config()
#' next_config(g, mark = TRUE)
#'
#' next_config(NULL)
#' next_config()
#'
#' @export
#'
next_config <- function(refhook = list(), mark = FALSE)
  .Call(rnng_next_config, refhook, mark)