update to use in-place hashing for all objects

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: secretbase
 Type: Package
 Title: Cryptographic Hash and Extendable-Output Functions
-Version: 0.0.2
+Version: 0.0.5
 Description: Fast, dependency-free SHA-3 cryptographic hash and SHAKE256
     extendable-output function (XOF) algorithms. The SHA-3 Secure Hash Standard
     was published by NIST in 2015 at <doi:10.6028/NIST.FIPS.202>. Uses the

NEWS.md

@@ -1,3 +1,7 @@
+# secretbase 0.0.5
+
+* Update to use efficient in-place hashing for all R objects.
+
 # secretbase 0.0.1
 
 * Initial release to rOpenSci R-universe and Github.

R/base.R

@@ -52,10 +52,9 @@
 #' @return A raw vector or character string depending on 'convert'.
 #'
 #' @details For argument 'x', a scalar string or raw vector (with no attributes)
-#'     is hashed directly. All other objects are first serialised using R
-#'     serialisation version 3, big-endian representation, with the
-#'     serialization header stripped (for portability across R installations as
-#'     this contains the R version number).
+#'     is hashed 'as is'. All other objects are hashed in-place, parsed by R
+#'     serialization version 3, big-endian representation, skipping the header
+#'     (for portability as this contains the R version number).
 #'
 #'     The result of hashing is always a byte sequence, which is converted to a
 #'     character string hex representation if 'convert' is TRUE, or returned as

README.Rmd

@@ -19,7 +19,7 @@ knitr::opts_chunk$set(
 [![CRAN status](https://www.r-pkg.org/badges/version/secretbase?color=42147b)](https://CRAN.R-project.org/package=secretbase)
 [![secretbase status badge](https://shikokuchuo.r-universe.dev/badges/secretbase?color=e4723a)](https://shikokuchuo.r-universe.dev/secretbase)
 [![R-CMD-check](https://github.com/shikokuchuo/secretbase/workflows/R-CMD-check/badge.svg)](https://github.com/shikokuchuo/secretbase/actions)
-[![codecov](https://codecov.io/gh/shikokuchuo/secretbase/branch/main/graph/badge.svg)](https://app.codecov.io/gh/shikokuchuo/secretbase)
+[![codecov](https://codecov.io/gh/shikokuchuo/secretbase/graph/badge.svg)](https://codecov.io/gh/shikokuchuo/secretbase)
 <!-- badges: end -->
 
 Fast, dependency-free SHA-3 cryptographic hash and SHAKE256 extendable-output function (XOF) algorithms.

README.md

@@ -10,7 +10,7 @@ status](https://www.r-pkg.org/badges/version/secretbase?color=42147b)](https://C
 [![secretbase status
 badge](https://shikokuchuo.r-universe.dev/badges/secretbase?color=e4723a)](https://shikokuchuo.r-universe.dev/secretbase)
 [![R-CMD-check](https://github.com/shikokuchuo/secretbase/workflows/R-CMD-check/badge.svg)](https://github.com/shikokuchuo/secretbase/actions)
-[![codecov](https://codecov.io/gh/shikokuchuo/secretbase/branch/main/graph/badge.svg)](https://app.codecov.io/gh/shikokuchuo/secretbase)
+[![codecov](https://codecov.io/gh/shikokuchuo/secretbase/graph/badge.svg)](https://codecov.io/gh/shikokuchuo/secretbase)
 <!-- badges: end -->
 
 Fast, dependency-free SHA-3 cryptographic hash and SHAKE256

src/secret.c

@@ -192,34 +192,25 @@ static int mbedtls_sha3_starts(mbedtls_sha3_context *ctx, mbedtls_sha3_id id) {
 
 }
 
-static int mbedtls_sha3_update(mbedtls_sha3_context *ctx,
-                               const uint8_t *input, size_t ilen ) {
-
-  if (ctx == NULL)
-    return -1;
+static void mbedtls_sha3_update(mbedtls_sha3_context *ctx,
+                                const uint8_t *input, size_t ilen) {
 
   if (ilen == 0 || input == NULL)
-    return 0;
+    return;
 
   while (ilen-- > 0) {
     ABSORB(ctx, ctx->index, *input++);
     if ((ctx->index = (ctx->index + 1) % ctx->max_block_size) == 0)
       keccak_f1600(ctx);
   }
 
-  return 0;
+  return;
 
 }
 
 static int mbedtls_sha3_finish(mbedtls_sha3_context *ctx,
                                uint8_t *output, size_t olen) {
-
-  if (ctx == NULL)
-    return -1;
-
-  if (olen == 0)
-    return 0;
-
+
   if (ctx->olen > 0 && ctx->olen != olen)
     return -1;
 
@@ -238,116 +229,17 @@ static int mbedtls_sha3_finish(mbedtls_sha3_context *ctx,
 
 }
 
-static int mbedtls_sha3(mbedtls_sha3_id id, const uint8_t *input,
-                        size_t ilen, uint8_t *output, size_t olen) {
-
-  int ret = -2;
-  mbedtls_sha3_context ctx;
-
-  if (ilen != 0 && input == NULL)
-    return -1;
-
-  if (output == NULL)
-    return -1;
-
-  mbedtls_sha3_init(&ctx);
-
-  if ((ret = mbedtls_sha3_starts(&ctx, id)) != 0)
-    goto exit;
-
-  if ((ret = mbedtls_sha3_update(&ctx, input, ilen)) != 0)
-    goto exit;
-
-  if ((ret = mbedtls_sha3_finish(&ctx, output, olen)) != 0)
-    goto exit;
-
-  exit:
-  mbedtls_sha3_free(&ctx);
-
-  return ret;
-
-}
-
 // secretbase - internal R binding functions -----------------------------------
 
-static void nano_write_char(R_outpstream_t stream, int c) {
-
-  nano_buf *buf = (nano_buf *) stream->data;
-  if (buf->cur >= buf->len) {
-    buf->len <<= 1;
-    buf->buf = R_Realloc(buf->buf, buf->len, unsigned char);
-  }
-
-  buf->buf[buf->cur++] = (char) c;
-
-}
-
-static void nano_write_bytes(R_outpstream_t stream, void *src, int len) {
-
-  nano_buf *buf = (nano_buf *) stream->data;
-
-  size_t req = buf->cur + (size_t) len;
-  if (req > buf->len) {
-    if (req > R_XLEN_T_MAX) {
-      if (buf->len) R_Free(buf->buf);
-      Rf_error("serialization exceeds max length of raw vector");
-    }
-    do {
-      buf->len <<= 1;
-    } while (buf->len < req);
-    buf->buf = R_Realloc(buf->buf, buf->len, unsigned char);
-  }
-
-  memcpy(buf->buf + buf->cur, src, len);
-  buf->cur += len;
-
-}
-
-static void nano_serialize_xdr(nano_buf *buf, const SEXP object) {
-
-  NANO_ALLOC(buf, NANO_INIT_BUFSIZE);
-  struct R_outpstream_st output_stream;
-
-  R_InitOutPStream(
-    &output_stream,
-    (R_pstream_data_t) buf,
-    R_pstream_xdr_format,
-    NANO_SERIAL_VER,
-    nano_write_char,
-    nano_write_bytes,
-    NULL,
-    R_NilValue
-  );
-
-  R_Serialize(object, &output_stream);
+static void hash_bytes(R_outpstream_t stream, void *src, int len) {
 
-}
-
-static nano_buf nano_any_buf(const SEXP x) {
-
-  nano_buf buf;
-
-  switch (TYPEOF(x)) {
-  case STRSXP:
-    if (XLENGTH(x) == 1 && ATTRIB(x) == R_NilValue) {
-      const char *s = CHAR(STRING_ELT(x, 0));
-      NANO_INIT(&buf, (unsigned char *) s, strlen(s));
-      return buf;
-    }
-    break;
-  case RAWSXP:
-    if (ATTRIB(x) == R_NilValue) {
-      NANO_INIT(&buf, (unsigned char *) STDVEC_DATAPTR(x), XLENGTH(x));
-      return buf;
-    }
+  secretbase_context *sctx = (secretbase_context *) stream->data;
+  if (sctx->skip) {
+    sctx->skip--;
+  } else {
+    mbedtls_sha3_update(sctx->ctx, (const uint8_t *) src, (size_t) len);
   }
 
-  nano_serialize_xdr(&buf, x);
-  buf.cur = buf.cur - NANO_SHLEN;
-  memmove(buf.buf, buf.buf + NANO_SHLEN, buf.cur);
-
-  return buf;
-
 }
 
 static SEXP nano_hash_char(unsigned char *buf, const size_t sz) {
@@ -370,7 +262,7 @@ static SEXP nano_hash_char(unsigned char *buf, const size_t sz) {
 // secretbase - public functions -----------------------------------------------
 
 SEXP secretbase_sha3(SEXP x, SEXP size, SEXP convert) {
-
+  
   const int bits = Rf_asInteger(size);
   if (bits < 8 || bits > (1 << 24))
     Rf_error("'size' must be between 8 and 2^24");
@@ -380,7 +272,7 @@ SEXP secretbase_sha3(SEXP x, SEXP size, SEXP convert) {
   mbedtls_sha3_id id;
   SEXP out;
   int xc;
-
+  
   switch(bits) {
   case 224:
     id = MBEDTLS_SHA3_224; break;
@@ -394,27 +286,70 @@ SEXP secretbase_sha3(SEXP x, SEXP size, SEXP convert) {
     id = MBEDTLS_SHA3_SHAKE256; break;
   }
 
-  nano_buf xhash = nano_any_buf(x);
-  xc = mbedtls_sha3(id, xhash.buf, xhash.cur, output, outlen);
-  NANO_FREE(xhash);
+  mbedtls_sha3_context ctx;
+  mbedtls_sha3_init(&ctx);
+
+  if ((xc = mbedtls_sha3_starts(&ctx, id)))
+    goto exit;
 
-  if (xc)
-    Rf_error("bad input data");
+  switch (TYPEOF(x)) {
+  case STRSXP:
+    if (XLENGTH(x) == 1 && ATTRIB(x) == R_NilValue) {
+      const char *s = CHAR(STRING_ELT(x, 0));
+      mbedtls_sha3_update(&ctx, (const uint8_t *) s, (size_t) strlen(s));
+      goto finish;
+    }
+    break;
+  case RAWSXP:
+    if (ATTRIB(x) == R_NilValue) {
+      mbedtls_sha3_update(&ctx, (const uint8_t *) STDVEC_DATAPTR(x), (size_t) XLENGTH(x));
+      goto finish;
+    }
+    break;
+  }
+
+  secretbase_context sctx;
+  sctx.ctx = &ctx;
+  sctx.skip = SB_SERIAL_HEADER_ITEMS;
+
+  struct R_outpstream_st output_stream;
+  R_InitOutPStream(
+    &output_stream,
+    (R_pstream_data_t) &sctx,
+    R_pstream_xdr_format,
+    SB_R_SERIAL_VER,
+    NULL,
+    hash_bytes,
+    NULL,
+    R_NilValue
+  );
+  R_Serialize(x, &output_stream);
+
+  finish:
+
+  if ((xc = mbedtls_sha3_finish(&ctx, output, outlen)))
+    goto exit;
 
-  if (*NANO_INTEGER(convert)) {
+  if (*READ_INTEGER(convert)) {
     out = nano_hash_char(output, outlen);
   } else {
     out = Rf_allocVector(RAWSXP, outlen);
     memcpy(STDVEC_DATAPTR(out), output, outlen);
   }
 
+  mbedtls_sha3_free(&ctx);
+
   return out;
-
+
+  exit:
+  mbedtls_sha3_free(&ctx);
+  Rf_error("hashing encountered error");
+
 }
 
 SEXP secretbase_read_integer(SEXP x) {
 
-  return Rf_ScalarInteger(*NANO_INTEGER(x));
+  return Rf_ScalarInteger(*READ_INTEGER(x));
 
 }
 

src/secret.h

@@ -26,6 +26,10 @@
 #include <Rinternals.h>
 #include <R_ext/Visibility.h>
 
+#define SB_R_SERIAL_VER 3
+#define SB_SERIAL_HEADER_ITEMS 5
+#define READ_INTEGER(x) (int *) DATAPTR_RO(x)
+
 typedef enum {
   MBEDTLS_SHA3_NONE = 0,
   MBEDTLS_SHA3_224,
@@ -54,24 +58,9 @@ typedef struct mbedtls_sha3_context {
   uint16_t max_block_size;
 } mbedtls_sha3_context;
 
-typedef struct nano_buf_s {
-  unsigned char *buf;
-  size_t len;
-  size_t cur;
-} nano_buf;
-
-#define NANO_SHLEN 23
-#define NANO_INIT_BUFSIZE 8192
-#define NANO_SERIAL_VER 3
-#define NANO_ALLOC(x, sz)                                      \
-  (x)->buf = R_Calloc(sz, unsigned char);                      \
-  (x)->len = sz;                                               \
-  (x)->cur = 0
-#define NANO_INIT(x, ptr, sz)                                  \
-  (x)->buf = ptr;                                              \
-  (x)->len = 0;                                                \
-  (x)->cur = sz
-#define NANO_FREE(x) if (x.len) R_Free(x.buf)
-#define NANO_INTEGER(x) (int *) DATAPTR_RO(x)
+typedef struct secretbase_context_s {
+  mbedtls_sha3_context *ctx;
+  int skip;
+} secretbase_context;
 
 #endif

tests/tests.R

@@ -14,13 +14,15 @@ test_equal(sha3("", 256), "a7ffc6f8bf1ed76651c14756a061d662f580ff4de43b49fa82d80
 test_equal(sha3("", 384), "0c63a75b845e4f7d01107d852e4c2485c51a50aaaa94fc61995e71bbee983a2ac3713831264adb47fb6bd1e058d5f004")
 test_equal(sha3("", 512), "a69f73cca23a9ac5c8b567dc185a756e97c982164fe25859e0d1dcc1475c80a615b2123af1f5f94c11e3e9402c3ac558f500199d95b6d3e301758586281dcd26")
 test_equal(sha3("secret base", size = 32), "995ebac1")
-test_equal(sha3(data.frame(a = 1, b = 2)), "05d4308e79d029b4af5604739ecc6c4efa1f602a23add0ed2d247b7407d4832f")
 test_equal(sha3(sha3("secret base", size = 32, convert = FALSE), size = 32), "4d872090")
 test_that(sha3(rnorm(1e5), size = 8196), is.character)
-test_equal(sha3(c("secret", "base")), "d906024c71828a10e28865a80f5e81d2cb5cd74067d44852d7039813ba62b0b6")
+test_equal(sha3(data.frame(a = 1, b = 2)), "33c6b16451e62e56ccab41cbb589178f199f2438b61ac758b707b7b1cd33d194")
+test_equal(sha3(c("secret", "base")), "57bd267111cc85e1c773b0f199b5ea39aae1202f9414e7c320700fd7ad629707")
+test_equal(sha3(NULL), "a15515f0723b692bbe28da9876d858c6cbdf75b19f55393512e72bf1d9c8c86e")
+test_equal(sha3(substitute()), "503e9539989f8b17f7db440849d829d6d5ec0512cb501072156b1185cf297a9b")
+test_error(sha3("secret base", size = 0), "'size' must be between 8 and 2^24")
+test_error(sha3("secret base", size = -1), "'size' must be between 8 and 2^24")
 test_equal(read_integer(sha3("secret base", size = 32, convert = FALSE)), -1044750695L)
 test_equal(read_integer(2:4), 2L)
 test_that(read_integer(NULL), is.integer)
 test_that(read_integer(substitute()), is.integer)
-test_error(sha3("secret base", size = 0), "'size' must be between 8 and 2^24")
-test_error(sha3("secret base", size = -1), "'size' must be between 8 and 2^24")