add test of upload with entitlement

src/Simplex/FileTransfer/Server.hs

@@ -56,7 +56,7 @@ import Simplex.FileTransfer.Server.StoreLog
 import Simplex.FileTransfer.Transport
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.BBS (BBSPresHeader)
-import Simplex.Messaging.Crypto.Entitlement (Entitlement (..), EntitlementProof (..), entitlementIssuerKeys, verifyEntitlement)
+import Simplex.Messaging.Crypto.Entitlement (Entitlement (..), EntitlementProof (..), verifyEntitlement)
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
@@ -509,10 +509,11 @@ processXFTPRequest sessionId HTTP2Body {bodyPart} = \case
     storageMaxSeconds _ Nothing = asks $ ttl . fileExpiration . config
     storageMaxSeconds ph (Just proof@EntitlementProof {entitlement = ent}) = do
       entCfg <- asks $ fileStorageEntitlements . config
+      keys <- asks $ entitlementKeys . config
       defaultMax <- asks $ ttl . fileExpiration . config
       now <- liftIO getCurrentTime
       let Entitlement {entitlementName, expiresAt} = ent
-      liftIO (verifyEntitlement entitlementIssuerKeys ph proof) >>= \case
+      liftIO (verifyEntitlement keys ph proof) >>= \case
         Just True | addUTCTime nominalDay expiresAt > now -> pure $ fromMaybe defaultMax (M.lookup entitlementName entCfg)
         _ -> pure defaultMax
     addFileRetry :: s -> FileInfo -> Int -> RoundedFileTime -> Maybe RoundedFileTime -> M s (Either XFTPErrorType XFTPFileId)

src/Simplex/FileTransfer/Server/Env.hs

@@ -41,11 +41,12 @@ import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime)
-import Data.Word (Word32)
+import Data.Word (Word16, Word32)
 import Data.X509.Validation (Fingerprint (..))
 import Network.Socket
 import qualified Network.TLS as T
 import Simplex.FileTransfer.Protocol (FileCmd, FileInfo (..), XFTPFileId)
+import Simplex.Messaging.Crypto.BBS (BBSPublicKey)
 import Simplex.Messaging.Crypto.Entitlement (EntitlementProof)
 import Simplex.FileTransfer.Server.Stats
 import Data.Either (fromRight)
@@ -95,6 +96,7 @@ data XFTPServerConfig s = XFTPServerConfig
     fileExpiration :: ExpirationConfig,
     -- | maximum storage time per entitlement name, seconds
     fileStorageEntitlements :: Map Text Int64,
+    entitlementKeys :: Map Word16 BBSPublicKey,
     -- | timeout to receive file
     fileTimeout :: Int,
     -- | time after which inactive clients can be disconnected and check interval, seconds

src/Simplex/FileTransfer/Server/Main.hs

@@ -35,6 +35,7 @@ import Simplex.FileTransfer.Server (runXFTPServer)
 import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), XFTPStoreConfig, AFStoreType (..), defFileExpirationHours, defaultFileExpiration, defaultInactiveClientExpiration, readFileStoreType, runWithStoreConfig, checkFileStoreMode, importToDatabase, exportFromDatabase)
 import Simplex.FileTransfer.Transport (alpnSupportedXFTPhandshakes, supportedFileServerVRange)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Entitlement (entitlementIssuerKeys)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern XFTPServer)
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
@@ -292,6 +293,7 @@ xftpServerCLI_ generateSite serveStaticFiles cfgPath logPath = do
                   { ttl = 3600 * readIniDefault defFileExpirationHours "STORE_LOG" "expire_files_hours" ini
                   },
               fileStorageEntitlements = iniEntitlements ini,
+              entitlementKeys = entitlementIssuerKeys,
               fileTimeout = 5 * 60 * 1000000, -- 5 mins to send 4mb chunk
               inactiveClientExpiration =
                 settingIsOn "INACTIVE_CLIENTS" "disconnect" ini
@@ -443,5 +445,5 @@ iniEntitlements :: Ini -> Map T.Text Int64
 iniEntitlements ini =
   M.fromList $ mapMaybe readEntitlement [("supporter", "expire_files_hours_for_supporter"), ("legend", "expire_files_hours_for_legend")]
   where
-    readEntitlement (name, key) = (name,) <$> (parseMax =<< eitherToMaybe (lookupValue "STORE_LOG" key ini))
-    parseMax t = (3600 *) <$> (readMaybe (T.unpack (T.strip t)) :: Maybe Int64)
+    readEntitlement (name, key) = (name,) . parseHours key <$> eitherToMaybe (lookupValue "STORE_LOG" key ini)
+    parseHours key t = maybe (error $ "Error: invalid " <> T.unpack key <> " value: " <> T.unpack t) (3600 *) (readMaybe (T.unpack (T.strip t)) :: Maybe Int64)

src/Simplex/Messaging/Agent/Client.hs

@@ -253,7 +253,7 @@ import Simplex.Messaging.Agent.TSessionSubs (TSessionSubs)
 import qualified Simplex.Messaging.Agent.TSessionSubs as SS
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Crypto.Entitlement (EntitlementCredential (..), entitlementIssuerKeys, generateEntitlementProof)
+import Simplex.Messaging.Crypto.Entitlement (EntitlementCredential (..), generateEntitlementProof)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Client
@@ -2194,15 +2194,16 @@ agentXFTPNewChunk c SndFileChunk {userId, chunkSpec = XFTPChunkSpec {chunkSize},
   let fileInfo = FileInfo {sndKey, size = chunkSize, digest = chunkDigest}
   logServer "-->" c srv NoEntity "FNEW"
   tSess <- mkTransportSession c userId srv chunkDigest
+  keys <- asks $ entitlementKeys . config
   (sndId, rIds, expiresAt) <- withClient c NRMBackground tSess $ \xftp -> do
-    proof <- liftIO $ mkEntitlementProof (sessionId $ X.thParams xftp) sndKey
+    proof <- liftIO $ mkEntitlementProof keys (sessionId $ X.thParams xftp) sndKey
     X.createXFTPChunk xftp replicaKey fileInfo (L.map fst rKeys) auth storageTime proof
   logServer "<--" c srv NoEntity $ B.unwords ["SIDS", logSecret sndId]
   pure NewSndChunkReplica {server = srv, replicaId = ChunkReplicaId sndId, replicaKey, rcvIdsKeys = L.toList $ xftpRcvIdsKeys rIds rKeys, expiresAt}
   where
-    mkEntitlementProof sessId sndKey =
+    mkEntitlementProof keys sessId sndKey =
       pure credential
-        $>>= \cred -> pure (M.lookup (issuerKeyIdx cred) entitlementIssuerKeys)
+        $>>= \cred -> pure (M.lookup (issuerKeyIdx cred) keys)
         $>>= \pk -> generateEntitlementProof pk cred (xftpNewProofHeader sessId sndKey chunkDigest)
         >>= \case
           Right p -> pure $ Just p

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

@@ -67,6 +67,8 @@ import Simplex.Messaging.Agent.Store.Interface (DBOpts)
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationError (..))
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.BBS (BBSPublicKey)
+import Simplex.Messaging.Crypto.Entitlement (entitlementIssuerKeys)
 import Simplex.Messaging.Crypto.Ratchet (VersionRangeE2E, supportedE2EEncryptVRange)
 import Simplex.Messaging.Notifications.Client (defaultNTFClientConfig)
 import Simplex.Messaging.Notifications.Transport (NTFVersion)
@@ -148,6 +150,7 @@ data AgentConfig = AgentConfig
     smpCfg :: ProtocolClientConfig SMPVersion,
     ntfCfg :: ProtocolClientConfig NTFVersion,
     xftpCfg :: XFTPClientConfig,
+    entitlementKeys :: Map Word16 BBSPublicKey,
     reconnectInterval :: RetryInterval,
     messageRetryInterval :: RetryInterval2,
     userNetworkInterval :: Int,
@@ -226,6 +229,7 @@ defaultAgentConfig =
       smpCfg = defaultSMPClientConfig,
       ntfCfg = defaultNTFClientConfig,
       xftpCfg = defaultXFTPClientConfig,
+      entitlementKeys = entitlementIssuerKeys,
       reconnectInterval = defaultReconnectInterval,
       messageRetryInterval = defaultMessageRetryInterval,
       userNetworkInterval = 1800_000000, -- 30 minutes, should be less than Int32 max value