replace ScrubbedBytes

apps/smp-agent/Main.hs

@@ -5,13 +5,13 @@
 module Main where
 
 import Control.Logger.Simple
-import Data.ByteArray (ScrubbedBytes)
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Server (runSMPAgent)
 import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..))
 import Simplex.Messaging.Client (defaultNetworkConfig)
+import Simplex.Messaging.Crypto.Memory (LockedBytes)
 import Simplex.Messaging.Transport (TLS, Transport (..))
 
 cfg :: AgentConfig
@@ -20,7 +20,7 @@ cfg = defaultAgentConfig
 agentDbFile :: String
 agentDbFile = "smp-agent.db"
 
-agentDbKey :: ScrubbedBytes
+agentDbKey :: LockedBytes
 agentDbKey = ""
 
 servers :: InitialAgentServers

cbits/sodium/utils_memory.c

@@ -0,0 +1,605 @@
+#ifndef __STDC_WANT_LIB_EXT1__
+# define __STDC_WANT_LIB_EXT1__ 1
+#endif
+#include <assert.h>
+#include <errno.h>
+#include <limits.h>
+#include <stddef.h>
+#include <stdio.h> // for debug prints
+#include <stdint.h>
+#include <stdlib.h>
+#include <string.h>
+
+#if defined(HAVE_RAISE) && !defined(__wasm__)
+# include <signal.h>
+#endif
+
+#ifdef HAVE_SYS_MMAN_H
+# include <sys/mman.h>
+#endif
+
+#ifdef HAVE_SYS_PARAM_H
+# include <sys/param.h>
+#endif
+
+#ifdef _WIN32
+# include <windows.h>
+# include <wincrypt.h>
+#else
+# include <unistd.h>
+#endif
+
+#ifndef HAVE_C_VARARRAYS
+# ifdef HAVE_ALLOCA_H
+#  include <alloca.h>
+# elif !defined(alloca)
+#  if defined(__clang__) || defined(__GNUC__)
+#   define alloca __builtin_alloca
+#  elif defined _AIX
+#   define alloca __alloca
+#  elif defined _MSC_VER
+#   include <malloc.h>
+#   define alloca _alloca
+#  else
+#   include <stddef.h>
+#   ifdef  __cplusplus
+extern "C"
+#   endif
+void *alloca (size_t);
+#  endif
+# endif
+#endif
+
+// #include "core.h"
+// #include "crypto_generichash.h"
+// #include "crypto_stream.h"
+// #include "randombytes.h"
+// #include "private/common.h"
+// #include "sodium_utils.h"
+
+#ifndef ENOSYS
+# define ENOSYS ENXIO
+#endif
+
+#if defined(_WIN32) && \
+    (!defined(WINAPI_FAMILY) || WINAPI_FAMILY == WINAPI_FAMILY_DESKTOP_APP)
+# define WINAPI_DESKTOP
+#endif
+
+#define CANARY_SIZE 16U
+#define GARBAGE_VALUE 0xdb
+
+#ifndef MAP_NOCORE
+# ifdef MAP_CONCEAL
+#  define MAP_NOCORE MAP_CONCEAL
+# else
+#  define MAP_NOCORE 0
+# endif
+#endif
+#if !defined(MAP_ANON) && defined(MAP_ANONYMOUS)
+# define MAP_ANON MAP_ANONYMOUS
+#endif
+#if defined(WINAPI_DESKTOP) || (defined(MAP_ANON) && defined(HAVE_MMAP)) || \
+    defined(HAVE_POSIX_MEMALIGN)
+# define HAVE_ALIGNED_MALLOC
+#endif
+
+#if defined(HAVE_MPROTECT) && \
+    !(defined(PROT_NONE) && defined(PROT_READ) && defined(PROT_WRITE))
+# undef HAVE_MPROTECT
+#endif
+#if defined(HAVE_ALIGNED_MALLOC) && \
+    (defined(WINAPI_DESKTOP) || defined(HAVE_MPROTECT))
+# define HAVE_PAGE_PROTECTION
+#endif
+#if !defined(MADV_DODUMP) && defined(MADV_CORE)
+# define MADV_DODUMP   MADV_CORE
+# define MADV_DONTDUMP MADV_NOCORE
+#endif
+
+#ifndef DEFAULT_PAGE_SIZE
+# ifdef PAGE_SIZE
+#  define DEFAULT_PAGE_SIZE PAGE_SIZE
+# else
+#  define DEFAULT_PAGE_SIZE 0x10000
+# endif
+#endif
+
+static size_t        page_size = DEFAULT_PAGE_SIZE;
+static unsigned char canary[CANARY_SIZE];
+
+/* LCOV_EXCL_START */
+#ifdef HAVE_WEAK_SYMBOLS
+__attribute__((weak)) void
+_sodium_dummy_symbol_to_prevent_memzero_lto(void *const  pnt,
+                                            const size_t len);
+__attribute__((weak)) void
+_sodium_dummy_symbol_to_prevent_memzero_lto(void *const  pnt,
+                                            const size_t len)
+{
+    (void) pnt; /* LCOV_EXCL_LINE */
+    (void) len; /* LCOV_EXCL_LINE */
+}
+#endif
+/* LCOV_EXCL_STOP */
+
+void
+sodium_memzero(void * const pnt, const size_t len)
+{
+#if defined(_WIN32) && !defined(__CRT_INLINE)
+    SecureZeroMemory(pnt, len);
+#elif defined(HAVE_MEMSET_S)
+    if (len > 0U && memset_s(pnt, (rsize_t) len, 0, (rsize_t) len) != 0) {
+        sodium_misuse(); /* LCOV_EXCL_LINE */
+    }
+#elif defined(HAVE_EXPLICIT_BZERO)
+    explicit_bzero(pnt, len);
+#elif defined(HAVE_MEMSET_EXPLICIT)
+    memset_explicit(pnt, 0, len);
+#elif defined(HAVE_EXPLICIT_MEMSET)
+    explicit_memset(pnt, 0, len);
+#elif HAVE_WEAK_SYMBOLS
+    if (len > 0U) {
+        memset(pnt, 0, len);
+        _sodium_dummy_symbol_to_prevent_memzero_lto(pnt, len);
+    }
+# ifdef HAVE_INLINE_ASM
+    __asm__ __volatile__ ("" : : "r"(pnt) : "memory");
+# endif
+#else
+    volatile unsigned char *volatile pnt_ =
+        (volatile unsigned char *volatile) pnt;
+    size_t i = (size_t) 0U;
+
+    while (i < len) {
+        pnt_[i++] = 0U;
+    }
+#endif
+}
+
+void
+sodium_stackzero(const size_t len)
+{
+#ifdef HAVE_C_VARARRAYS
+    unsigned char fodder[len];
+    sodium_memzero(fodder, len);
+#elif HAVE_ALLOCA
+    sodium_memzero(alloca(len), len);
+#endif
+}
+
+#ifdef HAVE_WEAK_SYMBOLS
+__attribute__((weak)) void
+_sodium_dummy_symbol_to_prevent_memcmp_lto(const unsigned char *b1,
+                                           const unsigned char *b2,
+                                           const size_t         len);
+__attribute__((weak)) void
+_sodium_dummy_symbol_to_prevent_memcmp_lto(const unsigned char *b1,
+                                           const unsigned char *b2,
+                                           const size_t         len)
+{
+    (void) b1;
+    (void) b2;
+    (void) len;
+}
+#endif
+
+int
+sodium_memcmp(const void *const b1_, const void *const b2_, size_t len)
+{
+#ifdef HAVE_WEAK_SYMBOLS
+    const unsigned char *b1 = (const unsigned char *) b1_;
+    const unsigned char *b2 = (const unsigned char *) b2_;
+#else
+    const volatile unsigned char *volatile b1 =
+        (const volatile unsigned char *volatile) b1_;
+    const volatile unsigned char *volatile b2 =
+        (const volatile unsigned char *volatile) b2_;
+#endif
+    size_t                 i;
+    volatile unsigned char d = 0U;
+
+#if HAVE_WEAK_SYMBOLS
+    _sodium_dummy_symbol_to_prevent_memcmp_lto(b1, b2, len);
+#endif
+    for (i = 0U; i < len; i++) {
+        d |= b1[i] ^ b2[i];
+    }
+    return (1 & ((d - 1) >> 8)) - 1;
+}
+
+#ifdef HAVE_WEAK_SYMBOLS
+__attribute__((weak)) void
+_sodium_dummy_symbol_to_prevent_compare_lto(const unsigned char *b1,
+                                            const unsigned char *b2,
+                                            const size_t         len);
+__attribute__((weak)) void
+_sodium_dummy_symbol_to_prevent_compare_lto(const unsigned char *b1,
+                                            const unsigned char *b2,
+                                            const size_t         len)
+{
+    (void) b1;
+    (void) b2;
+    (void) len;
+}
+#endif
+
+int
+sodium_compare(const unsigned char *b1_, const unsigned char *b2_, size_t len)
+{
+#ifdef HAVE_WEAK_SYMBOLS
+    const unsigned char *b1 = b1_;
+    const unsigned char *b2 = b2_;
+#else
+    const volatile unsigned char *volatile b1 =
+        (const volatile unsigned char *volatile) b1_;
+    const volatile unsigned char *volatile b2 =
+        (const volatile unsigned char *volatile) b2_;
+#endif
+    size_t                 i;
+    volatile unsigned char gt = 0U;
+    volatile unsigned char eq = 1U;
+    uint16_t               x1, x2;
+
+#if HAVE_WEAK_SYMBOLS
+    _sodium_dummy_symbol_to_prevent_compare_lto(b1, b2, len);
+#endif
+    i = len;
+    while (i != 0U) {
+        i--;
+        x1 = b1[i];
+        x2 = b2[i];
+        gt |= (((unsigned int) x2 - (unsigned int) x1) >> 8) & eq;
+        eq &= (((unsigned int) (x2 ^ x1)) - 1) >> 8;
+    }
+    return (int) (gt + gt + eq) - 1;
+}
+
+int
+sodium_is_zero(const unsigned char *n, const size_t nlen)
+{
+    size_t                 i;
+    volatile unsigned char d = 0U;
+
+    for (i = 0U; i < nlen; i++) {
+        d |= n[i];
+    }
+    return 1 & ((d - 1) >> 8);
+}
+
+int
+_sodium_alloc_init(void)
+{
+#ifdef HAVE_ALIGNED_MALLOC
+# if defined(_SC_PAGESIZE) && defined(HAVE_SYSCONF)
+    long page_size_ = sysconf(_SC_PAGESIZE);
+    if (page_size_ > 0L) {
+        page_size = (size_t) page_size_;
+    }
+# elif defined(WINAPI_DESKTOP)
+    SYSTEM_INFO si;
+    GetSystemInfo(&si);
+    page_size = (size_t) si.dwPageSize;
+# elif !defined(PAGE_SIZE)
+#  warning Unknown page size
+# endif
+    if (page_size < CANARY_SIZE || page_size < sizeof(size_t)) {
+        sodium_misuse(); /* LCOV_EXCL_LINE */
+    }
+#endif
+    // randombytes_buf(canary, CANARY_SIZE);
+
+    return 0;
+}
+
+int
+sodium_mlock(void *const addr, const size_t len)
+{
+    printf("sodium_mlock: %p (%zu)\n", addr, len);
+#if defined(MADV_DONTDUMP) && defined(HAVE_MADVISE)
+    (void) madvise(addr, len, MADV_DONTDUMP);
+#endif
+#ifdef HAVE_MLOCK
+    return mlock(addr, len);
+#elif defined(WINAPI_DESKTOP)
+    return -(VirtualLock(addr, len) == 0);
+#else
+    errno = ENOSYS;
+    return -1;
+#endif
+}
+
+int
+sodium_munlock(void *const addr, const size_t len)
+{
+    printf("sodium_munlock: %p (%zu)\n", addr, len);
+    sodium_memzero(addr, len);
+#if defined(MADV_DODUMP) && defined(HAVE_MADVISE)
+    (void) madvise(addr, len, MADV_DODUMP);
+#endif
+#ifdef HAVE_MLOCK
+    return munlock(addr, len);
+#elif defined(WINAPI_DESKTOP)
+    return -(VirtualUnlock(addr, len) == 0);
+#else
+    errno = ENOSYS;
+    return -1;
+#endif
+}
+
+static int
+_mprotect_noaccess(void *ptr, size_t size)
+{
+#ifdef HAVE_MPROTECT
+    return mprotect(ptr, size, PROT_NONE);
+#elif defined(WINAPI_DESKTOP)
+    DWORD old;
+    return -(VirtualProtect(ptr, size, PAGE_NOACCESS, &old) == 0);
+#else
+    errno = ENOSYS;
+    return -1;
+#endif
+}
+
+static int
+_mprotect_readonly(void *ptr, size_t size)
+{
+#ifdef HAVE_MPROTECT
+    return mprotect(ptr, size, PROT_READ);
+#elif defined(WINAPI_DESKTOP)
+    DWORD old;
+    return -(VirtualProtect(ptr, size, PAGE_READONLY, &old) == 0);
+#else
+    errno = ENOSYS;
+    return -1;
+#endif
+}
+
+static int
+_mprotect_readwrite(void *ptr, size_t size)
+{
+#ifdef HAVE_MPROTECT
+    return mprotect(ptr, size, PROT_READ | PROT_WRITE);
+#elif defined(WINAPI_DESKTOP)
+    DWORD old;
+    return -(VirtualProtect(ptr, size, PAGE_READWRITE, &old) == 0);
+#else
+    errno = ENOSYS;
+    return -1;
+#endif
+}
+
+#ifdef HAVE_ALIGNED_MALLOC
+
+__attribute__((noreturn)) static void
+_out_of_bounds(void)
+{
+# if defined(HAVE_RAISE) && !defined(__wasm__)
+#  ifdef SIGPROT
+    raise(SIGPROT);
+#  elif defined(SIGSEGV)
+    raise(SIGSEGV);
+#  elif defined(SIGKILL)
+    raise(SIGKILL);
+#  endif
+# endif
+    abort(); /* not something we want any higher-level API to catch */
+} /* LCOV_EXCL_LINE */
+
+static inline size_t
+_page_round(const size_t size)
+{
+    const size_t page_mask = page_size - 1U;
+
+    return (size + page_mask) & ~page_mask;
+}
+
+static __attribute__((malloc)) unsigned char *
+_alloc_aligned(const size_t size)
+{
+    void *ptr;
+
+# if defined(MAP_ANON) && defined(HAVE_MMAP)
+    if ((ptr = mmap(NULL, size, PROT_READ | PROT_WRITE,
+                    MAP_ANON | MAP_PRIVATE | MAP_NOCORE, -1, 0)) ==
+        MAP_FAILED) {
+        ptr = NULL; /* LCOV_EXCL_LINE */
+    }               /* LCOV_EXCL_LINE */
+# elif defined(HAVE_POSIX_MEMALIGN)
+    if (posix_memalign(&ptr, page_size, size) != 0) {
+        ptr = NULL; /* LCOV_EXCL_LINE */
+    }               /* LCOV_EXCL_LINE */
+# elif defined(WINAPI_DESKTOP)
+    ptr = VirtualAlloc(NULL, size, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE);
+# else
+#  error Bug
+# endif
+    return (unsigned char *) ptr;
+}
+
+static void
+_free_aligned(unsigned char *const ptr, const size_t size)
+{
+# if defined(MAP_ANON) && defined(HAVE_MMAP)
+    (void) munmap(ptr, size);
+# elif defined(HAVE_POSIX_MEMALIGN)
+    free(ptr);
+# elif defined(WINAPI_DESKTOP)
+    VirtualFree(ptr, 0U, MEM_RELEASE);
+# else
+#  error Bug
+#endif
+}
+
+static unsigned char *
+_unprotected_ptr_from_user_ptr(void *const ptr)
+{
+    uintptr_t      unprotected_ptr_u;
+    unsigned char *canary_ptr;
+    size_t         page_mask;
+
+    canary_ptr = ((unsigned char *) ptr) - sizeof canary;
+    page_mask = page_size - 1U;
+    unprotected_ptr_u = ((uintptr_t) canary_ptr & (uintptr_t) ~page_mask);
+    if (unprotected_ptr_u <= page_size * 2U) {
+        sodium_misuse(); /* LCOV_EXCL_LINE */
+    }
+    return (unsigned char *) unprotected_ptr_u;
+}
+
+#endif /* HAVE_ALIGNED_MALLOC */
+
+#ifndef HAVE_ALIGNED_MALLOC
+static __attribute__((malloc)) void *
+_sodium_malloc(const size_t size)
+{
+    return malloc(size > (size_t) 0U ? size : (size_t) 1U);
+}
+#else
+static __attribute__((malloc)) void *
+_sodium_malloc(const size_t size)
+{
+    void          *user_ptr;
+    unsigned char *base_ptr;
+    unsigned char *canary_ptr;
+    unsigned char *unprotected_ptr;
+    size_t         size_with_canary;
+    size_t         total_size;
+    size_t         unprotected_size;
+
+    if (size >= (size_t) SIZE_MAX - page_size * 4U) {
+        errno = ENOMEM;
+        return NULL;
+    }
+    if (page_size <= sizeof canary || page_size < sizeof unprotected_size) {
+        sodium_misuse(); /* LCOV_EXCL_LINE */
+    }
+    size_with_canary = (sizeof canary) + size;
+    unprotected_size = _page_round(size_with_canary);
+    total_size       = page_size + page_size + unprotected_size + page_size;
+    if ((base_ptr = _alloc_aligned(total_size)) == NULL) {
+        return NULL; /* LCOV_EXCL_LINE */
+    }
+    unprotected_ptr = base_ptr + page_size * 2U;
+    _mprotect_noaccess(base_ptr + page_size, page_size);
+# ifndef HAVE_PAGE_PROTECTION
+    memcpy(unprotected_ptr + unprotected_size, canary, sizeof canary);
+# endif
+    _mprotect_noaccess(unprotected_ptr + unprotected_size, page_size);
+    (void) sodium_mlock(unprotected_ptr, unprotected_size); /* not a hard error in the context of sodium_malloc() */
+    canary_ptr =
+        unprotected_ptr + _page_round(size_with_canary) - size_with_canary;
+    user_ptr = canary_ptr + sizeof canary;
+    memcpy(canary_ptr, canary, sizeof canary);
+    memcpy(base_ptr, &unprotected_size, sizeof unprotected_size);
+    _mprotect_readonly(base_ptr, page_size);
+    assert(_unprotected_ptr_from_user_ptr(user_ptr) == unprotected_ptr);
+
+    return user_ptr;
+}
+#endif /* !HAVE_ALIGNED_MALLOC */
+
+__attribute__((malloc)) void *
+sodium_malloc(const size_t size)
+{
+    void *ptr;
+
+    if ((ptr = _sodium_malloc(size)) == NULL) {
+        return NULL;
+    }
+    memset(ptr, (int) GARBAGE_VALUE, size);
+
+    return ptr;
+}
+
+__attribute__((malloc)) void *
+sodium_allocarray(size_t count, size_t size)
+{
+    if (count > (size_t) 0U && size >= (size_t) SIZE_MAX / count) {
+        errno = ENOMEM;
+        return NULL;
+    }
+    return sodium_malloc(count * size);
+}
+
+#ifndef HAVE_ALIGNED_MALLOC
+void
+sodium_free(void *ptr)
+{
+    free(ptr);
+}
+#else
+void
+sodium_free(void *ptr)
+{
+    unsigned char *base_ptr;
+    unsigned char *canary_ptr;
+    unsigned char *unprotected_ptr;
+    size_t         total_size;
+    size_t         unprotected_size;
+
+    if (ptr == NULL) {
+        return;
+    }
+    canary_ptr      = ((unsigned char *) ptr) - sizeof canary;
+    unprotected_ptr = _unprotected_ptr_from_user_ptr(ptr);
+    base_ptr        = unprotected_ptr - page_size * 2U;
+    memcpy(&unprotected_size, base_ptr, sizeof unprotected_size);
+    total_size = page_size + page_size + unprotected_size + page_size;
+    _mprotect_readwrite(base_ptr, total_size);
+    if (sodium_memcmp(canary_ptr, canary, sizeof canary) != 0) {
+        _out_of_bounds();
+    }
+# ifndef HAVE_PAGE_PROTECTION
+    if (sodium_memcmp(unprotected_ptr + unprotected_size, canary,
+                      sizeof canary) != 0) {
+        _out_of_bounds();
+    }
+# endif
+    (void) sodium_munlock(unprotected_ptr, unprotected_size);
+    _free_aligned(base_ptr, total_size);
+}
+#endif /* HAVE_ALIGNED_MALLOC */
+
+#ifndef HAVE_PAGE_PROTECTION
+static int
+_sodium_mprotect(void *ptr, int (*cb)(void *ptr, size_t size))
+{
+    (void) ptr;
+    (void) cb;
+    errno = ENOSYS;
+    return -1;
+}
+#else
+static int
+_sodium_mprotect(void *ptr, int (*cb)(void *ptr, size_t size))
+{
+    unsigned char *base_ptr;
+    unsigned char *unprotected_ptr;
+    size_t         unprotected_size;
+
+    unprotected_ptr = _unprotected_ptr_from_user_ptr(ptr);
+    base_ptr        = unprotected_ptr - page_size * 2U;
+    memcpy(&unprotected_size, base_ptr, sizeof unprotected_size);
+
+    return cb(unprotected_ptr, unprotected_size);
+}
+#endif
+
+int
+sodium_mprotect_noaccess(void *ptr)
+{
+    return _sodium_mprotect(ptr, _mprotect_noaccess);
+}
+
+int
+sodium_mprotect_readonly(void *ptr)
+{
+    return _sodium_mprotect(ptr, _mprotect_readonly);
+}
+
+int
+sodium_mprotect_readwrite(void *ptr)
+{
+    return _sodium_mprotect(ptr, _mprotect_readwrite);
+}

package.yaml

@@ -104,6 +104,7 @@ library:
   c-sources:
     - cbits/sha512.c
     - cbits/sntrup761.c
+    - cbits/sodium/utils_memory.c
   include-dirs: cbits
   extra-libraries: crypto
 

simplexmq.cabal

@@ -109,6 +109,7 @@ library
       Simplex.Messaging.Crypto
       Simplex.Messaging.Crypto.File
       Simplex.Messaging.Crypto.Lazy
+      Simplex.Messaging.Crypto.Memory
       Simplex.Messaging.Crypto.Ratchet
       Simplex.Messaging.Crypto.SNTRUP761
       Simplex.Messaging.Crypto.SNTRUP761.Bindings
@@ -173,6 +174,7 @@ library
   c-sources:
       cbits/sha512.c
       cbits/sntrup761.c
+      cbits/sodium/utils_memory.c
   extra-libraries:
       crypto
   build-depends:

src/Simplex/Messaging/Agent/Env/SQLite.hs

@@ -39,7 +39,6 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Crypto.Random
-import Data.ByteArray (ScrubbedBytes)
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Map (Map)
@@ -56,6 +55,7 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import Simplex.Messaging.Client
 import Simplex.Messaging.Client.Agent ()
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Memory (LockedBytes)
 import Simplex.Messaging.Crypto.Ratchet (supportedE2EEncryptVRange)
 import Simplex.Messaging.Notifications.Client (defaultNTFClientConfig)
 import Simplex.Messaging.Notifications.Types
@@ -211,7 +211,7 @@ newSMPAgentEnv config store = do
   multicastSubscribers <- newTMVarIO 0
   pure Env {config, store, random, randomServer, ntfSupervisor, xftpAgent, multicastSubscribers}
 
-createAgentStore :: FilePath -> ScrubbedBytes -> Bool -> MigrationConfirmation -> IO (Either MigrationError SQLiteStore)
+createAgentStore :: FilePath -> LockedBytes -> Bool -> MigrationConfirmation -> IO (Either MigrationError SQLiteStore)
 createAgentStore dbFilePath dbKey keepKey = createSQLiteStore dbFilePath dbKey keepKey Migrations.app
 
 data NtfSupervisor = NtfSupervisor

src/Simplex/Messaging/Agent/Store/SQLite.hs

@@ -230,7 +230,6 @@ import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson.TH as J
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first, second)
-import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Base64.URL as U
@@ -243,7 +242,7 @@ import Data.List (foldl', intercalate, sortBy)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
-import Data.Maybe (fromMaybe, isJust, listToMaybe, catMaybes)
+import Data.Maybe (catMaybes, fromMaybe, isJust, listToMaybe)
 import Data.Ord (Down (..))
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -270,6 +269,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations (DownMigration (..), MTRE
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
+import Simplex.Messaging.Crypto.Memory (LockedBytes)
 import Simplex.Messaging.Crypto.Ratchet (RatchetX448, SkippedMsgDiff (..), SkippedMsgKeys)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
@@ -328,7 +328,7 @@ instance StrEncoding MigrationConfirmation where
       "error" -> pure MCError
       _ -> fail "invalid MigrationConfirmation"
 
-createSQLiteStore :: FilePath -> ScrubbedBytes -> Bool -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError SQLiteStore)
+createSQLiteStore :: FilePath -> LockedBytes -> Bool -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError SQLiteStore)
 createSQLiteStore dbFilePath dbKey keepKey migrations confirmMigrations = do
   let dbDir = takeDirectory dbFilePath
   createDirectoryIfMissing True dbDir
@@ -378,7 +378,7 @@ confirmOrExit s = do
   ok <- getLine
   when (map toLower ok /= "y") exitFailure
 
-connectSQLiteStore :: FilePath -> ScrubbedBytes -> Bool -> IO SQLiteStore
+connectSQLiteStore :: FilePath -> LockedBytes -> Bool -> IO SQLiteStore
 connectSQLiteStore dbFilePath key keepKey = do
   dbNew <- not <$> doesFileExist dbFilePath
   dbConn <- dbBusyLoop (connectDB dbFilePath key)
@@ -388,7 +388,7 @@ connectSQLiteStore dbFilePath key keepKey = do
     dbClosed <- newTVar False
     pure SQLiteStore {dbFilePath, dbKey, dbConnection, dbNew, dbClosed}
 
-connectDB :: FilePath -> ScrubbedBytes -> IO DB.Connection
+connectDB :: FilePath -> LockedBytes -> IO DB.Connection
 connectDB path key = do
   db <- DB.open path
   prepare db `onException` DB.close db
@@ -414,11 +414,11 @@ closeSQLiteStore st@SQLiteStore {dbClosed} =
       DB.close conn
       atomically $ writeTVar dbClosed True
 
-openSQLiteStore :: SQLiteStore -> ScrubbedBytes -> Bool -> IO ()
+openSQLiteStore :: SQLiteStore -> LockedBytes -> Bool -> IO ()
 openSQLiteStore st@SQLiteStore {dbClosed} key keepKey =
   ifM (readTVarIO dbClosed) (openSQLiteStore_ st key keepKey) (putStrLn "openSQLiteStore: already opened")
 
-openSQLiteStore_ :: SQLiteStore -> ScrubbedBytes -> Bool -> IO ()
+openSQLiteStore_ :: SQLiteStore -> LockedBytes -> Bool -> IO ()
 openSQLiteStore_ SQLiteStore {dbConnection, dbFilePath, dbKey, dbClosed} key keepKey =
   bracketOnError
     (atomically $ takeTMVar dbConnection)
@@ -439,7 +439,7 @@ reopenSQLiteStore st@SQLiteStore {dbKey, dbClosed} =
         Just key -> openSQLiteStore_ st key True
         Nothing -> fail "reopenSQLiteStore: no key"
 
-keyString :: ScrubbedBytes -> Text
+keyString :: LockedBytes -> Text
 keyString = sqlString . safeDecodeUtf8 . BA.convert
 
 sqlString :: Text -> Text
@@ -2286,17 +2286,18 @@ createRcvFileRedirect db gVar userId redirectFd@FileDescription {chunks = redire
       forM_ (zip [1 ..] replicas) $ \(rno, replica) -> insertRcvFileChunkReplica db rno replica chunkId
   pure dstEntityId
   where
-    dummyDst = FileDescription
-      { party = SFRecipient,
-        size,
-        digest,
-        redirect = Nothing,
-        -- updated later with updateRcvFileRedirect
-        key = C.unsafeSbKey $ B.replicate 32 '#',
-        nonce = C.cbNonce "",
-        chunkSize = FileSize 0,
-        chunks = []
-      }
+    dummyDst =
+      FileDescription
+        { party = SFRecipient,
+          size,
+          digest,
+          redirect = Nothing,
+          -- updated later with updateRcvFileRedirect
+          key = C.unsafeSbKey $ B.replicate 32 '#',
+          nonce = C.cbNonce "",
+          chunkSize = FileSize 0,
+          chunks = []
+        }
 
 insertRcvFile :: DB.Connection -> TVar ChaChaDRG -> UserId -> FileDescription 'FRecipient -> FilePath -> FilePath -> CryptoFile -> Maybe DBRcvFileId -> Maybe RcvFileId -> IO (Either StoreError (RcvFileId, DBRcvFileId))
 insertRcvFile db gVar userId FileDescription {size, digest, key, nonce, chunkSize, redirect} prefixPath tmpPath (CryptoFile savePath cfArgs) redirectId_ redirectEntityId_ = runExceptT $ do
@@ -2365,10 +2366,11 @@ getRcvFile db rcvFileId = runExceptT $ do
         toFile ((rcvFileEntityId, userId, size, digest, key, nonce, chunkSize, prefixPath, tmpPath) :. (savePath, saveKey_, saveNonce_, status, deleted, redirectDbId, redirectEntityId, redirectSize_, redirectDigest_)) =
           let cfArgs = CFArgs <$> saveKey_ <*> saveNonce_
               saveFile = CryptoFile savePath cfArgs
-              redirect = RcvFileRedirect
-                <$> redirectDbId
-                <*> redirectEntityId
-                <*> (RedirectFileInfo <$> redirectSize_ <*> redirectDigest_)
+              redirect =
+                RcvFileRedirect
+                  <$> redirectDbId
+                  <*> redirectEntityId
+                  <*> (RedirectFileInfo <$> redirectSize_ <*> redirectDigest_)
            in RcvFile {rcvFileId, rcvFileEntityId, userId, size, digest, key, nonce, chunkSize, redirect, prefixPath, tmpPath, saveFile, status, deleted, chunks = []}
     getChunks :: RcvFileId -> UserId -> FilePath -> IO [RcvFileChunk]
     getChunks rcvFileEntityId userId fileTmpPath = do

src/Simplex/Messaging/Agent/Store/SQLite/Common.hs

@@ -15,23 +15,23 @@ module Simplex.Messaging.Agent.Store.SQLite.Common
 where
 
 import Control.Concurrent (threadDelay)
-import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
 import Data.Time.Clock (diffUTCTime, getCurrentTime)
 import Database.SQLite.Simple (SQLError)
 import qualified Database.SQLite.Simple as SQL
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
+import Simplex.Messaging.Crypto.Memory (LockedBytes)
 import Simplex.Messaging.Util (diffToMilliseconds)
 import UnliftIO.Exception (bracket)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
-storeKey :: ScrubbedBytes -> Bool -> Maybe ScrubbedBytes
+storeKey :: LockedBytes -> Bool -> Maybe LockedBytes
 storeKey key keepKey = if keepKey || BA.null key then Just key else Nothing
 
 data SQLiteStore = SQLiteStore
   { dbFilePath :: FilePath,
-    dbKey :: TVar (Maybe ScrubbedBytes),
+    dbKey :: TVar (Maybe LockedBytes),
     dbConnection :: TMVar DB.Connection,
     dbClosed :: TVar Bool,
     dbNew :: Bool

src/Simplex/Messaging/Crypto/Memory.hs

@@ -0,0 +1,202 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+-- |
+-- Module      : Data.ByteArray.ScrubbedBytes
+-- License     : BSD-style
+-- Author      : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : Stable
+-- Portability : GHC
+module Simplex.Messaging.Crypto.Memory where
+
+import GHC.Ptr
+import GHC.Word
+#if MIN_VERSION_base(4,15,0)
+import           GHC.Exts (unsafeCoerce#)
+#endif
+import Data.ByteArray (ByteArray (..), ByteArrayAccess (..))
+import Data.Foldable (toList)
+import Data.Memory.PtrMethods
+import Data.Semigroup
+import Data.String (IsString (..))
+import Data.Typeable
+import Foreign.Storable
+import GHC.Base
+import GHC.IO (unsafeDupablePerformIO)
+
+foreign import ccall "sodium_mlock"
+  c_sodium_mlock :: Ptr () -> Int -> IO ()
+
+foreign import ccall "sodium_munlock"
+  c_sodium_munlock :: Ptr () -> Int -> IO ()
+
+-- | LockedBytes is a memory chunk which have the properties of:
+--
+-- * Locked from going into swap on allocation.
+-- * Unlocked and scrubbed scrubbed after its goes out of scope.
+--
+-- * A Show instance that doesn't actually show any content
+--
+-- * A Eq instance that is constant time
+data LockedBytes = LockedBytes (MutableByteArray# RealWorld)
+  deriving (Typeable)
+
+instance Show LockedBytes where
+  show _ = "<locked-bytes>"
+
+instance Eq LockedBytes where
+  (==) = scrubbedBytesEq
+instance Ord LockedBytes where
+  compare = scrubbedBytesCompare
+#if MIN_VERSION_base(4,9,0)
+instance Semigroup LockedBytes where
+    b1 <> b2      = unsafeDupablePerformIO $ scrubbedBytesAppend b1 b2
+    sconcat       = unsafeDupablePerformIO . scrubbedBytesConcat . toList
+#endif
+instance Monoid LockedBytes where
+  mempty = unsafeDupablePerformIO (newLockedBytes 0)
+#if !(MIN_VERSION_base(4,11,0))
+    mappend b1 b2 = unsafeDupablePerformIO $ scrubbedBytesAppend b1 b2
+    mconcat       = unsafeDupablePerformIO . scrubbedBytesConcat
+#endif
+-- instance NFData LockedBytes where
+--     rnf b = b `seq` ()
+
+instance IsString LockedBytes where
+  fromString = scrubbedFromChar8
+
+instance ByteArrayAccess LockedBytes where
+  length = sizeofScrubbedBytes
+  withByteArray = withPtr
+
+instance ByteArray LockedBytes where
+  allocRet = scrubbedBytesAllocRet
+
+newLockedBytes :: Int -> IO LockedBytes
+newLockedBytes (I# sz)
+  | booleanPrim (sz <# 0#) = error "LockedBytes: size must be >= 0"
+  | booleanPrim (sz ==# 0#) = IO $ \s ->
+      case newAlignedPinnedByteArray# 0# 8# s of
+        (# s2, mba #) -> (# s2, LockedBytes mba #)
+  | otherwise = IO $ \s ->
+      case newAlignedPinnedByteArray# sz 8# s of
+        (# s1, mbarr #) ->
+          let !locker = getLocker (byteArrayContents# (unsafeCoerce# mbarr))
+              !scrubber = getScrubber (byteArrayContents# (unsafeCoerce# mbarr))
+              !mba = LockedBytes mbarr
+           in case mkWeak# mbarr () (finalize scrubber mba) (locker s1) of
+                (# s2, _weak #) ->
+                  (# s2, mba #)
+  where
+    getLocker :: Addr# -> State# RealWorld -> State# RealWorld
+    getLocker addr s =
+      let IO lockBytes = c_sodium_mlock (Ptr addr) (I# sz)
+       in case lockBytes s of
+            (# s', _ #) -> s'
+
+    getScrubber :: Addr# -> State# RealWorld -> State# RealWorld
+    getScrubber addr s =
+      let IO scrubBytes = c_sodium_munlock (Ptr addr) (I# sz)
+       in case scrubBytes s of
+            (# s', _ #) -> s'
+
+    finalize :: (State# RealWorld -> State# RealWorld) -> LockedBytes -> State# RealWorld -> (# State# RealWorld, () #)
+    finalize scrubber mba@(LockedBytes _) = \s1 ->
+      case scrubber s1 of
+        s2 -> case touch# mba s2 of
+          s3 -> (# s3, () #)
+
+scrubbedBytesAllocRet :: Int -> (Ptr p -> IO a) -> IO (a, LockedBytes)
+scrubbedBytesAllocRet sz f = do
+  ba <- newLockedBytes sz
+  r <- withPtr ba f
+  return (r, ba)
+
+scrubbedBytesAlloc :: Int -> (Ptr p -> IO ()) -> IO LockedBytes
+scrubbedBytesAlloc sz f = do
+  ba <- newLockedBytes sz
+  withPtr ba f
+  return ba
+
+scrubbedBytesConcat :: [LockedBytes] -> IO LockedBytes
+scrubbedBytesConcat l = scrubbedBytesAlloc retLen (copy l)
+  where
+    retLen = sum $ map sizeofScrubbedBytes l
+
+    copy [] _ = return ()
+    copy (x : xs) dst = do
+      withPtr x $ \src -> memCopy dst src chunkLen
+      copy xs (dst `plusPtr` chunkLen)
+      where
+        chunkLen = sizeofScrubbedBytes x
+
+scrubbedBytesAppend :: LockedBytes -> LockedBytes -> IO LockedBytes
+scrubbedBytesAppend b1 b2 = scrubbedBytesAlloc retLen $ \dst -> do
+  withPtr b1 $ \s1 -> memCopy dst s1 len1
+  withPtr b2 $ \s2 -> memCopy (dst `plusPtr` len1) s2 len2
+  where
+    len1 = sizeofScrubbedBytes b1
+    len2 = sizeofScrubbedBytes b2
+    retLen = len1 + len2
+
+sizeofScrubbedBytes :: LockedBytes -> Int
+sizeofScrubbedBytes (LockedBytes mba) = I# (sizeofMutableByteArray# mba)
+
+withPtr :: LockedBytes -> (Ptr p -> IO a) -> IO a
+withPtr b@(LockedBytes mba) f = do
+  a <- f (Ptr (byteArrayContents# (unsafeCoerce# mba)))
+  touchScrubbedBytes b
+  return a
+
+touchScrubbedBytes :: LockedBytes -> IO ()
+touchScrubbedBytes (LockedBytes mba) = IO $ \s -> case touch# mba s of s' -> (# s', () #)
+
+scrubbedBytesEq :: LockedBytes -> LockedBytes -> Bool
+scrubbedBytesEq a b
+  | l1 /= l2 = False
+  | otherwise = unsafeDupablePerformIO $ withPtr a $ \p1 -> withPtr b $ \p2 -> memConstEqual p1 p2 l1
+  where
+    l1 = sizeofScrubbedBytes a
+    l2 = sizeofScrubbedBytes b
+
+scrubbedBytesCompare :: LockedBytes -> LockedBytes -> Ordering
+scrubbedBytesCompare b1@(LockedBytes m1) b2@(LockedBytes m2) = unsafeDupablePerformIO $ loop 0
+  where
+    !l1 = sizeofScrubbedBytes b1
+    !l2 = sizeofScrubbedBytes b2
+    !len = min l1 l2
+
+    loop !i
+      | i == len =
+          if l1 == l2
+            then pure EQ
+            else
+              if l1 > l2
+                then pure GT
+                else pure LT
+      | otherwise = do
+          e1 <- read8 m1 i
+          e2 <- read8 m2 i
+          if e1 == e2
+            then loop (i + 1)
+            else
+              if e1 < e2
+                then pure LT
+                else pure GT
+
+    read8 m (I# i) = IO $ \s -> case readWord8Array# m i s of
+      (# s2, e #) -> (# s2, W8# e #)
+
+scrubbedFromChar8 :: [Char] -> LockedBytes
+scrubbedFromChar8 l = unsafeDupablePerformIO $ scrubbedBytesAlloc len (fill l)
+  where
+    len = Prelude.length l
+    fill :: [Char] -> Ptr Word8 -> IO ()
+    fill [] _ = return ()
+    fill (x : xs) !p = poke p (fromIntegral $ fromEnum x) >> fill xs (p `plusPtr` 1)
+
+booleanPrim :: Int# -> Bool
+booleanPrim v = tagToEnum# v

src/Simplex/Messaging/Crypto/SNTRUP761.hs

@@ -1,21 +1,20 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
 
 module Simplex.Messaging.Crypto.SNTRUP761 where
 
 import Crypto.Hash (Digest, SHA256, hash)
-import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
 import Data.ByteString (ByteString)
 import Simplex.Messaging.Crypto
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Memory (LockedBytes)
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings
 
 -- Hybrid shared secret for crypto_box is defined as SHA256(DHSecret || KEMSharedKey),
 -- similar to https://datatracker.ietf.org/doc/draft-josefsson-ntruprime-hybrid/
 
-newtype KEMHybridSecret = KEMHybridSecret ScrubbedBytes
+newtype KEMHybridSecret = KEMHybridSecret LockedBytes
 
 -- | NaCl @crypto_box@ decrypt with a shared hybrid DH + KEM secret and 192-bit nonce.
 kcbDecrypt :: KEMHybridSecret -> CbNonce -> ByteString -> Either CryptoError ByteString

src/Simplex/Messaging/Crypto/SNTRUP761/Bindings.hs

@@ -6,12 +6,12 @@ import Control.Concurrent.STM
 import Crypto.Random (ChaChaDRG)
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import Data.Bifunctor (bimap)
-import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
 import Data.ByteString (ByteString)
 import Database.SQLite.Simple.FromField
 import Database.SQLite.Simple.ToField
 import Foreign (nullPtr)
+import Simplex.Messaging.Crypto.Memory (LockedBytes)
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (withDRG)
@@ -21,13 +21,13 @@ import Simplex.Messaging.Encoding.String
 newtype KEMPublicKey = KEMPublicKey ByteString
   deriving (Show)
 
-newtype KEMSecretKey = KEMSecretKey ScrubbedBytes
+newtype KEMSecretKey = KEMSecretKey LockedBytes
   deriving (Show)
 
 newtype KEMCiphertext = KEMCiphertext ByteString
   deriving (Show)
 
-newtype KEMSharedKey = KEMSharedKey ScrubbedBytes
+newtype KEMSharedKey = KEMSharedKey LockedBytes
   deriving (Show)
 
 type KEMKeyPair = (KEMPublicKey, KEMSecretKey)

tests/AgentTests/SQLiteTests.hs

@@ -15,7 +15,6 @@ import Control.Concurrent.Async (concurrently_)
 import Control.Concurrent.STM
 import Control.Exception (SomeException)
 import Control.Monad (replicateM_)
-import Data.ByteArray (ScrubbedBytes)
 import Data.ByteString.Char8 (ByteString)
 import Data.List (isInfixOf)
 import qualified Data.Text as T
@@ -39,6 +38,7 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..))
+import Simplex.Messaging.Crypto.Memory (LockedBytes)
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import Simplex.Messaging.Protocol (SubscriptionMode (..))
 import qualified Simplex.Messaging.Protocol as SMP
@@ -64,7 +64,7 @@ withStore2 = before connect2 . after (removeStore . fst)
 createStore :: IO SQLiteStore
 createStore = createEncryptedStore "" False
 
-createEncryptedStore :: ScrubbedBytes -> Bool -> IO SQLiteStore
+createEncryptedStore :: LockedBytes -> Bool -> IO SQLiteStore
 createEncryptedStore key keepKey = do
   -- Randomize DB file name to avoid SQLite IO errors supposedly caused by asynchronous
   -- IO operations on multiple similarly named files; error seems to be environment specific