mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-08-27 02:50:08 +00:00
types
This commit is contained in:
@@ -9,24 +9,23 @@ New module `Simplex.Messaging.Crypto.Entitlement`, over `Simplex.Messaging.Crypt
|
||||
Types:
|
||||
|
||||
```
|
||||
newtype EntitlementSecret = EntitlementSecret ByteString
|
||||
newtype MasterKey = MasterKey ByteString
|
||||
|
||||
data Entitlement = Entitlement
|
||||
{ level :: Text,
|
||||
{ entitlementName :: Text,
|
||||
expiresAt :: UTCTime,
|
||||
extraInfo :: Text
|
||||
}
|
||||
|
||||
data EntitlementCredential = EntitlementCredential
|
||||
{ issuerKeyIdx :: Int,
|
||||
holderSecret :: EntitlementSecret,
|
||||
signature :: BBSSignature,
|
||||
masterKey :: MasterKey,
|
||||
issuerSignature :: BBSSignature,
|
||||
entitlement :: Entitlement
|
||||
}
|
||||
|
||||
data EntitlementProof = EntitlementProof
|
||||
{ issuerKeyIdx :: Int,
|
||||
presHeader :: BBSPresHeader,
|
||||
proof :: BBSProof,
|
||||
entitlement :: Entitlement
|
||||
}
|
||||
@@ -34,10 +33,10 @@ data EntitlementProof = EntitlementProof
|
||||
|
||||
Functions and constants:
|
||||
|
||||
- the disclosed-message encoding: the holder secret is message 0 and stays undisclosed; `expiresAt`, `level`, and `extraInfo` are messages 1 to 3 and are disclosed
|
||||
- the disclosed-message encoding: the master key is message 0 and stays undisclosed; `expiresAt`, `entitlementName`, and `extraInfo` are messages 1 to 3 and are disclosed
|
||||
- the BBS header string `"SimpleX entitlement v1"`, the message count, and the disclosed indexes
|
||||
- `generateEntitlementProof :: BBSPublicKey -> EntitlementCredential -> BBSPresHeader -> IO (Either String EntitlementProof)`
|
||||
- `verifyEntitlement :: Map Int BBSPublicKey -> EntitlementProof -> IO (Maybe Bool)`
|
||||
- `verifyEntitlement :: Map Int BBSPublicKey -> BBSPresHeader -> EntitlementProof -> IO (Maybe Bool)` (the caller supplies the presentation header; the server reconstructs it, the proof never includes it)
|
||||
- the issuer public keys constant `Map Int BBSPublicKey`
|
||||
|
||||
## simplexmq: protocol, new XFTP version
|
||||
@@ -66,8 +65,8 @@ In `Simplex.FileTransfer.Server`:
|
||||
|
||||
In `Simplex.FileTransfer.Server.Env` and `Simplex.FileTransfer.Server.Main`:
|
||||
|
||||
- read a maximum storage time for each entitlement level, and a default maximum, from the INI file, where each maximum is a number of hours or permanent
|
||||
- exit at startup if any level maximum is below the default
|
||||
- read a maximum storage time for each entitlement name, and a default maximum, from the INI file, where each maximum is a number of hours or permanent
|
||||
- exit at startup if any name's maximum is below the default
|
||||
- read the issuer public keys from the shared constant
|
||||
|
||||
## simplexmq: server store and expiration
|
||||
@@ -75,8 +74,8 @@ In `Simplex.FileTransfer.Server.Env` and `Simplex.FileTransfer.Server.Main`:
|
||||
Common to both stores, in `Simplex.FileTransfer.Server.Store`:
|
||||
|
||||
- add `expiresAt :: Maybe RoundedFileTime` to `FileRec`, where `Nothing` is permanent storage
|
||||
- in `createFile`, verify the proof against `sessionId <> sndKey <> digest`, resolve the requested time against the level maximum (a permanent maximum is unbounded), set `expiresAt` to the resolved expiration or `Nothing` when the result is permanent, and return it
|
||||
- add the FTTL handler, which verifies the proof against `sessionId <> senderId`, sets `expiresAt` by the same resolution, and returns it
|
||||
- in `createFile`, verify the proof against `sessionId <> sndKey <> digest`, resolve the requested time against the entitlement's maximum (a permanent maximum is unbounded), set `expiresAt` to the resolved expiration or `Nothing` when the result is permanent, and return it
|
||||
- add the FTTL handler, which verifies the proof against `sessionId <> sndKey <> digest`, sets `expiresAt` by the same resolution, and returns it
|
||||
- retain `created_at` for statistics and export
|
||||
|
||||
STM store:
|
||||
@@ -115,12 +114,12 @@ Upload, in `Simplex.Messaging.Agent.Client` and `Simplex.FileTransfer.Client`:
|
||||
|
||||
Set-time:
|
||||
|
||||
- for a completed file, generate a per-chunk proof bound to `sessionId <> senderId` and send FTTL, authorized with the sender key
|
||||
- for a completed file, generate a per-chunk proof bound to `sessionId <> sndKey <> digest` and send FTTL, authorized with the sender key
|
||||
|
||||
## simplex-chat
|
||||
|
||||
- remove lifetime badges: make `badgeExpiry` a `UTCTime`, drop the `"lifetime"` encoding, and remove the lifetime option from the UI and the CLI
|
||||
- map `BadgeInfo` to `Entitlement` (`level = textEncode badgeType`, `expiresAt = badgeExpiry`, `extraInfo = badgeExtra`) when calling the agent
|
||||
- map `BadgeInfo` to `Entitlement` (`entitlementName = textEncode badgeType`, `expiresAt = badgeExpiry`, `extraInfo = badgeExtra`) when calling the agent
|
||||
- pass the user's credential and `FSTMax` to `xftpSendFile`
|
||||
- retain the `maxXFTPFileSize` size limit
|
||||
- reuse `verifyEntitlement` for peer-badge verification
|
||||
|
||||
@@ -6,13 +6,13 @@ The server stores a storage time for each file. The sender sets it in the FNEW c
|
||||
|
||||
## Entitlement
|
||||
|
||||
An entitlement is a level, an expiration, and an extra string. It is the disclosed content of a BBS proof: the holder's secret remains undisclosed, and the three fields are revealed. The server reads `entLevel` to select a maximum storage time, checks `entExpires`, and ignores `entExtra`; the interpretation of `entExtra` is out of scope here. The protocol references only the entitlement, never a badge; chat maps its own badge to an entitlement before it asks the agent to send.
|
||||
An entitlement is a name, an expiration, and an extra string. It is the disclosed content of a BBS proof: the holder's secret remains undisclosed, and the three fields are revealed. The server reads `entName` to select a maximum storage time, checks `entExpires`, and ignores `entExtra`; the interpretation of `entExtra` is out of scope here. The protocol references only the entitlement, never a badge; chat maps its own badge to an entitlement before it asks the agent to send.
|
||||
|
||||
The proof discloses the entitlement and includes the issuer key index and the BBS proof. The holder's secret and the BBS signature remain with the sender and are never transmitted. The origin of the sender's signed entitlement, from the entitlement service, is out of scope here.
|
||||
|
||||
```
|
||||
entitlement = entLevel entExpires entExtra
|
||||
entLevel = shortString ; e.g. "supporter", "legend"
|
||||
entitlement = entName entExpires entExtra
|
||||
entName = shortString ; e.g. "supporter", "legend"
|
||||
entExpires = shortString ; expiration, encoded as signed
|
||||
entExtra = shortString ; opaque, interpretation out of scope
|
||||
|
||||
@@ -56,29 +56,28 @@ FNEW extends the SIDS response with the granted storage, and FTTL adds a respons
|
||||
sndIds = %s"SIDS " senderId rcvIds grantedStorage
|
||||
fileTime = %s"TTL " grantedStorage
|
||||
grantedStorage = grantedExpires / grantedPerm
|
||||
grantedExpires = %s"F" expiresSeconds
|
||||
grantedExpires = %s"F" expiresAt
|
||||
grantedPerm = %s"P"
|
||||
expiresSeconds = 8*8 OCTET ; Int64 seconds since epoch, network byte order
|
||||
expiresAt = 8*8 OCTET ; Int64, seconds since epoch (absolute UTC instant), network byte order
|
||||
```
|
||||
|
||||
`grantedExpires` returns the absolute expiration, and `grantedPerm` indicates permanent storage. `senderId` and `rcvIds` are defined by the current XFTP protocol.
|
||||
|
||||
## Binding
|
||||
|
||||
The presentation header binds each proof to the TLS session and to the specific chunk. The server reconstructs it and rejects a proof generated for any other session or chunk.
|
||||
The presentation header binds each proof to the TLS session and to the specific chunk. The server reconstructs it and rejects a proof generated for any other session or chunk. FNEW and FTTL use the same header.
|
||||
|
||||
```
|
||||
fnewPresHeader = sessionId sndKey digest
|
||||
fttlPresHeader = sessionId senderId
|
||||
presHeader = sessionId sndKey digest
|
||||
```
|
||||
|
||||
On FNEW the chunk is identified by the sender key and the digest, which the server verifies for every later command on the file. On FTTL the chunk is identified by `senderId`, which the server has assigned by then. `sessionId` is the TLS session identifier; `sndKey` and `digest` are the fields of `fileInfo`.
|
||||
The chunk is identified by the sender key and the digest, which the server verifies for every command on the file. `sessionId` is the TLS session identifier; `sndKey` and `digest` are the fields of `fileInfo`.
|
||||
|
||||
## Maximum storage time
|
||||
|
||||
The server configures a maximum storage time for each entitlement level, and a default maximum for requests with no proof. Each maximum is a number of hours or permanent. The server exits at startup if any level maximum is below the default, so a proof never reduces the allowed time. The server treats an entitlement whose expiration has passed as no proof.
|
||||
The server configures a maximum storage time for each entitlement name, and a default maximum for requests with no proof. Each maximum is a number of hours or permanent. The server exits at startup if any name's maximum is below the default, so a proof never reduces the allowed time. The server treats an entitlement whose expiration has passed as no proof.
|
||||
|
||||
If the requested time exceeds the maximum, the server stores the file for the maximum and does not reject the request. `storageMax` yields permanent storage when the level maximum is permanent, and the finite maximum otherwise.
|
||||
If the requested time exceeds the maximum, the server stores the file for the maximum and does not reject the request. `storageMax` yields permanent storage when the entitlement's maximum is permanent, and the finite maximum otherwise.
|
||||
|
||||
## Encoding primitives
|
||||
|
||||
|
||||
@@ -135,6 +135,7 @@ library
|
||||
Simplex.Messaging.Crypto.Lazy
|
||||
Simplex.Messaging.Crypto.Ratchet
|
||||
Simplex.Messaging.Crypto.BBS
|
||||
Simplex.Messaging.Crypto.Entitlement
|
||||
Simplex.Messaging.Crypto.SNTRUP761
|
||||
Simplex.Messaging.Crypto.SNTRUP761.Bindings
|
||||
Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
|
||||
|
||||
@@ -0,0 +1,129 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
-- | A generic entitlement, proven with a BBS proof over the SHA-256 suite.
|
||||
-- The holder secret (the master key) is the undisclosed message; the name, the
|
||||
-- expiration, and the extra string are disclosed. The protocol and the server
|
||||
-- reference the entitlement, never a badge; chat maps its own badge to an
|
||||
-- entitlement.
|
||||
module Simplex.Messaging.Crypto.Entitlement
|
||||
( Entitlement (..),
|
||||
EntitlementCredential (..),
|
||||
EntitlementProof (..),
|
||||
MasterKey (..),
|
||||
entitlementIssuerKeys,
|
||||
signEntitlement,
|
||||
verifyCredential,
|
||||
generateEntitlementProof,
|
||||
verifyEntitlement,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (FromJSON (..), ToJSON (..))
|
||||
import qualified Data.Aeson.TH as JQ
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.Either (fromRight)
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.Time.Clock (UTCTime)
|
||||
import Simplex.Messaging.Crypto.BBS
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (defaultJSON)
|
||||
|
||||
newtype MasterKey = MasterKey ByteString
|
||||
deriving newtype (Eq, Show, StrEncoding)
|
||||
deriving (ToJSON, FromJSON) via (StrJSON "MasterKey" MasterKey)
|
||||
|
||||
-- | The disclosed content of an entitlement proof.
|
||||
data Entitlement = Entitlement
|
||||
{ entitlementName :: Text,
|
||||
expiresAt :: UTCTime,
|
||||
extraInfo :: Text
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | The signing form, held by the entitlement holder; never transmitted.
|
||||
data EntitlementCredential = EntitlementCredential
|
||||
{ issuerKeyIdx :: Int,
|
||||
masterKey :: MasterKey,
|
||||
issuerSignature :: BBSSignature,
|
||||
entitlement :: Entitlement
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | The proof form. The presentation header is not part of the proof: the
|
||||
-- verifier supplies it, so a proof cannot claim its own binding.
|
||||
data EntitlementProof = EntitlementProof
|
||||
{ issuerKeyIdx :: Int,
|
||||
proof :: BBSProof,
|
||||
entitlement :: Entitlement
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
entitlementBBSHeader :: BBSHeader
|
||||
entitlementBBSHeader = BBSHeader "SimpleX entitlement v1"
|
||||
|
||||
entitlementMessageCount :: Int
|
||||
entitlementMessageCount = 4
|
||||
|
||||
entitlementDisclosedIndexes :: [Int]
|
||||
entitlementDisclosedIndexes = [1, 2, 3]
|
||||
|
||||
entitlementMessages :: MasterKey -> Entitlement -> [ByteString]
|
||||
entitlementMessages (MasterKey mk) ent = mk : disclosedMessages ent
|
||||
|
||||
disclosedMessages :: Entitlement -> [ByteString]
|
||||
disclosedMessages Entitlement {entitlementName, expiresAt, extraInfo} =
|
||||
[strEncode expiresAt, encodeUtf8 entitlementName, encodeUtf8 extraInfo]
|
||||
|
||||
-- | Issuer side: sign an entitlement for a holder master key.
|
||||
signEntitlement :: BBSSecretKey -> Int -> MasterKey -> Entitlement -> IO (Either String EntitlementCredential)
|
||||
signEntitlement sk keyIdx mk ent =
|
||||
fmap (\sig -> EntitlementCredential keyIdx mk sig ent) <$> bbsSign sk entitlementBBSHeader (entitlementMessages mk ent)
|
||||
|
||||
-- | Holder side: verify the credential received from the issuer.
|
||||
verifyCredential :: BBSPublicKey -> EntitlementCredential -> IO Bool
|
||||
verifyCredential pk EntitlementCredential {masterKey, issuerSignature, entitlement} =
|
||||
bbsVerify pk issuerSignature entitlementBBSHeader (entitlementMessages masterKey entitlement)
|
||||
|
||||
-- | Holder side: generate a proof bound to the presentation header.
|
||||
generateEntitlementProof :: BBSPublicKey -> EntitlementCredential -> BBSPresHeader -> IO (Either String EntitlementProof)
|
||||
generateEntitlementProof pk EntitlementCredential {issuerKeyIdx, masterKey, issuerSignature, entitlement} ph =
|
||||
fmap (\p -> EntitlementProof issuerKeyIdx p entitlement) <$> bbsProofGen pk issuerSignature entitlementBBSHeader ph entitlementDisclosedIndexes (entitlementMessages masterKey entitlement)
|
||||
|
||||
-- | Verifier side: verify the proof with the configured key its index points to,
|
||||
-- against the supplied presentation header. Nothing means the key index is not
|
||||
-- among the configured keys.
|
||||
verifyEntitlement :: Map Int BBSPublicKey -> BBSPresHeader -> EntitlementProof -> IO (Maybe Bool)
|
||||
verifyEntitlement keys ph EntitlementProof {issuerKeyIdx, proof, entitlement} = case M.lookup issuerKeyIdx keys of
|
||||
Nothing -> pure Nothing
|
||||
Just pk -> Just <$> bbsProofVerify pk proof entitlementBBSHeader ph entitlementDisclosedIndexes entitlementMessageCount (disclosedMessages entitlement)
|
||||
|
||||
entitlementIssuerKeys :: Map Int BBSPublicKey
|
||||
entitlementIssuerKeys =
|
||||
M.fromList
|
||||
[ (1, key "mW_5Zp1wHnXDF56wOZwFcRjGrf0GLLsfyymIQDqYoWfjfvS7oQWSfi7hH65N8JhuE9x8wbKXHidnQLO4GnOSMP_bRKUMH1qIzv5SQKFHNM8G4PaWcTcri8iZLc-3xhSI"),
|
||||
(2, key "odGCB7uVDXTURsHgSvSciByV4Q3-3ZvEB8myDsDJqm-PwOYc5-At36uc7n_pyUDxEQEHr9i4RJgFih2FSArPW-EQBXNPNf4wTtA0znn74qLEGc4fh9pVYPEIm_ZGbnsJ"),
|
||||
(3, key "txkT2003WMjc43KvYvPKEcR970NLmw5UZY51eUqgk91sgp53idt1HTlKYvnrEttJDFMlctYf1-bpri0e9DhBQ-xk1J4WoLN2uif_1OcA1pGCobpk9lwtsq1Idek4biy0"),
|
||||
(4, key "q_YzegihaLYrEm9z3cAghsfDGNZfXuEpQGMJERJQS4M0Szl4gvSC_fV_muKc3NIMA_8iYuBN8qyvb5U55RctCRn3kleFQ4sqf-WBgoydX6UVo7BsYcUbXWWEFZXlOGIH"),
|
||||
(5, key "oqymHASH_okefShrnz4HnTooUNlE1WoDRnSrgd0bTCpOacgJWBsMpwZpdmYlX-vQAKAC_zmI4VdKoOznnhW-sdUXZw6bthCi5JYjGxCR1Co27i1tix5UXCTbR5Jp901-"),
|
||||
(6, key "kDqaB6zKSRp_97QPFj5JPDlo0vzfSTLSp9goFx1qajv4q4H6dR6BbkmWZ4xx_9Q2AxmcpqcV0ethz1OH-Jk_Sz2J1mIz1PUVM9LkdLhi_PNtqhezzO5dbVs-HJ1fNqe6"),
|
||||
(7, key "rl36D5mg2N3NmmEybxE_RBeU9YZ_zeXNPfp7ZMLtUEuf2Mo4OQM_Up1v5rX_IqICD-AIJcuyptEBsELx_PJQzpmiNuG5I4cWO6HkRKtc6fVFvgZMrDJjaascPd1CIyxX"),
|
||||
(8, key "joM3Bnt7JPt5JiwQwERHGjro2iVZ0mPD_clUh4hzkhxvbjuFrWuTmfSNA8PWBqGKEGNl13aRi1pMf6yY14E27c5C71JxWm7T-rZaBrGPEUWifhD-qidWuf3PU7KJCCWd")
|
||||
]
|
||||
where
|
||||
key = fromRight (error "bad base64 in entitlement issuer key") . strDecode . B.pack
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''Entitlement)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''EntitlementCredential)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''EntitlementProof)
|
||||
Reference in New Issue
Block a user