diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 97e04d056..8bf16ac36 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -2195,14 +2195,16 @@ agentXFTPNewChunk c SndFileChunk {userId, chunkSpec = XFTPChunkSpec {chunkSize},
   logServer "-->" c srv NoEntity "FNEW"
   tSess <- mkTransportSession c userId srv chunkDigest
   (sndId, rIds) <- withClient c NRMBackground tSess $ \xftp -> do
-    proof <- liftIO $ case credential of
-      Nothing -> pure Nothing
-      Just cred@EntitlementCredential {issuerKeyIdx} -> case M.lookup issuerKeyIdx entitlementIssuerKeys of
-        Nothing -> pure Nothing
-        Just pk -> either (const Nothing) Just <$> generateEntitlementProof pk cred (xftpNewProofHeader (sessionId $ X.thParams xftp) sndKey chunkDigest)
+    proof <- liftIO $ mkEntitlementProof (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}
+  where
+    mkEntitlementProof sessId sndKey =
+      pure (credential >>= \cred@EntitlementCredential {issuerKeyIdx} -> (cred,) <$> M.lookup issuerKeyIdx entitlementIssuerKeys) $>>= \(cred, pk) ->
+        generateEntitlementProof pk cred (xftpNewProofHeader sessId sndKey chunkDigest) >>= \case
+          Right p -> pure $ Just p
+          Left e -> Nothing <$ logError ("entitlement proof error: " <> tshow e)
 
 agentXFTPUploadChunk :: AgentClient -> UserId -> FileDigest -> SndFileChunkReplica -> XFTPChunkSpec -> AM ()
 agentXFTPUploadChunk c userId (FileDigest chunkDigest) SndFileChunkReplica {server, replicaId = ChunkReplicaId fId, replicaKey} chunkSpec =
diff --git a/src/Simplex/Messaging/Crypto/Entitlement.hs b/src/Simplex/Messaging/Crypto/Entitlement.hs
index 529589a5c..a3bb28ecf 100644
--- a/src/Simplex/Messaging/Crypto/Entitlement.hs
+++ b/src/Simplex/Messaging/Crypto/Entitlement.hs
@@ -24,6 +24,7 @@ module Simplex.Messaging.Crypto.Entitlement
   )
 where
 
+import Control.Monad (forM)
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson.TH as JQ
 import Data.ByteString.Char8 (ByteString)
@@ -120,9 +121,9 @@ generateEntitlementProof pk EntitlementCredential {issuerKeyIdx, masterKey, issu
 -- 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)
+verifyEntitlement keys ph EntitlementProof {issuerKeyIdx, proof, entitlement} =
+  forM (M.lookup issuerKeyIdx keys) $ \pk ->
+    bbsProofVerify pk proof entitlementBBSHeader ph entitlementDisclosedIndexes entitlementMessageCount (disclosedMessages entitlement)
 
 entitlementIssuerKeys :: Map Int BBSPublicKey
 entitlementIssuerKeys =