mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-06-26 01:31:56 +00:00
core: supporter badges using anonymous BBS credentials
This commit is contained in:
Evgeny @ SimpleX Chat
+6
-6
@@ -1,5 +1,5 @@
|
||||
packages: .
|
||||
-- packages: . ../simplexmq
|
||||
-- packages: .
|
||||
packages: . ../simplexmq-3
|
||||
-- packages: . ../simplexmq ../direct-sqlcipher ../sqlcipher-simple
|
||||
|
||||
-- uncomment two sections below to run tests with coverage
|
||||
@@ -18,10 +18,10 @@ package cryptostore
|
||||
|
||||
constraints: zip +disable-bzip2 +disable-zstd
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/simplex-chat/simplexmq.git
|
||||
tag: ee2ff402fed4d27d31521570c910fe82e0cf116a
|
||||
-- source-repository-package
|
||||
-- type: git
|
||||
-- location: https://github.com/simplex-chat/simplexmq.git
|
||||
-- tag: ee2ff402fed4d27d31521570c910fe82e0cf116a
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
|
||||
@@ -0,0 +1,80 @@
|
||||
# Supporter Badges v1 - Verification
|
||||
|
||||
Badge verification in stable so that v6.5 users can see and verify badges from v7 users. Badge purchase and issuance is v2.
|
||||
|
||||
## Why BBS+
|
||||
|
||||
BBS+ signatures (IETF draft-irtf-cfrg-bbs-signatures) allow a holder of a signed credential to generate zero-knowledge proofs that selectively disclose some signed attributes while hiding others. Each proof uses a random nonce, making different proofs from the same credential computationally unlinkable - a verifier seeing two proofs cannot determine they came from the same credential. This means a supporter badge shown to different contacts cannot be correlated, preserving SimpleX's unlinkable identity model.
|
||||
|
||||
The server that signs the credential sees the master secret during signing but cannot link any received proof back to any signing session - this is the core zero-knowledge property.
|
||||
|
||||
## References
|
||||
|
||||
- IETF draft: https://datatracker.ietf.org/doc/draft-irtf-cfrg-bbs-signatures/
|
||||
- libbbs: https://github.com/Fraunhofer-AISEC/libbbs (Apache-2.0, Fraunhofer-AISEC)
|
||||
- blst: https://github.com/supranational/blst (Apache-2.0, audited by NCC Group) - internal dependency of libbbs for BLS12-381 curve operations
|
||||
|
||||
Both are vendored verbatim into simplexmq so that users and maintainers can verify the source matches upstream. Only libbbs API is called directly.
|
||||
|
||||
## Crypto
|
||||
|
||||
3 signed messages: `[ms, expiry, level]`. `ms` undisclosed (index 0), `expiry` and `level` disclosed (indexes 1, 2). Proof size: 304 bytes (272 base + 32 per undisclosed).
|
||||
|
||||
Server public key (`srvPK`, 96 bytes) hardcoded in app.
|
||||
|
||||
## libbbs integration
|
||||
|
||||
Vendor libbbs + blst C sources into simplexmq. Haskell FFI bindings following the SNTRUP761 pattern (`Simplex.Messaging.Crypto.BBS.Bindings`).
|
||||
|
||||
Full FFI surface for testing the complete flow:
|
||||
|
||||
- `bbs_keygen_full` - generate keypair
|
||||
- `bbs_sign` - sign messages
|
||||
- `bbs_proof_gen` - generate ZK proof with selective disclosure
|
||||
- `bbs_proof_verify` - verify proof
|
||||
- `bbs_sha256_ciphersuite` - ciphersuite constant
|
||||
|
||||
Unit tests: keygen, sign, proof gen, proof verify roundtrip. Verify proof size. Verify rejection of tampered proofs. Verify two proofs from same credential don't correlate (different presentation headers produce different proofs that both verify).
|
||||
|
||||
Use blst portable C fallback for now (avoids per-arch assembly).
|
||||
|
||||
## Profile type
|
||||
|
||||
Add optional `badge` field to `Profile`. The `SupporterBadge` type uses base64-encoded newtypes for binary fields, following the `KEMPublicKey`/`KEMCiphertext` pattern from SNTRUP761 bindings:
|
||||
|
||||
```haskell
|
||||
data SupporterBadge = SupporterBadge
|
||||
{ proof :: BBSProof
|
||||
, proofNonce :: ByteString
|
||||
, badgeExpiry :: UTCTime
|
||||
, badgeType :: Text
|
||||
}
|
||||
```
|
||||
|
||||
`badgeType` is a string: `"supporter"`, `"business"`, `"legend"`, `"cf_investor"`. Displayed in UI as Supporter, Business, Legend, Crowdfunding Investor. `BBSProof` is a newtype over `ByteString` with `StrEncoding` instances for base64url JSON encoding.
|
||||
|
||||
Backward compatible: `omitNothingFields` means older clients ignore it, newer clients without badge send `Nothing`.
|
||||
|
||||
## DB
|
||||
|
||||
- `badge` fields on `contact_profiles` and `group_member_profiles` to store received badge data
|
||||
- `badge_status` column on `contacts` and `group_members` to store verification result
|
||||
- `badge` fields on user profile (`users` or `contact_profiles` for own profile) for when badge issuance is added in v2
|
||||
|
||||
## Verification
|
||||
|
||||
On receiving profile with `badge` (in Subscriber.hs, `XInfo`/`XGrpMemInfo`/`XContact` handlers):
|
||||
|
||||
1. `bbs_proof_verify(srvPK, proof, "", proofNonce, disclosed=[1,2], [expiry, level])`
|
||||
2. Check `expiry >= now`
|
||||
3. Store badge + verification status on contact/member
|
||||
|
||||
## UI
|
||||
|
||||
Badge icon next to display name for verified contacts/members. Different icons per level string. Expired badges shown differently or hidden.
|
||||
|
||||
## Not in v1
|
||||
|
||||
- Badge purchase, issuance, credential storage, proof generation - v2
|
||||
- Service framework - v2
|
||||
- Payment platform integration - v2
|
||||
@@ -38,6 +38,7 @@ library
|
||||
exposed-modules:
|
||||
Simplex.Chat
|
||||
Simplex.Chat.AppSettings
|
||||
Simplex.Chat.Badges
|
||||
Simplex.Chat.Call
|
||||
Simplex.Chat.Controller
|
||||
Simplex.Chat.Delivery
|
||||
|
||||
@@ -0,0 +1,180 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Simplex.Chat.Badges
|
||||
( BadgeType (..),
|
||||
BadgePurchase (..),
|
||||
BadgeMasterKey (..),
|
||||
BadgeRequest (..),
|
||||
VerifiedBadgeRequest (..),
|
||||
BadgeCredential (..),
|
||||
SupporterBadge (..),
|
||||
bbsBadgeHeader,
|
||||
generateMasterKey,
|
||||
verifyPayment,
|
||||
issueBadge,
|
||||
verifyBadgeSignature,
|
||||
generateBadgeProof,
|
||||
verifyBadge,
|
||||
isBadgeExpired,
|
||||
) where
|
||||
|
||||
import Data.Aeson (FromJSON (..), ToJSON (..))
|
||||
import qualified Data.Aeson.TH as JQ
|
||||
import Control.Concurrent.STM
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.Time.Clock (UTCTime)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.BBS
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (defaultJSON)
|
||||
|
||||
-- Badge type
|
||||
|
||||
data BadgeType
|
||||
= BTSupporter
|
||||
| BTBusiness
|
||||
| BTLegend
|
||||
| BTCFInvestor
|
||||
| BTUnknown Text
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance TextEncoding BadgeType where
|
||||
textEncode = \case
|
||||
BTSupporter -> "supporter"
|
||||
BTBusiness -> "business"
|
||||
BTLegend -> "legend"
|
||||
BTCFInvestor -> "cf_investor"
|
||||
BTUnknown tag -> tag
|
||||
textDecode s = Just $ case s of
|
||||
"supporter" -> BTSupporter
|
||||
"business" -> BTBusiness
|
||||
"legend" -> BTLegend
|
||||
"cf_investor" -> BTCFInvestor
|
||||
tag -> BTUnknown tag
|
||||
|
||||
instance ToJSON BadgeType where
|
||||
toJSON = textToJSON
|
||||
toEncoding = textToEncoding
|
||||
|
||||
instance FromJSON BadgeType where
|
||||
parseJSON = textParseJSON "BadgeType"
|
||||
|
||||
-- Payment proof
|
||||
|
||||
data BadgePurchase
|
||||
= BPAppleReceipt Text
|
||||
| BPGoogleReceipt Text
|
||||
| BPStripeSession
|
||||
| BPRedeemCode Text
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- Master key
|
||||
|
||||
newtype BadgeMasterKey = BadgeMasterKey ByteString
|
||||
deriving (Eq, Show)
|
||||
|
||||
generateMasterKey :: TVar ChaChaDRG -> IO BadgeMasterKey
|
||||
generateMasterKey drg = BadgeMasterKey <$> atomically (C.randomBytes 32 drg)
|
||||
|
||||
-- Workflow types
|
||||
|
||||
data BadgeRequest = BadgeRequest
|
||||
{ masterKey :: BadgeMasterKey,
|
||||
badgeType :: BadgeType,
|
||||
payment :: BadgePurchase
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data VerifiedBadgeRequest = VerifiedBadgeRequest
|
||||
{ masterKey :: BadgeMasterKey,
|
||||
badgeType :: BadgeType
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data BadgeCredential = BadgeCredential
|
||||
{ masterKey :: BadgeMasterKey,
|
||||
signature :: BBSSignature,
|
||||
badgeExpiry :: Maybe UTCTime,
|
||||
badgeType :: BadgeType
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data SupporterBadge = SupporterBadge
|
||||
{ proof :: BBSProof,
|
||||
presHeader :: BBSPresHeader,
|
||||
badgeExpiry :: Maybe UTCTime,
|
||||
badgeType :: BadgeType
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- Constants
|
||||
|
||||
bbsBadgeHeader :: BBSHeader
|
||||
bbsBadgeHeader = BBSHeader "SimpleX badges v1"
|
||||
|
||||
bbsBadgeMessageCount :: Int
|
||||
bbsBadgeMessageCount = 3
|
||||
|
||||
bbsBadgeDisclosedIndexes :: [Int]
|
||||
bbsBadgeDisclosedIndexes = [1, 2]
|
||||
|
||||
-- Message encoding
|
||||
|
||||
encodeExpiry :: Maybe UTCTime -> ByteString
|
||||
encodeExpiry = maybe "lifetime" strEncode
|
||||
|
||||
badgeMessages :: BadgeMasterKey -> Maybe UTCTime -> BadgeType -> [ByteString]
|
||||
badgeMessages (BadgeMasterKey ms) expiry bt = [ms, encodeExpiry expiry, encodeUtf8 (textEncode bt)]
|
||||
|
||||
badgeDisclosedMessages :: Maybe UTCTime -> BadgeType -> [ByteString]
|
||||
badgeDisclosedMessages expiry bt = [encodeExpiry expiry, encodeUtf8 (textEncode bt)]
|
||||
|
||||
-- Payment verification (stub - always passes)
|
||||
|
||||
verifyPayment :: BadgeRequest -> IO (Maybe VerifiedBadgeRequest)
|
||||
verifyPayment BadgeRequest {masterKey, badgeType} =
|
||||
pure $ Just VerifiedBadgeRequest {masterKey, badgeType}
|
||||
|
||||
-- Server-side: issue a badge credential
|
||||
|
||||
issueBadge :: BBSSecretKey -> BBSPublicKey -> Maybe UTCTime -> VerifiedBadgeRequest -> IO (Either String BadgeCredential)
|
||||
issueBadge sk pk expiry VerifiedBadgeRequest {masterKey, badgeType} =
|
||||
fmap mkCred <$> bbsSign sk pk bbsBadgeHeader (badgeMessages masterKey expiry badgeType)
|
||||
where
|
||||
mkCred sig = BadgeCredential {masterKey, signature = sig, badgeExpiry = expiry, badgeType}
|
||||
|
||||
-- Client-side: verify the credential received from server
|
||||
|
||||
verifyBadgeSignature :: BBSPublicKey -> BadgeCredential -> IO Bool
|
||||
verifyBadgeSignature pk BadgeCredential {masterKey, signature, badgeExpiry, badgeType} =
|
||||
bbsVerify pk signature bbsBadgeHeader (badgeMessages masterKey badgeExpiry badgeType)
|
||||
|
||||
-- Client-side: generate a proof for a contact/group
|
||||
|
||||
generateBadgeProof :: BBSPublicKey -> BadgeCredential -> BBSPresHeader -> IO (Either String SupporterBadge)
|
||||
generateBadgeProof pk BadgeCredential {masterKey, signature, badgeExpiry, badgeType} ph =
|
||||
fmap mkBadge <$> bbsProofGen pk signature bbsBadgeHeader ph bbsBadgeDisclosedIndexes (badgeMessages masterKey badgeExpiry badgeType)
|
||||
where
|
||||
mkBadge p = SupporterBadge {proof = p, presHeader = ph, badgeExpiry, badgeType}
|
||||
|
||||
-- Recipient-side: verify a badge proof
|
||||
|
||||
verifyBadge :: BBSPublicKey -> SupporterBadge -> IO Bool
|
||||
verifyBadge pk SupporterBadge {proof, presHeader, badgeExpiry, badgeType} =
|
||||
bbsProofVerify pk proof bbsBadgeHeader presHeader bbsBadgeDisclosedIndexes bbsBadgeMessageCount (badgeDisclosedMessages badgeExpiry badgeType)
|
||||
|
||||
-- Check if badge has expired
|
||||
|
||||
isBadgeExpired :: UTCTime -> SupporterBadge -> Bool
|
||||
isBadgeExpired now SupporterBadge {badgeExpiry} = maybe False (now >) badgeExpiry
|
||||
|
||||
-- JSON for profile transmission
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''SupporterBadge)
|
||||
@@ -0,0 +1,93 @@
|
||||
{-# LANGUAGE DisambiguateRecordFields #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module BadgeTests (badgeTests) where
|
||||
|
||||
import Data.Time.Clock (UTCTime, getCurrentTime)
|
||||
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Chat.Badges
|
||||
import Simplex.Messaging.Crypto.BBS
|
||||
import Test.Hspec
|
||||
|
||||
badgeTests :: Spec
|
||||
badgeTests = do
|
||||
it "full workflow: request, issue, verify credential, generate and verify proof" testFullWorkflow
|
||||
it "should reject badge with tampered type" testTamperedType
|
||||
it "should reject badge with tampered expiry" testTamperedExpiry
|
||||
it "should reject badge with wrong server key" testWrongKey
|
||||
it "should check expiry dates correctly" testExpiryCheck
|
||||
it "should treat lifetime badges as never expired" testLifetimeBadge
|
||||
it "should accept unknown badge types" testUnknownBadgeType
|
||||
|
||||
testFullWorkflow :: IO ()
|
||||
testFullWorkflow = do
|
||||
(sk, pk) <- bbsKeyGen
|
||||
drg <- C.newRandom
|
||||
mk <- generateMasterKey drg
|
||||
let req = BadgeRequest {masterKey = mk, badgeType = BTSupporter, payment = BPRedeemCode "TEST"}
|
||||
Just vreq <- verifyPayment req
|
||||
Right cred <- issueBadge sk pk (Just futureTime) vreq
|
||||
let BadgeCredential {masterKey = mk'} = cred
|
||||
mk' `shouldBe` mk
|
||||
verifyBadgeSignature pk cred >>= (`shouldBe` True)
|
||||
Right badge <- generateBadgeProof pk cred (BBSPresHeader "nonce-1")
|
||||
verifyBadge pk badge >>= (`shouldBe` True)
|
||||
Right badge2 <- generateBadgeProof pk cred (BBSPresHeader "nonce-2")
|
||||
verifyBadge pk badge2 >>= (`shouldBe` True)
|
||||
proof badge `shouldNotBe` proof badge2
|
||||
|
||||
testTamperedType :: IO ()
|
||||
testTamperedType = do
|
||||
(pk, SupporterBadge {proof, presHeader, badgeExpiry}) <- issueBadgeProof BTSupporter (Just futureTime)
|
||||
verifyBadge pk (SupporterBadge {proof, presHeader, badgeExpiry, badgeType = BTBusiness}) >>= (`shouldBe` False)
|
||||
|
||||
testTamperedExpiry :: IO ()
|
||||
testTamperedExpiry = do
|
||||
(pk, SupporterBadge {proof, presHeader, badgeType}) <- issueBadgeProof BTSupporter (Just futureTime)
|
||||
verifyBadge pk (SupporterBadge {proof, presHeader, badgeExpiry = Just pastTime, badgeType}) >>= (`shouldBe` False)
|
||||
|
||||
testWrongKey :: IO ()
|
||||
testWrongKey = do
|
||||
(_, badge) <- issueBadgeProof BTSupporter (Just futureTime)
|
||||
(_, pk2) <- bbsKeyGen
|
||||
verifyBadge pk2 badge >>= (`shouldBe` False)
|
||||
|
||||
testExpiryCheck :: IO ()
|
||||
testExpiryCheck = do
|
||||
now <- getCurrentTime
|
||||
(_, past) <- issueBadgeProof BTSupporter (Just pastTime)
|
||||
isBadgeExpired now past `shouldBe` True
|
||||
(_, future) <- issueBadgeProof BTSupporter (Just futureTime)
|
||||
isBadgeExpired now future `shouldBe` False
|
||||
|
||||
testLifetimeBadge :: IO ()
|
||||
testLifetimeBadge = do
|
||||
now <- getCurrentTime
|
||||
(pk, badge) <- issueBadgeProof BTCFInvestor Nothing
|
||||
verifyBadge pk badge >>= (`shouldBe` True)
|
||||
isBadgeExpired now badge `shouldBe` False
|
||||
|
||||
testUnknownBadgeType :: IO ()
|
||||
testUnknownBadgeType = do
|
||||
(pk, badge) <- issueBadgeProof (BTUnknown "future_type") (Just futureTime)
|
||||
verifyBadge pk badge >>= (`shouldBe` True)
|
||||
|
||||
-- Helpers
|
||||
|
||||
futureTime :: UTCTime
|
||||
futureTime = posixSecondsToUTCTime 4102444800 -- 2099-12-31
|
||||
|
||||
pastTime :: UTCTime
|
||||
pastTime = posixSecondsToUTCTime 1577836800 -- 2020-01-01
|
||||
|
||||
issueBadgeProof :: BadgeType -> Maybe UTCTime -> IO (BBSPublicKey, SupporterBadge)
|
||||
issueBadgeProof bt expiry = do
|
||||
(sk, pk) <- bbsKeyGen
|
||||
drg <- C.newRandom
|
||||
mk <- generateMasterKey drg
|
||||
let vreq = VerifiedBadgeRequest {masterKey = mk, badgeType = bt}
|
||||
Right cred <- issueBadge sk pk expiry vreq
|
||||
Right badge <- generateBadgeProof pk cred (BBSPresHeader "test-nonce")
|
||||
pure (pk, badge)
|
||||
@@ -11,6 +11,7 @@ import ChatTests.DBUtils
|
||||
import ChatTests.Utils (xdescribe'')
|
||||
import Control.Logger.Simple
|
||||
import Data.Time.Clock.System
|
||||
import BadgeTests
|
||||
import JSONTests
|
||||
import MarkdownTests
|
||||
import MemberRelationsTests
|
||||
@@ -60,6 +61,7 @@ main = do
|
||||
#endif
|
||||
around tmpBracket $ describe "WebRTC encryption" webRTCTests
|
||||
#endif
|
||||
describe "Supporter badges" badgeTests
|
||||
describe "SimpleX chat markdown" markdownTests
|
||||
describe "JSON Tests" jsonTests
|
||||
describe "Member relations" memberRelationsTests
|
||||
|
||||
Reference in New Issue
Block a user