From 9e8676b0a49da0be558cc6a705802e725aad62e7 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Tue, 2 Jun 2026 13:26:41 +0000 Subject: [PATCH 01/15] crypto: BBS scheme for anonymous credentials with multiple presentations --- .gitmodules | 6 + cbits/blst | 1 + cbits/libbbs | 1 + plans/2026-06-01-bbs-bindings.md | 127 ++++++++++++++++ simplexmq.cabal | 14 ++ src/Simplex/Messaging/Crypto/BBS.hs | 217 ++++++++++++++++++++++++++++ tests/CoreTests/CryptoTests.hs | 92 ++++++++++++ 7 files changed, 458 insertions(+) create mode 100644 .gitmodules create mode 160000 cbits/blst create mode 160000 cbits/libbbs create mode 100644 plans/2026-06-01-bbs-bindings.md create mode 100644 src/Simplex/Messaging/Crypto/BBS.hs diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000000..6254df7cf4 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,6 @@ +[submodule "cbits/libbbs"] + path = cbits/libbbs + url = https://github.com/Fraunhofer-AISEC/libbbs.git +[submodule "cbits/blst"] + path = cbits/blst + url = https://github.com/supranational/blst.git diff --git a/cbits/blst b/cbits/blst new file mode 160000 index 0000000000..db3defd0d5 --- /dev/null +++ b/cbits/blst @@ -0,0 +1 @@ +Subproject commit db3defd0d501cc2bb1cdd59cb955d1a421821441 diff --git a/cbits/libbbs b/cbits/libbbs new file mode 160000 index 0000000000..7fcc6ccf31 --- /dev/null +++ b/cbits/libbbs @@ -0,0 +1 @@ +Subproject commit 7fcc6ccf31009c9e59ede2dc8ec35acb456e4176 diff --git a/plans/2026-06-01-bbs-bindings.md b/plans/2026-06-01-bbs-bindings.md new file mode 100644 index 0000000000..1ebff46406 --- /dev/null +++ b/plans/2026-06-01-bbs-bindings.md @@ -0,0 +1,127 @@ +# BBS+ Bindings for simplexmq + +Haskell FFI bindings to libbbs for BBS+ signatures. General-purpose - the module knows nothing about specific applications. + +## How BBS+ works + +BBS+ signs a fixed list of N messages. Each message is an arbitrary byte array. The signer signs all N messages at once with one signature. + +The holder of the signature can then generate a proof that selectively discloses some messages and hides others. The verifier learns the disclosed messages and confirms they were signed by the signer, but learns nothing about the hidden messages. Different proofs from the same signature are unlinkable. + +Key constraint: the total number of messages N is fixed at signing time. The verifier must know N. A proof generated from a 3-message signature cannot be verified as a 2-message proof. + +## Types + +```haskell +newtype BBSSecretKey = BBSSecretKey ByteString -- 32 bytes +newtype BBSPublicKey = BBSPublicKey ByteString -- 96 bytes (BLS12-381 G2 point) +newtype BBSSignature = BBSSignature ByteString -- 80 bytes +newtype BBSProof = BBSProof ByteString -- 272 + 32 * numUndisclosed bytes +newtype BBSHeader = BBSHeader ByteString -- always-disclosed context (e.g. protocol identifier) +newtype BBSPresHeader = BBSPresHeader ByteString -- random nonce for proof unlinkability +``` + +All newtypes get StrEncoding (base64url), ToJSON/FromJSON (via strToJSON/strParseJSON), Eq, Show. + +## Functions + +```haskell +bbsKeyGen :: IO (BBSSecretKey, BBSPublicKey) + +-- C order: sk, pk, header, messages +bbsSign + :: BBSSecretKey + -> BBSPublicKey + -> BBSHeader -- always-disclosed context + -> [ByteString] -- all N messages + -> IO (Either String BBSSignature) + +-- C order: pk, signature, header, presentation_header, disclosed_indexes, messages +bbsProofGen + :: BBSPublicKey + -> BBSSignature + -> BBSHeader -- must match what was signed + -> BBSPresHeader -- random nonce bound into the proof + -> [Int] -- disclosed indexes (0-based) + -> [ByteString] -- all N messages (needed internally, hidden ones not revealed in proof) + -> IO (Either String BBSProof) + +-- C order: pk, proof, header, presentation_header, disclosed_indexes, n, messages +bbsProofVerify + :: BBSPublicKey + -> BBSProof + -> BBSHeader -- must match what was signed + -> BBSPresHeader -- must match what was used in bbsProofGen + -> [Int] -- disclosed indexes + -> Int -- total message count N + -> [ByteString] -- disclosed messages only + -> IO Bool +``` + +## How applications use it + +An application defines: +- A message layout: which index means what +- Which indexes are disclosed vs hidden +- How to encode application values as ByteString messages + +### Badge example (in simplex-chat, not in this module) + +Message layout (always 3 messages): +- Index 0: master secret (32 random bytes) - HIDDEN +- Index 1: expiry (UTF-8 encoded timestamp string) - DISCLOSED +- Index 2: badge type (UTF-8 encoded, e.g. "supporter") - DISCLOSED + +Signing (v2, on the server): +``` +bbsSign sk pk header [ms, encodeUtf8 "2026-07-31", encodeUtf8 "supporter"] +``` + +Proof generation (v2, on the client): +``` +bbsProofGen pk sig header presHeader [1, 2] [ms, encodeUtf8 "2026-07-31", encodeUtf8 "supporter"] +``` + +Proof verification (v1, on the recipient): +``` +bbsProofVerify pk proof header presHeader 3 [1, 2] [encodeUtf8 "2026-07-31", encodeUtf8 "supporter"] +``` + +The recipient only sees the proof, presentationHeader, expiry string, and badge type string. They verify these were signed by the server (pk is hardcoded). They never see the master secret. + +Expiry is always present as a string. Monthly badges use a date like `"2026-07-31"`, lifetime badges use `"lifetime"`. BBS+ doesn't interpret the bytes - expiry semantics are the application's responsibility. This keeps the message count fixed at 3 for all badge types. + +## libbbs C API mapping + +```c +int bbs_keygen_full(ciphersuite, sk, pk) +int bbs_sign(ciphersuite, sk, pk, signature, header, header_len, n, messages, message_lens) +int bbs_proof_gen(ciphersuite, pk, signature, proof, header, header_len, presentation_header, presentation_header_len, disclosed_indexes, disclosed_indexes_len, n, messages, message_lens) +int bbs_proof_verify(ciphersuite, pk, proof, proof_len, header, header_len, presentation_header, presentation_header_len, disclosed_indexes, disclosed_indexes_len, n, messages, message_lens) +``` + +We use `bbs_sha256_ciphersuite`. The header parameter is exposed in all Haskell functions - the application decides what to put there. Tests use `"SimpleX"` as header. + +The `presentation_header` parameter is what we call `presentationHeader`. + +In `bbs_proof_verify`, the `n` parameter is the total number of messages (not the number of disclosed messages). The `messages` array contains only the disclosed messages, and `disclosed_indexes` maps each to its position in the original message list. + +## Build + +Submodules in cbits/: +- `cbits/libbbs` - https://github.com/Fraunhofer-AISEC/libbbs +- `cbits/blst` - https://github.com/supranational/blst (libbbs dependency) + +C sources in cabal: `cbits/blst/src/server.c`, `cbits/blst/build/assembly.S`, libbbs source files. +Include dirs: `cbits/blst/bindings/`, `cbits/blst/src/`, `cbits/libbbs/include/`, `cbits/libbbs/src/`. +C flags: `-D__BLST_PORTABLE__` for cross-CPU-generation compatibility. + +## Tests + +- Keygen produces keys of correct size +- Sign + proofGen + proofVerify roundtrip succeeds +- Tampered proof fails verification +- Tampered disclosed message fails verification +- Wrong public key fails verification +- Two proofs from same credential with different nonces both verify +- Proof size matches expected (272 + 32 * numUndisclosed) diff --git a/simplexmq.cabal b/simplexmq.cabal index 5fd0cdf8e0..6c11aaee85 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -122,6 +122,7 @@ library Simplex.Messaging.Crypto.File Simplex.Messaging.Crypto.Lazy Simplex.Messaging.Crypto.Ratchet + Simplex.Messaging.Crypto.BBS Simplex.Messaging.Crypto.SNTRUP761 Simplex.Messaging.Crypto.SNTRUP761.Bindings Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines @@ -298,9 +299,22 @@ library ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-home-modules -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 include-dirs: cbits + cbits/blst/bindings + cbits/blst/src + cbits/libbbs/include + cbits/libbbs/src + cc-options: -D__BLST_PORTABLE__ c-sources: cbits/sha512.c cbits/sntrup761.c + cbits/blst/src/server.c + cbits/blst/build/assembly.S + cbits/libbbs/src/bbs.c + cbits/libbbs/src/bbs_ciphersuites.c + cbits/libbbs/src/bbs_util.c + cbits/libbbs/src/compat-string.c + cbits/libbbs/src/sha256.c + cbits/libbbs/src/shake256.c extra-libraries: crypto build-depends: diff --git a/src/Simplex/Messaging/Crypto/BBS.hs b/src/Simplex/Messaging/Crypto/BBS.hs new file mode 100644 index 0000000000..e892a804b8 --- /dev/null +++ b/src/Simplex/Messaging/Crypto/BBS.hs @@ -0,0 +1,217 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Simplex.Messaging.Crypto.BBS + ( BBSSecretKey (..), + BBSPublicKey (..), + BBSSignature (..), + BBSProof (..), + BBSHeader (..), + BBSPresHeader (..), + bbsKeyGen, + bbsSign, + bbsProofGen, + bbsProofVerify, + ) where + +import Data.Aeson (FromJSON (..), ToJSON (..)) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Internal as BI +import Foreign +import Foreign.C +import Simplex.Messaging.Encoding.String + +newtype BBSSecretKey = BBSSecretKey ByteString + deriving newtype (Eq, Show, StrEncoding) + +instance ToJSON BBSSecretKey where + toJSON = strToJSON + toEncoding = strToJEncoding + +instance FromJSON BBSSecretKey where + parseJSON = strParseJSON "BBSSecretKey" + +newtype BBSPublicKey = BBSPublicKey ByteString + deriving newtype (Eq, Show, StrEncoding) + deriving (ToJSON, FromJSON) via BBSSecretKey + +newtype BBSSignature = BBSSignature ByteString + deriving newtype (Eq, Show, StrEncoding) + deriving (ToJSON, FromJSON) via BBSSecretKey + +newtype BBSProof = BBSProof ByteString + deriving newtype (Eq, Show, StrEncoding) + deriving (ToJSON, FromJSON) via BBSSecretKey + +newtype BBSHeader = BBSHeader ByteString + deriving newtype (Eq, Show, StrEncoding) + deriving (ToJSON, FromJSON) via BBSSecretKey + +newtype BBSPresHeader = BBSPresHeader ByteString + deriving newtype (Eq, Show, StrEncoding) + deriving (ToJSON, FromJSON) via BBSSecretKey + +-- Constants + +bbsSkLen, bbsPkLen, bbsSigLen, bbsProofBaseLen, bbsProofUdElemLen :: Int +bbsSkLen = 32 +bbsPkLen = 96 +bbsSigLen = 80 +bbsProofBaseLen = 272 +bbsProofUdElemLen = 32 + +bbsProofLen :: Int -> Int +bbsProofLen numUndisclosed = bbsProofBaseLen + numUndisclosed * bbsProofUdElemLen + +-- FFI + +data BBS_Ciphersuite + +foreign import ccall "bbs_keygen_full" + c_bbs_keygen_full :: Ptr BBS_Ciphersuite -> Ptr Word8 -> Ptr Word8 -> IO CInt + +foreign import ccall "bbs_sign" + c_bbs_sign :: + Ptr BBS_Ciphersuite -> + Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> + Ptr Word8 -> CSize -> + CSize -> Ptr (Ptr Word8) -> Ptr CSize -> + IO CInt + +foreign import ccall "bbs_proof_gen" + c_bbs_proof_gen :: + Ptr BBS_Ciphersuite -> + Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> + Ptr Word8 -> CSize -> + Ptr Word8 -> CSize -> + Ptr CSize -> CSize -> + CSize -> Ptr (Ptr Word8) -> Ptr CSize -> + IO CInt + +foreign import ccall "bbs_proof_verify" + c_bbs_proof_verify :: + Ptr BBS_Ciphersuite -> + Ptr Word8 -> + Ptr Word8 -> CSize -> + Ptr Word8 -> CSize -> + Ptr Word8 -> CSize -> + Ptr CSize -> CSize -> + CSize -> Ptr (Ptr Word8) -> Ptr CSize -> + IO CInt + +foreign import ccall "&bbs_sha256_ciphersuite" + c_bbs_sha256_ciphersuite :: Ptr (Ptr BBS_Ciphersuite) + +getCiphersuite :: IO (Ptr BBS_Ciphersuite) +getCiphersuite = peek c_bbs_sha256_ciphersuite + +-- Helpers + +withBS :: ByteString -> (Ptr Word8 -> CSize -> IO a) -> IO a +withBS bs f = let (fptr, off, len) = BI.toForeignPtr bs + in withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off) (fromIntegral len) + +withMessages :: [ByteString] -> (Ptr (Ptr Word8) -> Ptr CSize -> CSize -> IO a) -> IO a +withMessages msgs f = do + let n = length msgs + allocaArray n $ \msgsPtr -> + allocaArray n $ \lensPtr -> do + pokeMessages msgs msgsPtr lensPtr 0 + f msgsPtr lensPtr (fromIntegral n) + where + pokeMessages [] _ _ _ = pure () + pokeMessages (m : ms) msgsPtr lensPtr i = do + let (fptr, off, len) = BI.toForeignPtr m + withForeignPtr fptr $ \ptr -> do + pokeElemOff msgsPtr i (ptr `plusPtr` off) + pokeElemOff lensPtr i (fromIntegral len) + pokeMessages ms msgsPtr lensPtr (i + 1) + +withIndexes :: [Int] -> (Ptr CSize -> CSize -> IO a) -> IO a +withIndexes idxs f = do + let n = length idxs + allocaArray n $ \ptr -> do + pokeArray ptr (map fromIntegral idxs) + f ptr (fromIntegral n) + +-- Public API + +bbsKeyGen :: IO (BBSSecretKey, BBSPublicKey) +bbsKeyGen = do + cs <- getCiphersuite + sk <- BI.create bbsSkLen $ \_ -> pure () + pk <- BI.create bbsPkLen $ \_ -> pure () + withBS sk $ \skPtr _ -> + withBS pk $ \pkPtr _ -> do + rc <- c_bbs_keygen_full cs skPtr pkPtr + if rc == 0 + then pure (BBSSecretKey sk, BBSPublicKey pk) + else error "bbsKeyGen failed" + +bbsSign :: + BBSSecretKey -> + BBSPublicKey -> + BBSHeader -> + [ByteString] -> + IO (Either String BBSSignature) +bbsSign (BBSSecretKey sk) (BBSPublicKey pk) (BBSHeader header) msgs = do + cs <- getCiphersuite + sig <- BI.create bbsSigLen $ \_ -> pure () + withBS sk $ \skPtr _ -> + withBS pk $ \pkPtr _ -> + withBS header $ \hdrPtr hdrLen -> + withBS sig $ \sigPtr _ -> + withMessages msgs $ \msgsPtr lensPtr n -> do + rc <- c_bbs_sign cs skPtr pkPtr sigPtr hdrPtr hdrLen n msgsPtr lensPtr + pure $ if rc == 0 + then Right (BBSSignature sig) + else Left "bbsSign failed" + +bbsProofGen :: + BBSPublicKey -> + BBSSignature -> + BBSHeader -> + BBSPresHeader -> + [Int] -> + [ByteString] -> + IO (Either String BBSProof) +bbsProofGen (BBSPublicKey pk) (BBSSignature sig) (BBSHeader header) (BBSPresHeader ph) disclosedIdxs msgs = do + cs <- getCiphersuite + let numUndisclosed = length msgs - length disclosedIdxs + proofSz = bbsProofLen numUndisclosed + proof <- BI.create proofSz $ \_ -> pure () + withBS pk $ \pkPtr _ -> + withBS sig $ \sigPtr _ -> + withBS proof $ \proofPtr _ -> + withBS header $ \hdrPtr hdrLen -> + withBS ph $ \phPtr phLen -> + withIndexes disclosedIdxs $ \idxsPtr idxsLen -> + withMessages msgs $ \msgsPtr lensPtr n -> do + rc <- c_bbs_proof_gen cs pkPtr sigPtr proofPtr hdrPtr hdrLen phPtr phLen idxsPtr idxsLen n msgsPtr lensPtr + pure $ if rc == 0 + then Right (BBSProof proof) + else Left "bbsProofGen failed" + +bbsProofVerify :: + BBSPublicKey -> + BBSProof -> + BBSHeader -> + BBSPresHeader -> + [Int] -> + Int -> + [ByteString] -> + IO Bool +bbsProofVerify (BBSPublicKey pk) (BBSProof proof) (BBSHeader header) (BBSPresHeader ph) disclosedIdxs numMessages disclosedMsgs = do + cs <- getCiphersuite + withBS pk $ \pkPtr _ -> + withBS proof $ \proofPtr proofLen -> + withBS header $ \hdrPtr hdrLen -> + withBS ph $ \phPtr phLen -> + withIndexes disclosedIdxs $ \idxsPtr idxsLen -> + withMessages disclosedMsgs $ \msgsPtr lensPtr _ -> do + rc <- c_bbs_proof_verify cs pkPtr proofPtr proofLen hdrPtr hdrLen phPtr phLen idxsPtr idxsLen (fromIntegral numMessages) msgsPtr lensPtr + pure (rc == 0) + diff --git a/tests/CoreTests/CryptoTests.hs b/tests/CoreTests/CryptoTests.hs index 8e4d9a2582..a66d59c51f 100644 --- a/tests/CoreTests/CryptoTests.hs +++ b/tests/CoreTests/CryptoTests.hs @@ -22,6 +22,7 @@ import qualified Data.X509.Validation as XV import qualified SMPClient import qualified Simplex.Messaging.Crypto as C import qualified Simplex.Messaging.Crypto.Lazy as LC +import Simplex.Messaging.Crypto.BBS import Simplex.Messaging.Crypto.SNTRUP761.Bindings import Simplex.Messaging.Transport.Client import Test.Hspec hiding (fit, it) @@ -101,6 +102,14 @@ cryptoTests = do it "should validate certificates" testValidateX509 describe "sntrup761" $ it "should enc/dec key" testSNTRUP761 + describe "BBS+" $ do + it "should sign and verify" testBBSSignVerify + it "should generate and verify proof" testBBSProofRoundtrip + it "should reject tampered proof" testBBSTamperedProof + it "should reject wrong disclosed message" testBBSWrongMessage + it "should reject wrong public key" testBBSWrongKey + it "should produce unlinkable proofs" testBBSUnlinkable + it "should produce proof of expected size" testBBSProofSize instance Eq C.APublicKey where C.APublicKey a k == C.APublicKey a' k' = case testEquality a a' of @@ -271,3 +280,86 @@ testSNTRUP761 = do (c, KEMSharedKey k) <- sntrup761Enc drg pk KEMSharedKey k' <- sntrup761Dec c sk k' `shouldBe` k + +-- BBS+ tests + +bbsHeader :: BBSHeader +bbsHeader = BBSHeader "SimpleX" + +bbsMessages :: [B.ByteString] +bbsMessages = ["secret_master_key", "2026-07-31", "supporter"] + +bbsDisclosedIdxs :: [Int] +bbsDisclosedIdxs = [1, 2] + +bbsDisclosedMsgs :: [B.ByteString] +bbsDisclosedMsgs = ["2026-07-31", "supporter"] + +testBBSSignVerify :: IO () +testBBSSignVerify = do + (sk, pk) <- bbsKeyGen + Right sig <- bbsSign sk pk bbsHeader bbsMessages + let BBSSecretKey skBs = sk + BBSPublicKey pkBs = pk + BBSSignature sigBs = sig + B.length skBs `shouldBe` 32 + B.length pkBs `shouldBe` 96 + B.length sigBs `shouldBe` 80 + +testBBSProofRoundtrip :: IO () +testBBSProofRoundtrip = do + (sk, pk) <- bbsKeyGen + Right sig <- bbsSign sk pk bbsHeader bbsMessages + let ph = BBSPresHeader "test-nonce-1" + Right proof <- bbsProofGen pk sig bbsHeader ph bbsDisclosedIdxs bbsMessages + result <- bbsProofVerify pk proof bbsHeader ph bbsDisclosedIdxs 3 bbsDisclosedMsgs + result `shouldBe` True + +testBBSTamperedProof :: IO () +testBBSTamperedProof = do + (sk, pk) <- bbsKeyGen + Right sig <- bbsSign sk pk bbsHeader bbsMessages + let ph = BBSPresHeader "test-nonce-2" + Right (BBSProof proofBs) <- bbsProofGen pk sig bbsHeader ph bbsDisclosedIdxs bbsMessages + let tampered = BBSProof $ B.take 10 proofBs <> "\xff" <> B.drop 11 proofBs + result <- bbsProofVerify pk tampered bbsHeader ph bbsDisclosedIdxs 3 bbsDisclosedMsgs + result `shouldBe` False + +testBBSWrongMessage :: IO () +testBBSWrongMessage = do + (sk, pk) <- bbsKeyGen + Right sig <- bbsSign sk pk bbsHeader bbsMessages + let ph = BBSPresHeader "test-nonce-3" + Right proof <- bbsProofGen pk sig bbsHeader ph bbsDisclosedIdxs bbsMessages + result <- bbsProofVerify pk proof bbsHeader ph bbsDisclosedIdxs 3 ["2026-07-31", "business"] + result `shouldBe` False + +testBBSWrongKey :: IO () +testBBSWrongKey = do + (sk, pk) <- bbsKeyGen + (_, pk2) <- bbsKeyGen + Right sig <- bbsSign sk pk bbsHeader bbsMessages + let ph = BBSPresHeader "test-nonce-4" + Right proof <- bbsProofGen pk sig bbsHeader ph bbsDisclosedIdxs bbsMessages + result <- bbsProofVerify pk2 proof bbsHeader ph bbsDisclosedIdxs 3 bbsDisclosedMsgs + result `shouldBe` False + +testBBSUnlinkable :: IO () +testBBSUnlinkable = do + (sk, pk) <- bbsKeyGen + Right sig <- bbsSign sk pk bbsHeader bbsMessages + let ph1 = BBSPresHeader "nonce-contact-1" + ph2 = BBSPresHeader "nonce-contact-2" + Right (BBSProof proof1) <- bbsProofGen pk sig bbsHeader ph1 bbsDisclosedIdxs bbsMessages + Right (BBSProof proof2) <- bbsProofGen pk sig bbsHeader ph2 bbsDisclosedIdxs bbsMessages + proof1 `shouldNotBe` proof2 + bbsProofVerify pk (BBSProof proof1) bbsHeader ph1 bbsDisclosedIdxs 3 bbsDisclosedMsgs >>= (`shouldBe` True) + bbsProofVerify pk (BBSProof proof2) bbsHeader ph2 bbsDisclosedIdxs 3 bbsDisclosedMsgs >>= (`shouldBe` True) + +testBBSProofSize :: IO () +testBBSProofSize = do + (sk, pk) <- bbsKeyGen + Right sig <- bbsSign sk pk bbsHeader bbsMessages + let ph = BBSPresHeader "test-nonce-size" + Right (BBSProof proofBs) <- bbsProofGen pk sig bbsHeader ph bbsDisclosedIdxs bbsMessages + B.length proofBs `shouldBe` 304 -- 272 + 32 * 1 undisclosed From 73b2036d4229ad7a403708b992189dc45b22cfa6 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Tue, 2 Jun 2026 13:55:25 +0000 Subject: [PATCH 02/15] verify --- src/Simplex/Messaging/Crypto/BBS.hs | 76 +++++++++++++++++++---------- tests/CoreTests/CryptoTests.hs | 6 ++- 2 files changed, 55 insertions(+), 27 deletions(-) diff --git a/src/Simplex/Messaging/Crypto/BBS.hs b/src/Simplex/Messaging/Crypto/BBS.hs index e892a804b8..c81bb02f73 100644 --- a/src/Simplex/Messaging/Crypto/BBS.hs +++ b/src/Simplex/Messaging/Crypto/BBS.hs @@ -12,6 +12,7 @@ module Simplex.Messaging.Crypto.BBS BBSPresHeader (..), bbsKeyGen, bbsSign, + bbsVerify, bbsProofGen, bbsProofVerify, ) where @@ -81,6 +82,14 @@ foreign import ccall "bbs_sign" CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO CInt +foreign import ccall "bbs_verify" + c_bbs_verify :: + Ptr BBS_Ciphersuite -> + Ptr Word8 -> Ptr Word8 -> + Ptr Word8 -> CSize -> + CSize -> Ptr (Ptr Word8) -> Ptr CSize -> + IO CInt + foreign import ccall "bbs_proof_gen" c_bbs_proof_gen :: Ptr BBS_Ciphersuite -> @@ -111,8 +120,12 @@ getCiphersuite = peek c_bbs_sha256_ciphersuite -- Helpers withBS :: ByteString -> (Ptr Word8 -> CSize -> IO a) -> IO a -withBS bs f = let (fptr, off, len) = BI.toForeignPtr bs - in withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off) (fromIntegral len) +withBS bs f = + let (fptr, off, len) = BI.toForeignPtr bs + in withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off) (fromIntegral len) + +packPtr :: Ptr Word8 -> Int -> IO ByteString +packPtr ptr len = B.packCStringLen (castPtr ptr, len) withMessages :: [ByteString] -> (Ptr (Ptr Word8) -> Ptr CSize -> CSize -> IO a) -> IO a withMessages msgs f = do @@ -142,14 +155,15 @@ withIndexes idxs f = do bbsKeyGen :: IO (BBSSecretKey, BBSPublicKey) bbsKeyGen = do cs <- getCiphersuite - sk <- BI.create bbsSkLen $ \_ -> pure () - pk <- BI.create bbsPkLen $ \_ -> pure () - withBS sk $ \skPtr _ -> - withBS pk $ \pkPtr _ -> do + allocaBytes bbsSkLen $ \skPtr -> + allocaBytes bbsPkLen $ \pkPtr -> do rc <- c_bbs_keygen_full cs skPtr pkPtr - if rc == 0 - then pure (BBSSecretKey sk, BBSPublicKey pk) - else error "bbsKeyGen failed" + if rc /= 0 + then error "bbsKeyGen failed" + else do + sk <- packPtr skPtr bbsSkLen + pk <- packPtr pkPtr bbsPkLen + pure (BBSSecretKey sk, BBSPublicKey pk) bbsSign :: BBSSecretKey -> @@ -159,16 +173,30 @@ bbsSign :: IO (Either String BBSSignature) bbsSign (BBSSecretKey sk) (BBSPublicKey pk) (BBSHeader header) msgs = do cs <- getCiphersuite - sig <- BI.create bbsSigLen $ \_ -> pure () - withBS sk $ \skPtr _ -> - withBS pk $ \pkPtr _ -> - withBS header $ \hdrPtr hdrLen -> - withBS sig $ \sigPtr _ -> + allocaBytes bbsSigLen $ \sigPtr -> + withBS sk $ \skPtr _ -> + withBS pk $ \pkPtr _ -> + withBS header $ \hdrPtr hdrLen -> withMessages msgs $ \msgsPtr lensPtr n -> do rc <- c_bbs_sign cs skPtr pkPtr sigPtr hdrPtr hdrLen n msgsPtr lensPtr - pure $ if rc == 0 - then Right (BBSSignature sig) - else Left "bbsSign failed" + if rc /= 0 + then pure $ Left "bbsSign failed" + else Right . BBSSignature <$> packPtr sigPtr bbsSigLen + +bbsVerify :: + BBSPublicKey -> + BBSSignature -> + BBSHeader -> + [ByteString] -> + IO Bool +bbsVerify (BBSPublicKey pk) (BBSSignature sig) (BBSHeader header) msgs = do + cs <- getCiphersuite + withBS pk $ \pkPtr _ -> + withBS sig $ \sigPtr _ -> + withBS header $ \hdrPtr hdrLen -> + withMessages msgs $ \msgsPtr lensPtr n -> do + rc <- c_bbs_verify cs pkPtr sigPtr hdrPtr hdrLen n msgsPtr lensPtr + pure (rc == 0) bbsProofGen :: BBSPublicKey -> @@ -182,18 +210,17 @@ bbsProofGen (BBSPublicKey pk) (BBSSignature sig) (BBSHeader header) (BBSPresHead cs <- getCiphersuite let numUndisclosed = length msgs - length disclosedIdxs proofSz = bbsProofLen numUndisclosed - proof <- BI.create proofSz $ \_ -> pure () - withBS pk $ \pkPtr _ -> - withBS sig $ \sigPtr _ -> - withBS proof $ \proofPtr _ -> + allocaBytes proofSz $ \proofPtr -> + withBS pk $ \pkPtr _ -> + withBS sig $ \sigPtr _ -> withBS header $ \hdrPtr hdrLen -> withBS ph $ \phPtr phLen -> withIndexes disclosedIdxs $ \idxsPtr idxsLen -> withMessages msgs $ \msgsPtr lensPtr n -> do rc <- c_bbs_proof_gen cs pkPtr sigPtr proofPtr hdrPtr hdrLen phPtr phLen idxsPtr idxsLen n msgsPtr lensPtr - pure $ if rc == 0 - then Right (BBSProof proof) - else Left "bbsProofGen failed" + if rc /= 0 + then pure $ Left "bbsProofGen failed" + else Right . BBSProof <$> packPtr proofPtr proofSz bbsProofVerify :: BBSPublicKey -> @@ -214,4 +241,3 @@ bbsProofVerify (BBSPublicKey pk) (BBSProof proof) (BBSHeader header) (BBSPresHea withMessages disclosedMsgs $ \msgsPtr lensPtr _ -> do rc <- c_bbs_proof_verify cs pkPtr proofPtr proofLen hdrPtr hdrLen phPtr phLen idxsPtr idxsLen (fromIntegral numMessages) msgsPtr lensPtr pure (rc == 0) - diff --git a/tests/CoreTests/CryptoTests.hs b/tests/CoreTests/CryptoTests.hs index a66d59c51f..9f77267907 100644 --- a/tests/CoreTests/CryptoTests.hs +++ b/tests/CoreTests/CryptoTests.hs @@ -298,13 +298,15 @@ bbsDisclosedMsgs = ["2026-07-31", "supporter"] testBBSSignVerify :: IO () testBBSSignVerify = do (sk, pk) <- bbsKeyGen - Right sig <- bbsSign sk pk bbsHeader bbsMessages let BBSSecretKey skBs = sk BBSPublicKey pkBs = pk - BBSSignature sigBs = sig B.length skBs `shouldBe` 32 B.length pkBs `shouldBe` 96 + Right sig <- bbsSign sk pk bbsHeader bbsMessages + let BBSSignature sigBs = sig B.length sigBs `shouldBe` 80 + bbsVerify pk sig bbsHeader bbsMessages >>= (`shouldBe` True) + bbsVerify pk sig bbsHeader ["wrong", "2026-07-31", "supporter"] >>= (`shouldBe` False) testBBSProofRoundtrip :: IO () testBBSProofRoundtrip = do From aedcfa723ca272669bbeaa1d1a43cc7bf7af762a Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Thu, 4 Jun 2026 19:36:35 +0000 Subject: [PATCH 03/15] add files to sources --- simplexmq.cabal | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/simplexmq.cabal b/simplexmq.cabal index 6c11aaee85..20f2b8435d 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -24,6 +24,13 @@ extra-source-files: CHANGELOG.md cbits/sha512.h cbits/sntrup761.h + cbits/blst/src/*.c + cbits/blst/src/*.h + cbits/blst/bindings/blst.h + cbits/blst/bindings/blst_aux.h + cbits/blst/build/assembly.S + cbits/libbbs/include/*.h + cbits/libbbs/src/*.h apps/common/Web/static/index.html apps/common/Web/static/link.html apps/common/Web/static/media/apk_icon.png From abba4256821ad95c3b725eac7c1fe221777a8c02 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Thu, 4 Jun 2026 19:50:45 +0000 Subject: [PATCH 04/15] more files --- simplexmq.cabal | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/simplexmq.cabal b/simplexmq.cabal index 20f2b8435d..313bbd0b73 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -29,6 +29,14 @@ extra-source-files: cbits/blst/bindings/blst.h cbits/blst/bindings/blst_aux.h cbits/blst/build/assembly.S + cbits/blst/build/elf/*.s + cbits/blst/build/elf/*.S + cbits/blst/build/coff/*.s + cbits/blst/build/coff/*.S + cbits/blst/build/mach-o/*.s + cbits/blst/build/mach-o/*.S + cbits/blst/build/cheri/*.S + cbits/blst/build/win64/*.asm cbits/libbbs/include/*.h cbits/libbbs/src/*.h apps/common/Web/static/index.html From 6a2a8647ae57badf225ac1406925d8b25cb7d0b8 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Thu, 4 Jun 2026 19:55:10 +0000 Subject: [PATCH 05/15] more files, use cabal 3.0 --- simplexmq.cabal | 24 ++++++------------------ 1 file changed, 6 insertions(+), 18 deletions(-) diff --git a/simplexmq.cabal b/simplexmq.cabal index 313bbd0b73..909a1d85be 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -1,4 +1,4 @@ -cabal-version: 1.12 +cabal-version: 3.0 name: simplexmq version: 6.5.2.0 @@ -16,7 +16,7 @@ homepage: https://github.com/simplex-chat/simplexmq#readme author: simplex.chat maintainer: chat@simplex.chat copyright: 2020-2022 simplex.chat -license: AGPL-3 +license: AGPL-3.0-only license-file: LICENSE build-type: Simple extra-source-files: @@ -24,21 +24,8 @@ extra-source-files: CHANGELOG.md cbits/sha512.h cbits/sntrup761.h - cbits/blst/src/*.c - cbits/blst/src/*.h - cbits/blst/bindings/blst.h - cbits/blst/bindings/blst_aux.h - cbits/blst/build/assembly.S - cbits/blst/build/elf/*.s - cbits/blst/build/elf/*.S - cbits/blst/build/coff/*.s - cbits/blst/build/coff/*.S - cbits/blst/build/mach-o/*.s - cbits/blst/build/mach-o/*.S - cbits/blst/build/cheri/*.S - cbits/blst/build/win64/*.asm - cbits/libbbs/include/*.h - cbits/libbbs/src/*.h + cbits/blst/** + cbits/libbbs/** apps/common/Web/static/index.html apps/common/Web/static/link.html apps/common/Web/static/media/apk_icon.png @@ -323,13 +310,14 @@ library cbits/sha512.c cbits/sntrup761.c cbits/blst/src/server.c - cbits/blst/build/assembly.S cbits/libbbs/src/bbs.c cbits/libbbs/src/bbs_ciphersuites.c cbits/libbbs/src/bbs_util.c cbits/libbbs/src/compat-string.c cbits/libbbs/src/sha256.c cbits/libbbs/src/shake256.c + asm-sources: + cbits/blst/build/assembly.S extra-libraries: crypto build-depends: From 59b382fb43fcb182a02b5d4692ad9a1d439aaa4a Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Thu, 4 Jun 2026 19:56:42 +0000 Subject: [PATCH 06/15] fix path --- simplexmq.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/simplexmq.cabal b/simplexmq.cabal index 909a1d85be..3de44cd966 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -24,8 +24,8 @@ extra-source-files: CHANGELOG.md cbits/sha512.h cbits/sntrup761.h - cbits/blst/** - cbits/libbbs/** + cbits/blst/**/* + cbits/libbbs/**/* apps/common/Web/static/index.html apps/common/Web/static/link.html apps/common/Web/static/media/apk_icon.png From 6e9f5a468b899ecca3ac6edf095248954e368149 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Thu, 4 Jun 2026 20:01:27 +0000 Subject: [PATCH 07/15] extensions --- simplexmq.cabal | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/simplexmq.cabal b/simplexmq.cabal index 3de44cd966..c5c82cd14f 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -24,8 +24,13 @@ extra-source-files: CHANGELOG.md cbits/sha512.h cbits/sntrup761.h - cbits/blst/**/* - cbits/libbbs/**/* + cbits/blst/**/*.c + cbits/blst/**/*.h + cbits/blst/**/*.s + cbits/blst/**/*.S + cbits/blst/**/*.asm + cbits/libbbs/**/*.c + cbits/libbbs/**/*.h apps/common/Web/static/index.html apps/common/Web/static/link.html apps/common/Web/static/media/apk_icon.png From 8418781fc7db2b9956b4df9a24461de5a9b41262 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Fri, 5 Jun 2026 21:11:12 +0000 Subject: [PATCH 08/15] switch libbbs to fork --- .gitmodules | 2 +- cbits/libbbs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 6254df7cf4..ced9d3a2af 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +1,6 @@ [submodule "cbits/libbbs"] path = cbits/libbbs - url = https://github.com/Fraunhofer-AISEC/libbbs.git + url = https://github.com/simplex-chat/libbbs.git [submodule "cbits/blst"] path = cbits/blst url = https://github.com/supranational/blst.git diff --git a/cbits/libbbs b/cbits/libbbs index 7fcc6ccf31..ac7f5c711a 160000 --- a/cbits/libbbs +++ b/cbits/libbbs @@ -1 +1 @@ -Subproject commit 7fcc6ccf31009c9e59ede2dc8ec35acb456e4176 +Subproject commit ac7f5c711a2a2ab08a0d36260c795f94e1501e41 From fffa088113ab840088393892bbaef9aa8eb0e851 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sat, 6 Jun 2026 11:26:13 +0000 Subject: [PATCH 09/15] return either from keygen --- src/Simplex/Messaging/Crypto/BBS.hs | 6 +++--- tests/CoreTests/CryptoTests.hs | 16 ++++++++-------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/Simplex/Messaging/Crypto/BBS.hs b/src/Simplex/Messaging/Crypto/BBS.hs index c81bb02f73..095c605434 100644 --- a/src/Simplex/Messaging/Crypto/BBS.hs +++ b/src/Simplex/Messaging/Crypto/BBS.hs @@ -152,18 +152,18 @@ withIndexes idxs f = do -- Public API -bbsKeyGen :: IO (BBSSecretKey, BBSPublicKey) +bbsKeyGen :: IO (Either String (BBSSecretKey, BBSPublicKey)) bbsKeyGen = do cs <- getCiphersuite allocaBytes bbsSkLen $ \skPtr -> allocaBytes bbsPkLen $ \pkPtr -> do rc <- c_bbs_keygen_full cs skPtr pkPtr if rc /= 0 - then error "bbsKeyGen failed" + then pure $ Left "bbsKeyGen failed" else do sk <- packPtr skPtr bbsSkLen pk <- packPtr pkPtr bbsPkLen - pure (BBSSecretKey sk, BBSPublicKey pk) + pure $ Right (BBSSecretKey sk, BBSPublicKey pk) bbsSign :: BBSSecretKey -> diff --git a/tests/CoreTests/CryptoTests.hs b/tests/CoreTests/CryptoTests.hs index 9f77267907..8d67c6a4cf 100644 --- a/tests/CoreTests/CryptoTests.hs +++ b/tests/CoreTests/CryptoTests.hs @@ -297,7 +297,7 @@ bbsDisclosedMsgs = ["2026-07-31", "supporter"] testBBSSignVerify :: IO () testBBSSignVerify = do - (sk, pk) <- bbsKeyGen + Right (sk, pk) <- bbsKeyGen let BBSSecretKey skBs = sk BBSPublicKey pkBs = pk B.length skBs `shouldBe` 32 @@ -310,7 +310,7 @@ testBBSSignVerify = do testBBSProofRoundtrip :: IO () testBBSProofRoundtrip = do - (sk, pk) <- bbsKeyGen + Right (sk, pk) <- bbsKeyGen Right sig <- bbsSign sk pk bbsHeader bbsMessages let ph = BBSPresHeader "test-nonce-1" Right proof <- bbsProofGen pk sig bbsHeader ph bbsDisclosedIdxs bbsMessages @@ -319,7 +319,7 @@ testBBSProofRoundtrip = do testBBSTamperedProof :: IO () testBBSTamperedProof = do - (sk, pk) <- bbsKeyGen + Right (sk, pk) <- bbsKeyGen Right sig <- bbsSign sk pk bbsHeader bbsMessages let ph = BBSPresHeader "test-nonce-2" Right (BBSProof proofBs) <- bbsProofGen pk sig bbsHeader ph bbsDisclosedIdxs bbsMessages @@ -329,7 +329,7 @@ testBBSTamperedProof = do testBBSWrongMessage :: IO () testBBSWrongMessage = do - (sk, pk) <- bbsKeyGen + Right (sk, pk) <- bbsKeyGen Right sig <- bbsSign sk pk bbsHeader bbsMessages let ph = BBSPresHeader "test-nonce-3" Right proof <- bbsProofGen pk sig bbsHeader ph bbsDisclosedIdxs bbsMessages @@ -338,8 +338,8 @@ testBBSWrongMessage = do testBBSWrongKey :: IO () testBBSWrongKey = do - (sk, pk) <- bbsKeyGen - (_, pk2) <- bbsKeyGen + Right (sk, pk) <- bbsKeyGen + Right (_, pk2) <- bbsKeyGen Right sig <- bbsSign sk pk bbsHeader bbsMessages let ph = BBSPresHeader "test-nonce-4" Right proof <- bbsProofGen pk sig bbsHeader ph bbsDisclosedIdxs bbsMessages @@ -348,7 +348,7 @@ testBBSWrongKey = do testBBSUnlinkable :: IO () testBBSUnlinkable = do - (sk, pk) <- bbsKeyGen + Right (sk, pk) <- bbsKeyGen Right sig <- bbsSign sk pk bbsHeader bbsMessages let ph1 = BBSPresHeader "nonce-contact-1" ph2 = BBSPresHeader "nonce-contact-2" @@ -360,7 +360,7 @@ testBBSUnlinkable = do testBBSProofSize :: IO () testBBSProofSize = do - (sk, pk) <- bbsKeyGen + Right (sk, pk) <- bbsKeyGen Right sig <- bbsSign sk pk bbsHeader bbsMessages let ph = BBSPresHeader "test-nonce-size" Right (BBSProof proofBs) <- bbsProofGen pk sig bbsHeader ph bbsDisclosedIdxs bbsMessages From 0475af88b43f3161cc17807776239145f09e48dc Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sat, 13 Jun 2026 07:41:02 +0000 Subject: [PATCH 10/15] use only secret key to sign --- src/Simplex/Messaging/Crypto/BBS.hs | 47 ++++++++++++++++++++--------- tests/CoreTests/CryptoTests.hs | 37 ++++++++++++++--------- 2 files changed, 55 insertions(+), 29 deletions(-) diff --git a/src/Simplex/Messaging/Crypto/BBS.hs b/src/Simplex/Messaging/Crypto/BBS.hs index 095c605434..65c9664032 100644 --- a/src/Simplex/Messaging/Crypto/BBS.hs +++ b/src/Simplex/Messaging/Crypto/BBS.hs @@ -6,11 +6,13 @@ module Simplex.Messaging.Crypto.BBS ( BBSSecretKey (..), BBSPublicKey (..), + BBSKeyPair, BBSSignature (..), BBSProof (..), BBSHeader (..), BBSPresHeader (..), bbsKeyGen, + bbsPublicKey, bbsSign, bbsVerify, bbsProofGen, @@ -39,6 +41,8 @@ newtype BBSPublicKey = BBSPublicKey ByteString deriving newtype (Eq, Show, StrEncoding) deriving (ToJSON, FromJSON) via BBSSecretKey +type BBSKeyPair = (BBSPublicKey, BBSSecretKey) + newtype BBSSignature = BBSSignature ByteString deriving newtype (Eq, Show, StrEncoding) deriving (ToJSON, FromJSON) via BBSSecretKey @@ -74,6 +78,9 @@ data BBS_Ciphersuite foreign import ccall "bbs_keygen_full" c_bbs_keygen_full :: Ptr BBS_Ciphersuite -> Ptr Word8 -> Ptr Word8 -> IO CInt +foreign import ccall "bbs_sk_to_pk" + c_bbs_sk_to_pk :: Ptr BBS_Ciphersuite -> Ptr Word8 -> Ptr Word8 -> IO CInt + foreign import ccall "bbs_sign" c_bbs_sign :: Ptr BBS_Ciphersuite -> @@ -152,7 +159,7 @@ withIndexes idxs f = do -- Public API -bbsKeyGen :: IO (Either String (BBSSecretKey, BBSPublicKey)) +bbsKeyGen :: IO (Either String BBSKeyPair) bbsKeyGen = do cs <- getCiphersuite allocaBytes bbsSkLen $ \skPtr -> @@ -163,25 +170,37 @@ bbsKeyGen = do else do sk <- packPtr skPtr bbsSkLen pk <- packPtr pkPtr bbsPkLen - pure $ Right (BBSSecretKey sk, BBSPublicKey pk) + pure $ Right (BBSPublicKey pk, BBSSecretKey sk) + +bbsPublicKey :: BBSSecretKey -> IO (Either String BBSPublicKey) +bbsPublicKey (BBSSecretKey sk) = do + cs <- getCiphersuite + allocaBytes bbsPkLen $ \pkPtr -> + withBS sk $ \skPtr _ -> do + rc <- c_bbs_sk_to_pk cs skPtr pkPtr + if rc /= 0 + then pure $ Left "bbsPublicKey failed" + else Right . BBSPublicKey <$> packPtr pkPtr bbsPkLen bbsSign :: BBSSecretKey -> - BBSPublicKey -> BBSHeader -> [ByteString] -> IO (Either String BBSSignature) -bbsSign (BBSSecretKey sk) (BBSPublicKey pk) (BBSHeader header) msgs = do - cs <- getCiphersuite - allocaBytes bbsSigLen $ \sigPtr -> - withBS sk $ \skPtr _ -> - withBS pk $ \pkPtr _ -> - withBS header $ \hdrPtr hdrLen -> - withMessages msgs $ \msgsPtr lensPtr n -> do - rc <- c_bbs_sign cs skPtr pkPtr sigPtr hdrPtr hdrLen n msgsPtr lensPtr - if rc /= 0 - then pure $ Left "bbsSign failed" - else Right . BBSSignature <$> packPtr sigPtr bbsSigLen +bbsSign secret@(BBSSecretKey sk) (BBSHeader header) msgs = + bbsPublicKey secret >>= either (pure . Left) sign' + where + sign' (BBSPublicKey pk) = do + cs <- getCiphersuite + allocaBytes bbsSigLen $ \sigPtr -> + withBS sk $ \skPtr _ -> + withBS pk $ \pkPtr _ -> + withBS header $ \hdrPtr hdrLen -> + withMessages msgs $ \msgsPtr lensPtr n -> do + rc <- c_bbs_sign cs skPtr pkPtr sigPtr hdrPtr hdrLen n msgsPtr lensPtr + if rc /= 0 + then pure $ Left "bbsSign failed" + else Right . BBSSignature <$> packPtr sigPtr bbsSigLen bbsVerify :: BBSPublicKey -> diff --git a/tests/CoreTests/CryptoTests.hs b/tests/CoreTests/CryptoTests.hs index 8d67c6a4cf..94a576d332 100644 --- a/tests/CoreTests/CryptoTests.hs +++ b/tests/CoreTests/CryptoTests.hs @@ -104,6 +104,7 @@ cryptoTests = do it "should enc/dec key" testSNTRUP761 describe "BBS+" $ do it "should sign and verify" testBBSSignVerify + it "should derive public key from secret key" testBBSPublicKeyDerivation it "should generate and verify proof" testBBSProofRoundtrip it "should reject tampered proof" testBBSTamperedProof it "should reject wrong disclosed message" testBBSWrongMessage @@ -297,21 +298,27 @@ bbsDisclosedMsgs = ["2026-07-31", "supporter"] testBBSSignVerify :: IO () testBBSSignVerify = do - Right (sk, pk) <- bbsKeyGen + Right (pk, sk) <- bbsKeyGen let BBSSecretKey skBs = sk BBSPublicKey pkBs = pk B.length skBs `shouldBe` 32 B.length pkBs `shouldBe` 96 - Right sig <- bbsSign sk pk bbsHeader bbsMessages + Right sig <- bbsSign sk bbsHeader bbsMessages let BBSSignature sigBs = sig B.length sigBs `shouldBe` 80 bbsVerify pk sig bbsHeader bbsMessages >>= (`shouldBe` True) bbsVerify pk sig bbsHeader ["wrong", "2026-07-31", "supporter"] >>= (`shouldBe` False) +testBBSPublicKeyDerivation :: IO () +testBBSPublicKeyDerivation = do + Right (pk, sk) <- bbsKeyGen + -- the public key derived from the secret key matches the one keygen returned + bbsPublicKey sk >>= (`shouldBe` Right pk) + testBBSProofRoundtrip :: IO () testBBSProofRoundtrip = do - Right (sk, pk) <- bbsKeyGen - Right sig <- bbsSign sk pk bbsHeader bbsMessages + Right (pk, sk) <- bbsKeyGen + Right sig <- bbsSign sk bbsHeader bbsMessages let ph = BBSPresHeader "test-nonce-1" Right proof <- bbsProofGen pk sig bbsHeader ph bbsDisclosedIdxs bbsMessages result <- bbsProofVerify pk proof bbsHeader ph bbsDisclosedIdxs 3 bbsDisclosedMsgs @@ -319,8 +326,8 @@ testBBSProofRoundtrip = do testBBSTamperedProof :: IO () testBBSTamperedProof = do - Right (sk, pk) <- bbsKeyGen - Right sig <- bbsSign sk pk bbsHeader bbsMessages + Right (pk, sk) <- bbsKeyGen + Right sig <- bbsSign sk bbsHeader bbsMessages let ph = BBSPresHeader "test-nonce-2" Right (BBSProof proofBs) <- bbsProofGen pk sig bbsHeader ph bbsDisclosedIdxs bbsMessages let tampered = BBSProof $ B.take 10 proofBs <> "\xff" <> B.drop 11 proofBs @@ -329,8 +336,8 @@ testBBSTamperedProof = do testBBSWrongMessage :: IO () testBBSWrongMessage = do - Right (sk, pk) <- bbsKeyGen - Right sig <- bbsSign sk pk bbsHeader bbsMessages + Right (pk, sk) <- bbsKeyGen + Right sig <- bbsSign sk bbsHeader bbsMessages let ph = BBSPresHeader "test-nonce-3" Right proof <- bbsProofGen pk sig bbsHeader ph bbsDisclosedIdxs bbsMessages result <- bbsProofVerify pk proof bbsHeader ph bbsDisclosedIdxs 3 ["2026-07-31", "business"] @@ -338,9 +345,9 @@ testBBSWrongMessage = do testBBSWrongKey :: IO () testBBSWrongKey = do - Right (sk, pk) <- bbsKeyGen - Right (_, pk2) <- bbsKeyGen - Right sig <- bbsSign sk pk bbsHeader bbsMessages + Right (pk, sk) <- bbsKeyGen + Right (pk2, _) <- bbsKeyGen + Right sig <- bbsSign sk bbsHeader bbsMessages let ph = BBSPresHeader "test-nonce-4" Right proof <- bbsProofGen pk sig bbsHeader ph bbsDisclosedIdxs bbsMessages result <- bbsProofVerify pk2 proof bbsHeader ph bbsDisclosedIdxs 3 bbsDisclosedMsgs @@ -348,8 +355,8 @@ testBBSWrongKey = do testBBSUnlinkable :: IO () testBBSUnlinkable = do - Right (sk, pk) <- bbsKeyGen - Right sig <- bbsSign sk pk bbsHeader bbsMessages + Right (pk, sk) <- bbsKeyGen + Right sig <- bbsSign sk bbsHeader bbsMessages let ph1 = BBSPresHeader "nonce-contact-1" ph2 = BBSPresHeader "nonce-contact-2" Right (BBSProof proof1) <- bbsProofGen pk sig bbsHeader ph1 bbsDisclosedIdxs bbsMessages @@ -360,8 +367,8 @@ testBBSUnlinkable = do testBBSProofSize :: IO () testBBSProofSize = do - Right (sk, pk) <- bbsKeyGen - Right sig <- bbsSign sk pk bbsHeader bbsMessages + Right (pk, sk) <- bbsKeyGen + Right sig <- bbsSign sk bbsHeader bbsMessages let ph = BBSPresHeader "test-nonce-size" Right (BBSProof proofBs) <- bbsProofGen pk sig bbsHeader ph bbsDisclosedIdxs bbsMessages B.length proofBs `shouldBe` 304 -- 272 + 32 * 1 undisclosed From 0d2c4242123b42812bb43bb444aa84babce8eb2d Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sat, 13 Jun 2026 13:36:49 +0000 Subject: [PATCH 11/15] improve FFI --- src/Simplex/Messaging/Crypto/BBS.hs | 148 +++++++++++++---------- src/Simplex/Messaging/Encoding/String.hs | 22 ++++ 2 files changed, 109 insertions(+), 61 deletions(-) diff --git a/src/Simplex/Messaging/Crypto/BBS.hs b/src/Simplex/Messaging/Crypto/BBS.hs index 65c9664032..c6f4f47a3a 100644 --- a/src/Simplex/Messaging/Crypto/BBS.hs +++ b/src/Simplex/Messaging/Crypto/BBS.hs @@ -1,8 +1,14 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +-- | FFI bindings to libbbs (BBS+ signatures over BLS12-381, SHA-256 suite). +-- Values parsed from untrusted input are length-validated; see FixedBS and the +-- BBSProof StrEncoding instance. module Simplex.Messaging.Crypto.BBS ( BBSSecretKey (..), BBSPublicKey (..), @@ -19,45 +25,64 @@ module Simplex.Messaging.Crypto.BBS bbsProofVerify, ) where -import Data.Aeson (FromJSON (..), ToJSON (..)) +import Data.Aeson (FromJSON, ToJSON) import Data.ByteString (ByteString) import qualified Data.ByteString as B -import qualified Data.ByteString.Internal as BI +import qualified Data.ByteString.Unsafe as BU +import Data.Proxy (Proxy (..)) import Foreign import Foreign.C +import GHC.TypeLits (KnownNat, KnownSymbol, Nat, Symbol, natVal, symbolVal) import Simplex.Messaging.Encoding.String +import System.IO.Unsafe (unsafePerformIO) -newtype BBSSecretKey = BBSSecretKey ByteString - deriving newtype (Eq, Show, StrEncoding) - -instance ToJSON BBSSecretKey where - toJSON = strToJSON - toEncoding = strToJEncoding +-- Note: the data constructors below are unchecked escape hatches for trusted, +-- internally-produced values (e.g. keygen output). Any value parsed from +-- untrusted input (StrEncoding / FromJSON) is length-validated — see FixedBS +-- and the BBSProof StrEncoding instance. -instance FromJSON BBSSecretKey where - parseJSON = strParseJSON "BBSSecretKey" +newtype BBSSecretKey = BBSSecretKey ByteString + deriving newtype (Eq, Show) + deriving (StrEncoding) via (FixedBS "BBSSecretKey" 32) + deriving (ToJSON, FromJSON) via (StrJSON "BBSSecretKey" BBSSecretKey) newtype BBSPublicKey = BBSPublicKey ByteString - deriving newtype (Eq, Show, StrEncoding) - deriving (ToJSON, FromJSON) via BBSSecretKey + deriving newtype (Eq, Show) + deriving (StrEncoding) via (FixedBS "BBSPublicKey" 96) + deriving (ToJSON, FromJSON) via (StrJSON "BBSPublicKey" BBSPublicKey) type BBSKeyPair = (BBSPublicKey, BBSSecretKey) newtype BBSSignature = BBSSignature ByteString - deriving newtype (Eq, Show, StrEncoding) - deriving (ToJSON, FromJSON) via BBSSecretKey + deriving newtype (Eq, Show) + deriving (StrEncoding) via (FixedBS "BBSSignature" 80) + deriving (ToJSON, FromJSON) via (StrJSON "BBSSignature" BBSSignature) newtype BBSProof = BBSProof ByteString - deriving newtype (Eq, Show, StrEncoding) - deriving (ToJSON, FromJSON) via BBSSecretKey + deriving newtype (Eq, Show) + deriving (ToJSON, FromJSON) via (StrJSON "BBSProof" BBSProof) newtype BBSHeader = BBSHeader ByteString deriving newtype (Eq, Show, StrEncoding) - deriving (ToJSON, FromJSON) via BBSSecretKey + deriving (ToJSON, FromJSON) via (StrJSON "BBSHeader" BBSHeader) newtype BBSPresHeader = BBSPresHeader ByteString deriving newtype (Eq, Show, StrEncoding) - deriving (ToJSON, FromJSON) via BBSSecretKey + deriving (ToJSON, FromJSON) via (StrJSON "BBSPresHeader" BBSPresHeader) + +-- | A ByteString validated to be exactly @n@ bytes when parsed via StrEncoding +-- (and the JSON derived from it). Local to BBS, where every key/signature is a +-- fixed size; @name@ appears in the decode error only. +newtype FixedBS (name :: Symbol) (n :: Nat) = FixedBS ByteString + +instance forall name n. (KnownSymbol name, KnownNat n) => StrEncoding (FixedBS name n) where + strEncode (FixedBS bs) = strEncode bs + strP = do + bs <- base64urlP + let n = fromIntegral (natVal (Proxy :: Proxy n)) + if B.length bs == n + then pure (FixedBS bs) + else fail $ symbolVal (Proxy :: Proxy name) <> ": expected " <> show n <> " bytes, got " <> show (B.length bs) -- Constants @@ -71,6 +96,16 @@ bbsProofUdElemLen = 32 bbsProofLen :: Int -> Int bbsProofLen numUndisclosed = bbsProofBaseLen + numUndisclosed * bbsProofUdElemLen +-- | A proof is @bbsProofBaseLen + 32 * numUndisclosed@ bytes; reject anything else. +instance StrEncoding BBSProof where + strEncode (BBSProof bs) = strEncode bs + strP = do + bs <- base64urlP + let len = B.length bs + if len >= bbsProofBaseLen && (len - bbsProofBaseLen) `mod` bbsProofUdElemLen == 0 + then pure (BBSProof bs) + else fail $ "BBS: invalid proof length " <> show len + -- FFI data BBS_Ciphersuite @@ -121,50 +156,45 @@ foreign import ccall "bbs_proof_verify" foreign import ccall "&bbs_sha256_ciphersuite" c_bbs_sha256_ciphersuite :: Ptr (Ptr BBS_Ciphersuite) -getCiphersuite :: IO (Ptr BBS_Ciphersuite) -getCiphersuite = peek c_bbs_sha256_ciphersuite +-- The ciphersuite is a static const pointer in libbbs; read it once. +ciphersuite :: Ptr BBS_Ciphersuite +ciphersuite = unsafePerformIO $ peek c_bbs_sha256_ciphersuite +{-# NOINLINE ciphersuite #-} -- Helpers withBS :: ByteString -> (Ptr Word8 -> CSize -> IO a) -> IO a -withBS bs f = - let (fptr, off, len) = BI.toForeignPtr bs - in withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off) (fromIntegral len) +withBS bs f = BU.unsafeUseAsCStringLen bs $ \(p, l) -> f (castPtr p) (fromIntegral l) packPtr :: Ptr Word8 -> Int -> IO ByteString packPtr ptr len = B.packCStringLen (castPtr ptr, len) +-- Marshals a list of messages into parallel pointer/length arrays. Each +-- ByteString is held alive (via nested unsafeUseAsCStringLen) until @f@ returns, +-- so the C callee never sees a pointer to freed memory. withMessages :: [ByteString] -> (Ptr (Ptr Word8) -> Ptr CSize -> CSize -> IO a) -> IO a -withMessages msgs f = do - let n = length msgs - allocaArray n $ \msgsPtr -> - allocaArray n $ \lensPtr -> do - pokeMessages msgs msgsPtr lensPtr 0 - f msgsPtr lensPtr (fromIntegral n) +withMessages msgs f = go msgs [] where - pokeMessages [] _ _ _ = pure () - pokeMessages (m : ms) msgsPtr lensPtr i = do - let (fptr, off, len) = BI.toForeignPtr m - withForeignPtr fptr $ \ptr -> do - pokeElemOff msgsPtr i (ptr `plusPtr` off) - pokeElemOff lensPtr i (fromIntegral len) - pokeMessages ms msgsPtr lensPtr (i + 1) + go [] acc = + let cstrs = reverse acc + in withArray (map fst cstrs) $ \msgsPtr -> + withArray (map snd cstrs) $ \lensPtr -> + f msgsPtr lensPtr (fromIntegral $ length cstrs) + go (m : ms) acc = + BU.unsafeUseAsCStringLen m $ \(p, l) -> + go ms ((castPtr p :: Ptr Word8, fromIntegral l :: CSize) : acc) withIndexes :: [Int] -> (Ptr CSize -> CSize -> IO a) -> IO a -withIndexes idxs f = do - let n = length idxs - allocaArray n $ \ptr -> do - pokeArray ptr (map fromIntegral idxs) - f ptr (fromIntegral n) +withIndexes idxs f = + withArrayLen (map fromIntegral idxs :: [CSize]) $ \n ptr -> f ptr (fromIntegral n) -- Public API bbsKeyGen :: IO (Either String BBSKeyPair) -bbsKeyGen = do - cs <- getCiphersuite +bbsKeyGen = allocaBytes bbsSkLen $ \skPtr -> allocaBytes bbsPkLen $ \pkPtr -> do - rc <- c_bbs_keygen_full cs skPtr pkPtr + rc <- c_bbs_keygen_full ciphersuite skPtr pkPtr if rc /= 0 then pure $ Left "bbsKeyGen failed" else do @@ -173,11 +203,10 @@ bbsKeyGen = do pure $ Right (BBSPublicKey pk, BBSSecretKey sk) bbsPublicKey :: BBSSecretKey -> IO (Either String BBSPublicKey) -bbsPublicKey (BBSSecretKey sk) = do - cs <- getCiphersuite +bbsPublicKey (BBSSecretKey sk) = allocaBytes bbsPkLen $ \pkPtr -> withBS sk $ \skPtr _ -> do - rc <- c_bbs_sk_to_pk cs skPtr pkPtr + rc <- c_bbs_sk_to_pk ciphersuite skPtr pkPtr if rc /= 0 then pure $ Left "bbsPublicKey failed" else Right . BBSPublicKey <$> packPtr pkPtr bbsPkLen @@ -190,14 +219,13 @@ bbsSign :: bbsSign secret@(BBSSecretKey sk) (BBSHeader header) msgs = bbsPublicKey secret >>= either (pure . Left) sign' where - sign' (BBSPublicKey pk) = do - cs <- getCiphersuite + sign' (BBSPublicKey pk) = allocaBytes bbsSigLen $ \sigPtr -> withBS sk $ \skPtr _ -> withBS pk $ \pkPtr _ -> withBS header $ \hdrPtr hdrLen -> withMessages msgs $ \msgsPtr lensPtr n -> do - rc <- c_bbs_sign cs skPtr pkPtr sigPtr hdrPtr hdrLen n msgsPtr lensPtr + rc <- c_bbs_sign ciphersuite skPtr pkPtr sigPtr hdrPtr hdrLen n msgsPtr lensPtr if rc /= 0 then pure $ Left "bbsSign failed" else Right . BBSSignature <$> packPtr sigPtr bbsSigLen @@ -208,13 +236,12 @@ bbsVerify :: BBSHeader -> [ByteString] -> IO Bool -bbsVerify (BBSPublicKey pk) (BBSSignature sig) (BBSHeader header) msgs = do - cs <- getCiphersuite +bbsVerify (BBSPublicKey pk) (BBSSignature sig) (BBSHeader header) msgs = withBS pk $ \pkPtr _ -> withBS sig $ \sigPtr _ -> withBS header $ \hdrPtr hdrLen -> withMessages msgs $ \msgsPtr lensPtr n -> do - rc <- c_bbs_verify cs pkPtr sigPtr hdrPtr hdrLen n msgsPtr lensPtr + rc <- c_bbs_verify ciphersuite pkPtr sigPtr hdrPtr hdrLen n msgsPtr lensPtr pure (rc == 0) bbsProofGen :: @@ -225,10 +252,7 @@ bbsProofGen :: [Int] -> [ByteString] -> IO (Either String BBSProof) -bbsProofGen (BBSPublicKey pk) (BBSSignature sig) (BBSHeader header) (BBSPresHeader ph) disclosedIdxs msgs = do - cs <- getCiphersuite - let numUndisclosed = length msgs - length disclosedIdxs - proofSz = bbsProofLen numUndisclosed +bbsProofGen (BBSPublicKey pk) (BBSSignature sig) (BBSHeader header) (BBSPresHeader ph) disclosedIdxs msgs = allocaBytes proofSz $ \proofPtr -> withBS pk $ \pkPtr _ -> withBS sig $ \sigPtr _ -> @@ -236,10 +260,13 @@ bbsProofGen (BBSPublicKey pk) (BBSSignature sig) (BBSHeader header) (BBSPresHead withBS ph $ \phPtr phLen -> withIndexes disclosedIdxs $ \idxsPtr idxsLen -> withMessages msgs $ \msgsPtr lensPtr n -> do - rc <- c_bbs_proof_gen cs pkPtr sigPtr proofPtr hdrPtr hdrLen phPtr phLen idxsPtr idxsLen n msgsPtr lensPtr + rc <- c_bbs_proof_gen ciphersuite pkPtr sigPtr proofPtr hdrPtr hdrLen phPtr phLen idxsPtr idxsLen n msgsPtr lensPtr if rc /= 0 then pure $ Left "bbsProofGen failed" else Right . BBSProof <$> packPtr proofPtr proofSz + where + numUndisclosed = length msgs - length disclosedIdxs + proofSz = bbsProofLen numUndisclosed bbsProofVerify :: BBSPublicKey -> @@ -250,13 +277,12 @@ bbsProofVerify :: Int -> [ByteString] -> IO Bool -bbsProofVerify (BBSPublicKey pk) (BBSProof proof) (BBSHeader header) (BBSPresHeader ph) disclosedIdxs numMessages disclosedMsgs = do - cs <- getCiphersuite +bbsProofVerify (BBSPublicKey pk) (BBSProof proof) (BBSHeader header) (BBSPresHeader ph) disclosedIdxs numMessages disclosedMsgs = withBS pk $ \pkPtr _ -> withBS proof $ \proofPtr proofLen -> withBS header $ \hdrPtr hdrLen -> withBS ph $ \phPtr phLen -> withIndexes disclosedIdxs $ \idxsPtr idxsLen -> withMessages disclosedMsgs $ \msgsPtr lensPtr _ -> do - rc <- c_bbs_proof_verify cs pkPtr proofPtr proofLen hdrPtr hdrLen phPtr phLen idxsPtr idxsLen (fromIntegral numMessages) msgsPtr lensPtr + rc <- c_bbs_proof_verify ciphersuite pkPtr proofPtr proofLen hdrPtr hdrLen phPtr phLen idxsPtr idxsLen (fromIntegral numMessages) msgsPtr lensPtr pure (rc == 0) diff --git a/src/Simplex/Messaging/Encoding/String.hs b/src/Simplex/Messaging/Encoding/String.hs index a97d86c33a..7e1ea28ef3 100644 --- a/src/Simplex/Messaging/Encoding/String.hs +++ b/src/Simplex/Messaging/Encoding/String.hs @@ -1,10 +1,14 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} module Simplex.Messaging.Encoding.String ( TextEncoding (..), StrEncoding (..), Str (..), + StrJSON (..), strP_, _strP, strToJSON, @@ -34,6 +38,7 @@ import Data.Int (Int64) import Data.IntSet (IntSet) import qualified Data.IntSet as IS import qualified Data.List.NonEmpty as L +import Data.Proxy (Proxy (..)) import Data.Set (Set) import qualified Data.Set as S import Data.Text (Text) @@ -44,6 +49,7 @@ import Data.Time.Format.ISO8601 import Data.Word (Word16, Word32) import qualified Data.X509 as X import qualified Data.X509.Validation as XV +import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import Simplex.Messaging.Encoding import Simplex.Messaging.Parsers (parseAll) import Simplex.Messaging.Util (bshow, safeDecodeUtf8, (<$?>)) @@ -247,3 +253,19 @@ textToEncoding = JE.text . textEncode textParseJSON :: TextEncoding a => String -> J.Value -> JT.Parser a textParseJSON name = J.withText name $ maybe (fail name) pure . textDecode + +-- | Derives ToJSON/FromJSON from a type's own StrEncoding (a base64url string), +-- so any length (or other) validation in StrEncoding also applies to JSON +-- parsing. The @name@ symbol is the JSON parse error label. Intended for +-- DerivingVia: +-- +-- > newtype Key = Key ByteString +-- > deriving (ToJSON, FromJSON) via (StrJSON "Key" Key) +newtype StrJSON (name :: Symbol) a = StrJSON a + +instance StrEncoding a => ToJSON (StrJSON name a) where + toJSON (StrJSON a) = strToJSON a + toEncoding (StrJSON a) = strToJEncoding a + +instance forall name a. (KnownSymbol name, StrEncoding a) => FromJSON (StrJSON name a) where + parseJSON = fmap StrJSON . strParseJSON (symbolVal (Proxy :: Proxy name)) From 0a7ccf432ab582d6ca0caf237006200f1827e31f Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sat, 13 Jun 2026 15:37:45 +0100 Subject: [PATCH 12/15] simplify --- src/Simplex/Messaging/Crypto/BBS.hs | 12 ++++++------ src/Simplex/Messaging/Encoding/String.hs | 21 +++++++-------------- 2 files changed, 13 insertions(+), 20 deletions(-) diff --git a/src/Simplex/Messaging/Crypto/BBS.hs b/src/Simplex/Messaging/Crypto/BBS.hs index c6f4f47a3a..864bd44f88 100644 --- a/src/Simplex/Messaging/Crypto/BBS.hs +++ b/src/Simplex/Messaging/Crypto/BBS.hs @@ -44,31 +44,31 @@ import System.IO.Unsafe (unsafePerformIO) newtype BBSSecretKey = BBSSecretKey ByteString deriving newtype (Eq, Show) deriving (StrEncoding) via (FixedBS "BBSSecretKey" 32) - deriving (ToJSON, FromJSON) via (StrJSON "BBSSecretKey" BBSSecretKey) + deriving (ToJSON, FromJSON) via (StrJSON "BBSSecretKey") newtype BBSPublicKey = BBSPublicKey ByteString deriving newtype (Eq, Show) deriving (StrEncoding) via (FixedBS "BBSPublicKey" 96) - deriving (ToJSON, FromJSON) via (StrJSON "BBSPublicKey" BBSPublicKey) + deriving (ToJSON, FromJSON) via (StrJSON "BBSPublicKey") type BBSKeyPair = (BBSPublicKey, BBSSecretKey) newtype BBSSignature = BBSSignature ByteString deriving newtype (Eq, Show) deriving (StrEncoding) via (FixedBS "BBSSignature" 80) - deriving (ToJSON, FromJSON) via (StrJSON "BBSSignature" BBSSignature) + deriving (ToJSON, FromJSON) via (StrJSON "BBSSignature") newtype BBSProof = BBSProof ByteString deriving newtype (Eq, Show) - deriving (ToJSON, FromJSON) via (StrJSON "BBSProof" BBSProof) + deriving (ToJSON, FromJSON) via (StrJSON "BBSProof") newtype BBSHeader = BBSHeader ByteString deriving newtype (Eq, Show, StrEncoding) - deriving (ToJSON, FromJSON) via (StrJSON "BBSHeader" BBSHeader) + deriving (ToJSON, FromJSON) via (StrJSON "BBSHeader") newtype BBSPresHeader = BBSPresHeader ByteString deriving newtype (Eq, Show, StrEncoding) - deriving (ToJSON, FromJSON) via (StrJSON "BBSPresHeader" BBSPresHeader) + deriving (ToJSON, FromJSON) via (StrJSON "BBSPresHeader") -- | A ByteString validated to be exactly @n@ bytes when parsed via StrEncoding -- (and the JSON derived from it). Local to BBS, where every key/signature is a diff --git a/src/Simplex/Messaging/Encoding/String.hs b/src/Simplex/Messaging/Encoding/String.hs index 7e1ea28ef3..653df75b77 100644 --- a/src/Simplex/Messaging/Encoding/String.hs +++ b/src/Simplex/Messaging/Encoding/String.hs @@ -254,18 +254,11 @@ textToEncoding = JE.text . textEncode textParseJSON :: TextEncoding a => String -> J.Value -> JT.Parser a textParseJSON name = J.withText name $ maybe (fail name) pure . textDecode --- | Derives ToJSON/FromJSON from a type's own StrEncoding (a base64url string), --- so any length (or other) validation in StrEncoding also applies to JSON --- parsing. The @name@ symbol is the JSON parse error label. Intended for --- DerivingVia: --- --- > newtype Key = Key ByteString --- > deriving (ToJSON, FromJSON) via (StrJSON "Key" Key) -newtype StrJSON (name :: Symbol) a = StrJSON a - -instance StrEncoding a => ToJSON (StrJSON name a) where - toJSON (StrJSON a) = strToJSON a - toEncoding (StrJSON a) = strToJEncoding a - -instance forall name a. (KnownSymbol name, StrEncoding a) => FromJSON (StrJSON name a) where +newtype StrJSON (name :: Symbol) = StrJSON ByteString + +instance ToJSON (StrJSON name) where + toJSON (StrJSON s) = strToJSON s + toEncoding (StrJSON s) = strToJEncoding s + +instance forall name. KnownSymbol name => FromJSON (StrJSON name) where parseJSON = fmap StrJSON . strParseJSON (symbolVal (Proxy :: Proxy name)) From c59c9c05c077d62121768b1ae2ea1cbae11b1e19 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sat, 13 Jun 2026 17:01:41 +0100 Subject: [PATCH 13/15] update libbbs to support iOS --- cbits/libbbs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cbits/libbbs b/cbits/libbbs index ac7f5c711a..59a0f4bf32 160000 --- a/cbits/libbbs +++ b/cbits/libbbs @@ -1 +1 @@ -Subproject commit ac7f5c711a2a2ab08a0d36260c795f94e1501e41 +Subproject commit 59a0f4bf32e195cb6883de8374825c0f4764c717 From 611cbec44d7d6b7fd9e1174edbe3a83ce06b15e3 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sat, 13 Jun 2026 16:06:33 +0000 Subject: [PATCH 14/15] add commoncrypto flag --- cbits/libbbs | 2 +- simplexmq.cabal | 8 ++++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/cbits/libbbs b/cbits/libbbs index 59a0f4bf32..ac7f5c711a 160000 --- a/cbits/libbbs +++ b/cbits/libbbs @@ -1 +1 @@ -Subproject commit 59a0f4bf32e195cb6883de8374825c0f4764c717 +Subproject commit ac7f5c711a2a2ab08a0d36260c795f94e1501e41 diff --git a/simplexmq.cabal b/simplexmq.cabal index 9790fb898d..b9c6802444 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -89,6 +89,11 @@ flag server_postgres manual: True default: False +flag commoncrypto + description: On Apple platforms, use SecRandomCopyBytes (Security.framework) for libbbs randomness. getentropy is a non-public symbol on iOS and triggers App Store rejection (ITMS-90338). + manual: True + default: False + library exposed-modules: Simplex.FileTransfer.Agent @@ -311,6 +316,9 @@ library cbits/libbbs/include cbits/libbbs/src cc-options: -D__BLST_PORTABLE__ + if flag(commoncrypto) + cc-options: -DBBS_CRYPTO_CC + frameworks: Security c-sources: cbits/sha512.c cbits/sntrup761.c From 11dfc64eb0ff3857ea6988ca031b553457d7d99d Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sat, 13 Jun 2026 17:40:31 +0100 Subject: [PATCH 15/15] bump libbbs --- cbits/libbbs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cbits/libbbs b/cbits/libbbs index ac7f5c711a..59a0f4bf32 160000 --- a/cbits/libbbs +++ b/cbits/libbbs @@ -1 +1 @@ -Subproject commit ac7f5c711a2a2ab08a0d36260c795f94e1501e41 +Subproject commit 59a0f4bf32e195cb6883de8374825c0f4764c717