diff --git a/apps/ios/Shared/Views/Call/WebRTCClient.swift b/apps/ios/Shared/Views/Call/WebRTCClient.swift index acb459938f..933a3c745e 100644 --- a/apps/ios/Shared/Views/Call/WebRTCClient.swift +++ b/apps/ios/Shared/Views/Call/WebRTCClient.swift @@ -18,6 +18,7 @@ final class WebRTCClient: NSObject, RTCVideoViewDelegate, RTCFrameEncryptorDeleg }() private static let ivTagBytes: Int = 28 private static let enableEncryption: Bool = true + private var chat_ctrl = getChatCtrl() struct Call { var connection: RTCPeerConnection @@ -308,7 +309,7 @@ final class WebRTCClient: NSObject, RTCVideoViewDelegate, RTCFrameEncryptorDeleg memcpy(pointer, (unencrypted as NSData).bytes, unencrypted.count) let isKeyFrame = unencrypted[0] & 1 == 0 let clearTextBytesSize = mediaType.rawValue == 0 ? 1 : isKeyFrame ? 10 : 3 - logCrypto("encrypt", chat_encrypt_media(&key, pointer.advanced(by: clearTextBytesSize), Int32(unencrypted.count + WebRTCClient.ivTagBytes - clearTextBytesSize))) + logCrypto("encrypt", chat_encrypt_media(chat_ctrl, &key, pointer.advanced(by: clearTextBytesSize), Int32(unencrypted.count + WebRTCClient.ivTagBytes - clearTextBytesSize))) return Data(bytes: pointer, count: unencrypted.count + WebRTCClient.ivTagBytes) } else { return nil diff --git a/apps/ios/SimpleXChat/CryptoFile.swift b/apps/ios/SimpleXChat/CryptoFile.swift index dcb2be9ae0..0e539ba97c 100644 --- a/apps/ios/SimpleXChat/CryptoFile.swift +++ b/apps/ios/SimpleXChat/CryptoFile.swift @@ -17,7 +17,7 @@ public func writeCryptoFile(path: String, data: Data) throws -> CryptoFileArgs { let ptr: UnsafeMutableRawPointer = malloc(data.count) memcpy(ptr, (data as NSData).bytes, data.count) var cPath = path.cString(using: .utf8)! - let cjson = chat_write_file(&cPath, ptr, Int32(data.count))! + let cjson = chat_write_file(getChatCtrl(), &cPath, ptr, Int32(data.count))! let d = fromCString(cjson).data(using: .utf8)! switch try jsonDecoder.decode(WriteFileResult.self, from: d) { case let .result(cfArgs): return cfArgs @@ -50,7 +50,7 @@ public func readCryptoFile(path: String, cryptoArgs: CryptoFileArgs) throws -> D public func encryptCryptoFile(fromPath: String, toPath: String) throws -> CryptoFileArgs { var cFromPath = fromPath.cString(using: .utf8)! var cToPath = toPath.cString(using: .utf8)! - let cjson = chat_encrypt_file(&cFromPath, &cToPath)! + let cjson = chat_encrypt_file(getChatCtrl(), &cFromPath, &cToPath)! let d = fromCString(cjson).data(using: .utf8)! switch try jsonDecoder.decode(WriteFileResult.self, from: d) { case let .result(cfArgs): return cfArgs diff --git a/apps/ios/SimpleXChat/SimpleX.h b/apps/ios/SimpleXChat/SimpleX.h index 6e37a51779..909d76a76c 100644 --- a/apps/ios/SimpleXChat/SimpleX.h +++ b/apps/ios/SimpleXChat/SimpleX.h @@ -25,11 +25,11 @@ extern char *chat_parse_markdown(char *str); extern char *chat_parse_server(char *str); extern char *chat_password_hash(char *pwd, char *salt); extern char *chat_valid_name(char *name); -extern char *chat_encrypt_media(char *key, char *frame, int len); +extern char *chat_encrypt_media(chat_ctrl ctl, char *key, char *frame, int len); extern char *chat_decrypt_media(char *key, char *frame, int len); // chat_write_file returns null-terminated string with JSON of WriteFileResult -extern char *chat_write_file(char *path, char *data, int len); +extern char *chat_write_file(chat_ctrl ctl, char *path, char *data, int len); // chat_read_file returns a buffer with: // result status (1 byte), then if @@ -38,7 +38,7 @@ extern char *chat_write_file(char *path, char *data, int len); extern char *chat_read_file(char *path, char *key, char *nonce); // chat_encrypt_file returns null-terminated string with JSON of WriteFileResult -extern char *chat_encrypt_file(char *fromPath, char *toPath); +extern char *chat_encrypt_file(chat_ctrl ctl, char *fromPath, char *toPath); // chat_decrypt_file returns null-terminated string with the error message extern char *chat_decrypt_file(char *fromPath, char *key, char *nonce, char *toPath); diff --git a/cabal.project b/cabal.project index e81c21c990..1ff8aacd77 100644 --- a/cabal.project +++ b/cabal.project @@ -14,7 +14,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 8c250ebe19f56dd7d53572d984e8016cb0e4d658 + tag: 13a60d1d3944aa175311563e661161e759b92563 source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 9f06b66101..595d40c4e7 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."8c250ebe19f56dd7d53572d984e8016cb0e4d658" = "080rw86yncf1h3zr5a8y65cndihq6f3ji43vxrdhr2mrb75vmw8m"; + "https://github.com/simplex-chat/simplexmq.git"."13a60d1d3944aa175311563e661161e759b92563" = "08mvqrbjfnq7c6mhkj4hhy4cxn0cj21n49lqzh67ani71g2g1xwa"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d"; "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl"; diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 4e7a1cab9a..8bce204f54 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -22,7 +22,6 @@ import Control.Monad import Control.Monad.Except import Control.Monad.IO.Unlift import Control.Monad.Reader -import Crypto.Random (drgNew) import qualified Data.Aeson as J import Data.Attoparsec.ByteString.Char8 (Parser) import qualified Data.Attoparsec.ByteString.Char8 as A @@ -208,7 +207,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen servers <- agentServers config smpAgent <- getSMPAgentClient aCfg {tbqSize} servers agentStore agentAsync <- newTVarIO Nothing - idsDrg <- newTVarIO =<< liftIO drgNew + random <- liftIO C.newRandom inputQ <- newTBQueueIO tbqSize outputQ <- newTBQueueIO tbqSize connNetworkStatuses <- atomically TM.empty @@ -243,7 +242,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen agentAsync, chatStore, chatStoreChanged, - idsDrg, + random, inputQ, outputQ, connNetworkStatuses, @@ -1077,8 +1076,9 @@ processChatCommand = \case then do calls <- asks currentCalls withChatLock "sendCallInvitation" $ do - callId <- CallId <$> drgRandomBytes 16 - dhKeyPair <- if encryptedCall callType then Just <$> liftIO C.generateKeyPair' else pure Nothing + g <- asks random + callId <- atomically $ CallId <$> C.randomBytes 16 g + dhKeyPair <- atomically $ if encryptedCall callType then Just <$> C.generateKeyPair g else pure Nothing let invitation = CallInvitation {callType, callDhPubKey = fst <$> dhKeyPair} callState = CallInvitationSent {localCallType = callType, localDhPrivKey = snd <$> dhKeyPair} (msg, _) <- sendDirectContactMessage ct (XCallInv callId invitation) @@ -1600,7 +1600,7 @@ processChatCommand = \case processChatCommand $ APIChatItemReaction chatRef chatItemId add reaction APINewGroup userId incognito gProfile@GroupProfile {displayName} -> withUserId userId $ \user -> do checkValidName displayName - gVar <- asks idsDrg + gVar <- asks random -- [incognito] generate incognito profile for group membership incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing groupInfo <- withStore $ \db -> createNewGroup db gVar user gProfile incognitoProfile @@ -1621,7 +1621,7 @@ processChatCommand = \case let sendInvitation = sendGrpInvitation user contact gInfo case contactMember contact members of Nothing -> do - gVar <- asks idsDrg + gVar <- asks random subMode <- chatReadVar subscriptionMode (agentConnId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing subMode member <- withStore $ \db -> createNewContactMember db gVar user gInfo contact memRole agentConnId cReq subMode @@ -1884,7 +1884,7 @@ processChatCommand = \case SetFileToReceive fileId encrypted_ -> withUser $ \_ -> do withChatLock "setFileToReceive" . procCmd $ do encrypt <- (`fromMaybe` encrypted_) <$> chatReadVar encryptLocalFiles - cfArgs <- if encrypt then Just <$> liftIO CF.randomArgs else pure Nothing + cfArgs <- if encrypt then Just <$> (atomically . CF.randomArgs =<< asks random) else pure Nothing withStore' $ \db -> setRcvFileToReceive db fileId cfArgs ok_ CancelFile fileId -> withUser $ \user@User {userId} -> @@ -2030,7 +2030,7 @@ processChatCommand = \case -- in View.hs `r'` should be defined as `id` in this case -- procCmd :: m ChatResponse -> m ChatResponse -- procCmd action = do - -- ChatController {chatLock = l, smpAgent = a, outputQ = q, idsDrg = gVar} <- ask + -- ChatController {chatLock = l, smpAgent = a, outputQ = q, random = gVar} <- ask -- corrId <- liftIO $ SMP.CorrId <$> randomBytes gVar 8 -- void . forkIO $ -- withAgentLock a . withLock l name $ @@ -2296,7 +2296,7 @@ processChatCommand = \case then pure Nothing else Just . addUTCTime (realToFrac ttl) <$> liftIO getCurrentTime drgRandomBytes :: Int -> m ByteString - drgRandomBytes n = asks idsDrg >>= liftIO . (`randomBytes` n) + drgRandomBytes n = asks random >>= atomically . C.randomBytes n privateGetUser :: UserId -> m User privateGetUser userId = tryChatError (withStore (`getUser` userId)) >>= \case @@ -2571,7 +2571,7 @@ toFSFilePath f = setFileToEncrypt :: ChatMonad m => RcvFileTransfer -> m RcvFileTransfer setFileToEncrypt ft@RcvFileTransfer {fileId} = do - cfArgs <- liftIO CF.randomArgs + cfArgs <- atomically . CF.randomArgs =<< asks random withStore' $ \db -> setFileCryptoArgs db fileId cfArgs pure (ft :: RcvFileTransfer) {cryptoArgs = Just cfArgs} @@ -2726,7 +2726,7 @@ acceptGroupJoinRequestAsync ucr@UserContactRequest {agentInvitationId = AgentInvId invId} gLinkMemRole incognitoProfile = do - gVar <- asks idsDrg + gVar <- asks random (groupMemberId, memberId) <- withStore $ \db -> createAcceptedMember db gVar user gInfo ucr gLinkMemRole let Profile {displayName} = profileToSendOnAccept user incognitoProfile GroupMember {memberRole = userRole, memberId = userMemberId} = membership @@ -3407,7 +3407,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do groupInfo <- withStore $ \db -> getGroupInfo db user groupId subMode <- chatReadVar subscriptionMode groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode - gVar <- asks idsDrg + gVar <- asks random withStore $ \db -> createNewContactMemberAsync db gVar user groupInfo ct gLinkMemRole groupConnIds (fromJVersionRange peerChatVRange) subMode Just (gInfo, m@GroupMember {activeConn}) -> when (maybe False ((== ConnReady) . connStatus) activeConn) $ do @@ -4049,7 +4049,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do probeMatchingContactsAndMembers :: Contact -> IncognitoEnabled -> Bool -> m () probeMatchingContactsAndMembers ct connectedIncognito doProbeContacts = do - gVar <- asks idsDrg + gVar <- asks random contactMerge <- readTVarIO =<< asks contactMergeEnabled if contactMerge && not connectedIncognito then do @@ -4073,7 +4073,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do probeMatchingMemberContact :: GroupMember -> IncognitoEnabled -> m () probeMatchingMemberContact GroupMember {activeConn = Nothing} _ = pure () probeMatchingMemberContact m@GroupMember {groupId, activeConn = Just conn} connectedIncognito = do - gVar <- asks idsDrg + gVar <- asks random contactMerge <- readTVarIO =<< asks contactMergeEnabled if contactMerge && not connectedIncognito then do @@ -4774,7 +4774,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do checkIntegrityCreateItem (CDDirectRcv ct) msgMeta if featureAllowed SCFCalls forContact ct then do - dhKeyPair <- if encryptedCall callType then Just <$> liftIO C.generateKeyPair' else pure Nothing + g <- asks random + dhKeyPair <- atomically $ if encryptedCall callType then Just <$> C.generateKeyPair g else pure Nothing ci <- saveCallItem CISCallPending let sharedKey = C.Key . C.dhBytes' <$> (C.dh' <$> callDhPubKey <*> (snd <$> dhKeyPair)) callState = CallInvitationReceived {peerCallType = callType, localDhPubKey = fst <$> dhKeyPair, sharedKey} @@ -5517,7 +5518,7 @@ sendDirectMessage conn chatMsgEvent connOrGroupId = do createSndMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> ConnOrGroupId -> m SndMessage createSndMessage chatMsgEvent connOrGroupId = do - gVar <- asks idsDrg + gVar <- asks random ChatConfig {chatVRange} <- asks config withStore $ \db -> createNewSndMessage db gVar connOrGroupId $ \sharedMsgId -> let msgBody = strEncode ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent} diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 70e0cc64fc..b198cccbf7 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -180,7 +180,7 @@ data ChatController = ChatController agentAsync :: TVar (Maybe (Async (), Maybe (Async ()))), chatStore :: SQLiteStore, chatStoreChanged :: TVar Bool, -- if True, chat should be fully restarted - idsDrg :: TVar ChaChaDRG, + random :: TVar ChaChaDRG, inputQ :: TBQueue String, outputQ :: TBQueue (Maybe CorrId, Maybe RemoteHostId, ChatResponse), connNetworkStatuses :: TMap AgentConnId NetworkStatus, diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index a7f032c75b..6540352a3d 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -94,15 +94,15 @@ foreign export ccall "chat_password_hash" cChatPasswordHash :: CString -> CStrin foreign export ccall "chat_valid_name" cChatValidName :: CString -> IO CString -foreign export ccall "chat_encrypt_media" cChatEncryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString +foreign export ccall "chat_encrypt_media" cChatEncryptMedia :: StablePtr ChatController -> CString -> Ptr Word8 -> CInt -> IO CString foreign export ccall "chat_decrypt_media" cChatDecryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString -foreign export ccall "chat_write_file" cChatWriteFile :: CString -> Ptr Word8 -> CInt -> IO CJSONString +foreign export ccall "chat_write_file" cChatWriteFile :: StablePtr ChatController -> CString -> Ptr Word8 -> CInt -> IO CJSONString foreign export ccall "chat_read_file" cChatReadFile :: CString -> CString -> CString -> IO (Ptr Word8) -foreign export ccall "chat_encrypt_file" cChatEncryptFile :: CString -> CString -> IO CJSONString +foreign export ccall "chat_encrypt_file" cChatEncryptFile :: StablePtr ChatController -> CString -> CString -> IO CJSONString foreign export ccall "chat_decrypt_file" cChatDecryptFile :: CString -> CString -> CString -> CString -> IO CString diff --git a/src/Simplex/Chat/Mobile/File.hs b/src/Simplex/Chat/Mobile/File.hs index 1da64a3044..afbb1bc8c9 100644 --- a/src/Simplex/Chat/Mobile/File.hs +++ b/src/Simplex/Chat/Mobile/File.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} @@ -31,7 +32,9 @@ import Data.Word (Word32, Word8) import Foreign.C import Foreign.Marshal.Alloc (mallocBytes) import Foreign.Ptr +import Foreign.StablePtr import Foreign.Storable (poke, pokeByteOff) +import Simplex.Chat.Controller (ChatController (..)) import Simplex.Chat.Mobile.Shared import Simplex.Chat.Util (chunkSize, encryptFile) import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..), CryptoFileHandle, FTCryptoError (..)) @@ -39,7 +42,7 @@ import qualified Simplex.Messaging.Crypto.File as CF import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON) import Simplex.Messaging.Util (catchAll) -import UnliftIO (Handle, IOMode (..), withFile) +import UnliftIO (Handle, IOMode (..), atomically, withFile) data WriteFileResult = WFResult {cryptoArgs :: CryptoFileArgs} @@ -47,16 +50,17 @@ data WriteFileResult $(JQ.deriveToJSON (sumTypeJSON $ dropPrefix "WF") ''WriteFileResult) -cChatWriteFile :: CString -> Ptr Word8 -> CInt -> IO CJSONString -cChatWriteFile cPath ptr len = do +cChatWriteFile :: StablePtr ChatController -> CString -> Ptr Word8 -> CInt -> IO CJSONString +cChatWriteFile cc cPath ptr len = do + c <- deRefStablePtr cc path <- peekCString cPath s <- getByteString ptr len - r <- chatWriteFile path s + r <- chatWriteFile c path s newCStringFromLazyBS $ J.encode r -chatWriteFile :: FilePath -> ByteString -> IO WriteFileResult -chatWriteFile path s = do - cfArgs <- CF.randomArgs +chatWriteFile :: ChatController -> FilePath -> ByteString -> IO WriteFileResult +chatWriteFile ChatController {random} path s = do + cfArgs <- atomically $ CF.randomArgs random let file = CryptoFile path $ Just cfArgs either WFError (\_ -> WFResult cfArgs) <$> runCatchExceptT (withExceptT show $ CF.writeFile file $ LB.fromStrict s) @@ -87,19 +91,20 @@ chatReadFile path keyStr nonceStr = runCatchExceptT $ do let file = CryptoFile path $ Just $ CFArgs key nonce withExceptT show $ CF.readFile file -cChatEncryptFile :: CString -> CString -> IO CJSONString -cChatEncryptFile cFromPath cToPath = do +cChatEncryptFile :: StablePtr ChatController -> CString -> CString -> IO CJSONString +cChatEncryptFile cc cFromPath cToPath = do + c <- deRefStablePtr cc fromPath <- peekCString cFromPath toPath <- peekCString cToPath - r <- chatEncryptFile fromPath toPath + r <- chatEncryptFile c fromPath toPath newCAString . LB'.unpack $ J.encode r -chatEncryptFile :: FilePath -> FilePath -> IO WriteFileResult -chatEncryptFile fromPath toPath = +chatEncryptFile :: ChatController -> FilePath -> FilePath -> IO WriteFileResult +chatEncryptFile ChatController {random} fromPath toPath = either WFError WFResult <$> runCatchExceptT encrypt where encrypt = do - cfArgs <- liftIO CF.randomArgs + cfArgs <- atomically $ CF.randomArgs random encryptFile fromPath toPath cfArgs pure cfArgs diff --git a/src/Simplex/Chat/Mobile/WebRTC.hs b/src/Simplex/Chat/Mobile/WebRTC.hs index 422cfd5a8c..537388b18b 100644 --- a/src/Simplex/Chat/Mobile/WebRTC.hs +++ b/src/Simplex/Chat/Mobile/WebRTC.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} module Simplex.Chat.Mobile.WebRTC ( cChatEncryptMedia, @@ -21,11 +22,14 @@ import Data.Either (fromLeft) import Data.Word (Word8) import Foreign.C (CInt, CString, newCAString) import Foreign.Ptr (Ptr) +import Foreign.StablePtr +import Simplex.Chat.Controller (ChatController (..)) import Simplex.Chat.Mobile.Shared import qualified Simplex.Messaging.Crypto as C +import UnliftIO (atomically) -cChatEncryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString -cChatEncryptMedia = cTransformMedia chatEncryptMedia +cChatEncryptMedia :: StablePtr ChatController -> CString -> Ptr Word8 -> CInt -> IO CString +cChatEncryptMedia = cTransformMedia . chatEncryptMedia cChatDecryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString cChatDecryptMedia = cTransformMedia chatDecryptMedia @@ -39,11 +43,12 @@ cTransformMedia f cKey cFrame cFrameLen = do putFrame s = when (B.length s <= fromIntegral cFrameLen) $ putByteString cFrame s {-# INLINE cTransformMedia #-} -chatEncryptMedia :: ByteString -> ByteString -> ExceptT String IO ByteString -chatEncryptMedia keyStr frame = do +chatEncryptMedia :: StablePtr ChatController -> ByteString -> ByteString -> ExceptT String IO ByteString +chatEncryptMedia cc keyStr frame = do + ChatController {random} <- liftIO $ deRefStablePtr cc len <- checkFrameLen frame key <- decodeKey keyStr - iv <- liftIO C.randomGCMIV + iv <- atomically $ C.randomGCMIV random (tag, frame') <- withExceptT show $ C.encryptAESNoPad key iv $ B.take len frame pure $ frame' <> BA.convert (C.unAuthTag tag) <> C.unGCMIV iv diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs index 3d98eb7e35..f3d0ba4d1b 100644 --- a/src/Simplex/Chat/Remote.hs +++ b/src/Simplex/Chat/Remote.hs @@ -142,7 +142,7 @@ startRemoteHost rh_ rcAddrPrefs_ port_ = do Just (rhId, multicast) -> do rh@RemoteHost {hostPairing} <- withStore $ \db -> getRemoteHost db rhId pure (RHId rhId, multicast, Just $ remoteHostInfo rh $ Just RHSStarting, hostPairing) -- get from the database, start multicast if requested - Nothing -> (RHNew,False,Nothing,) <$> rcNewHostPairing + Nothing -> withAgent $ \a -> (RHNew,False,Nothing,) <$> rcNewHostPairing a sseq <- startRemoteHostSession rhKey ctrlAppInfo <- mkCtrlAppInfo (localAddrs, invitation, rchClient, vars) <- handleConnectError rhKey sseq . withAgent $ \a -> rcConnectHost a pairing (J.toJSON ctrlAppInfo) multicast rcAddrPrefs_ port_ @@ -352,7 +352,7 @@ storeRemoteFile rhId encrypted_ localPath = do tmpDir <- getChatTempDirectory createDirectoryIfMissing True tmpDir tmpFile <- tmpDir `uniqueCombine` takeFileName localPath - cfArgs <- liftIO CF.randomArgs + cfArgs <- atomically . CF.randomArgs =<< asks random liftError (ChatError . CEFileWrite tmpFile) $ encryptFile localPath tmpFile cfArgs pure $ CryptoFile tmpFile $ Just cfArgs diff --git a/src/Simplex/Chat/Remote/Protocol.hs b/src/Simplex/Chat/Remote/Protocol.hs index af4c7d33ec..b8ff847091 100644 --- a/src/Simplex/Chat/Remote/Protocol.hs +++ b/src/Simplex/Chat/Remote/Protocol.hs @@ -78,7 +78,7 @@ $(deriveJSON (taggedObjectJSON $ dropPrefix "RR") ''RemoteResponse) mkRemoteHostClient :: ChatMonad m => HTTP2Client -> HostSessKeys -> SessionCode -> FilePath -> HostAppInfo -> m RemoteHostClient mkRemoteHostClient httpClient sessionKeys sessionCode storePath HostAppInfo {encoding, deviceName, encryptFiles} = do - drg <- asks $ agentDRG . smpAgent + drg <- asks random counter <- newTVarIO 1 let HostSessKeys {hybridKey, idPrivKey, sessPrivKey} = sessionKeys signatures = RSSign {idPrivKey, sessPrivKey} @@ -95,7 +95,7 @@ mkRemoteHostClient httpClient sessionKeys sessionCode storePath HostAppInfo {enc mkCtrlRemoteCrypto :: ChatMonad m => CtrlSessKeys -> SessionCode -> m RemoteCrypto mkCtrlRemoteCrypto CtrlSessKeys {hybridKey, idPubKey, sessPubKey} sessionCode = do - drg <- asks $ agentDRG . smpAgent + drg <- asks random counter <- newTVarIO 1 let signatures = RSVerify {idPubKey, sessPubKey} pure RemoteCrypto {drg, counter, sessionCode, hybridKey, signatures} diff --git a/src/Simplex/Chat/Remote/Transport.hs b/src/Simplex/Chat/Remote/Transport.hs index ccd10b328a..1c9c3f08eb 100644 --- a/src/Simplex/Chat/Remote/Transport.hs +++ b/src/Simplex/Chat/Remote/Transport.hs @@ -24,7 +24,7 @@ type EncryptedFile = ((Handle, Word32), C.CbNonce, LC.SbState) prepareEncryptedFile :: RemoteCrypto -> (Handle, Word32) -> ExceptT RemoteProtocolError IO EncryptedFile prepareEncryptedFile RemoteCrypto {drg, hybridKey} f = do - nonce <- atomically $ C.pseudoRandomCbNonce drg + nonce <- atomically $ C.randomCbNonce drg sbState <- liftEitherWith (const $ PRERemoteControl RCEEncrypt) $ LC.kcbInit hybridKey nonce pure (f, nonce, sbState) diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index e1125adc3a..1e69d70767 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -15,7 +15,7 @@ import qualified Control.Exception as E import Control.Monad import Control.Monad.Except import Control.Monad.IO.Class -import Crypto.Random (ChaChaDRG, randomBytesGenerate) +import Crypto.Random (ChaChaDRG) import qualified Data.Aeson.TH as J import qualified Data.ByteString.Base64 as B64 import Data.ByteString.Char8 (ByteString) @@ -35,6 +35,7 @@ import Simplex.Chat.Types.Preferences import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, UserId) import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB +import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON) import Simplex.Messaging.Protocol (SubscriptionMode (..)) import Simplex.Messaging.Util (allFinally) @@ -389,7 +390,4 @@ createWithRandomBytes size gVar create = tryCreate 3 | otherwise -> throwError . SEInternalError $ show e encodedRandomBytes :: TVar ChaChaDRG -> Int -> IO ByteString -encodedRandomBytes gVar = fmap B64.encode . randomBytes gVar - -randomBytes :: TVar ChaChaDRG -> Int -> IO ByteString -randomBytes gVar = atomically . stateTVar gVar . randomBytesGenerate +encodedRandomBytes gVar n = atomically $ B64.encode <$> C.randomBytes n gVar diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs index 4396a900dc..2a0736bc6f 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -1094,7 +1094,7 @@ testXFTPFileTransferEncrypted = let srcPath = "./tests/tmp/alice/test.pdf" createDirectoryIfMissing True "./tests/tmp/alice/" createDirectoryIfMissing True "./tests/tmp/bob/" - WFResult cfArgs <- chatWriteFile srcPath src + WFResult cfArgs <- chatWriteFile (chatController alice) srcPath src let fileJSON = LB.unpack $ J.encode $ CryptoFile srcPath $ Just cfArgs withXFTPServer $ do connectUsers alice bob diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs index 64fb7c98b8..a6231fa27e 100644 --- a/tests/MobileTests.hs +++ b/tests/MobileTests.hs @@ -8,8 +8,8 @@ module MobileTests where import ChatTests.Utils +import Control.Concurrent.STM import Control.Monad.Except -import Crypto.Random (getRandomBytes) import Data.Aeson (FromJSON) import qualified Data.Aeson as J import qualified Data.Aeson.TH as JQ @@ -22,8 +22,10 @@ import Data.Word (Word8, Word32) import Foreign.C import Foreign.Marshal.Alloc (mallocBytes) import Foreign.Ptr +import Foreign.StablePtr import Foreign.Storable (peek) import GHC.IO.Encoding (setLocaleEncoding, setFileSystemEncoding, setForeignEncoding) +import Simplex.Chat.Controller (ChatController (..)) import Simplex.Chat.Mobile import Simplex.Chat.Mobile.File import Simplex.Chat.Mobile.Shared @@ -226,25 +228,29 @@ testChatApi tmp = do chatParseMarkdown "*hello*" `shouldBe` parsedMarkdown testMediaApi :: HasCallStack => FilePath -> IO () -testMediaApi _ = do - key :: ByteString <- getRandomBytes 32 - frame <- getRandomBytes 100 +testMediaApi tmp = do + Right c@ChatController {random = g} <- chatMigrateInit (tmp "1") "" "yesUp" + cc <- newStablePtr c + key <- atomically $ C.randomBytes 32 g + frame <- atomically $ C.randomBytes 100 g let keyStr = strEncode key reserved = B.replicate (C.authTagSize + C.gcmIVSize) 0 frame' = frame <> reserved - Right encrypted <- runExceptT $ chatEncryptMedia keyStr frame' + Right encrypted <- runExceptT $ chatEncryptMedia cc keyStr frame' encrypted `shouldNotBe` frame' B.length encrypted `shouldBe` B.length frame' runExceptT (chatDecryptMedia keyStr encrypted) `shouldReturn` Right frame' testMediaCApi :: HasCallStack => FilePath -> IO () -testMediaCApi _ = do - key :: ByteString <- getRandomBytes 32 - frame <- getRandomBytes 100 +testMediaCApi tmp = do + Right c@ChatController {random = g} <- chatMigrateInit (tmp "1") "" "yesUp" + cc <- newStablePtr c + key <- atomically $ C.randomBytes 32 g + frame <- atomically $ C.randomBytes 100 g let keyStr = strEncode key reserved = B.replicate (C.authTagSize + C.gcmIVSize) 0 frame' = frame <> reserved - encrypted <- test cChatEncryptMedia keyStr frame' + encrypted <- test (cChatEncryptMedia cc) keyStr frame' encrypted `shouldNotBe` frame' test cChatDecryptMedia keyStr encrypted `shouldReturn` frame' where @@ -266,6 +272,7 @@ instance FromJSON ReadFileResult where testFileCApi :: FilePath -> FilePath -> IO () testFileCApi fileName tmp = do + cc <- mkCCPtr tmp src <- B.readFile "./tests/fixtures/test.pdf" let path = tmp (fileName <> ".pdf") cPath <- newCString path @@ -273,7 +280,7 @@ testFileCApi fileName tmp = do cLen = fromIntegral len ptr <- mallocBytes $ B.length src putByteString ptr src - r <- peekCAString =<< cChatWriteFile cPath ptr cLen + r <- peekCAString =<< cChatWriteFile cc cPath ptr cLen Just (WFResult cfArgs@(CFArgs key nonce)) <- jDecode r let encryptedFile = CryptoFile path $ Just cfArgs CF.getFileContentsSize encryptedFile `shouldReturn` fromIntegral (B.length src) @@ -292,7 +299,7 @@ testMissingFileCApi :: FilePath -> IO () testMissingFileCApi tmp = do let path = tmp "missing_file" cPath <- newCString path - CFArgs key nonce <- CF.randomArgs + CFArgs key nonce <- atomically . CF.randomArgs =<< C.newRandom cKey <- encodedCString key cNonce <- encodedCString nonce ptr <- cChatReadFile cPath cKey cNonce @@ -302,13 +309,14 @@ testMissingFileCApi tmp = do testFileEncryptionCApi :: FilePath -> FilePath -> IO () testFileEncryptionCApi fileName tmp = do + cc <- mkCCPtr tmp let fromPath = tmp (fileName <> ".source.pdf") copyFile "./tests/fixtures/test.pdf" fromPath src <- B.readFile fromPath cFromPath <- newCString fromPath let toPath = tmp (fileName <> ".encrypted.pdf") cToPath <- newCString toPath - r <- peekCAString =<< cChatEncryptFile cFromPath cToPath + r <- peekCAString =<< cChatEncryptFile cc cFromPath cToPath Just (WFResult cfArgs@(CFArgs key nonce)) <- jDecode r CF.getFileContentsSize (CryptoFile toPath $ Just cfArgs) `shouldReturn` fromIntegral (B.length src) cKey <- encodedCString key @@ -320,14 +328,15 @@ testFileEncryptionCApi fileName tmp = do testMissingFileEncryptionCApi :: FilePath -> IO () testMissingFileEncryptionCApi tmp = do + cc <- mkCCPtr tmp let fromPath = tmp "missing_file.source.pdf" toPath = tmp "missing_file.encrypted.pdf" cFromPath <- newCString fromPath cToPath <- newCString toPath - r <- peekCAString =<< cChatEncryptFile cFromPath cToPath + r <- peekCAString =<< cChatEncryptFile cc cFromPath cToPath Just (WFError err) <- jDecode r err `shouldContain` fromPath - CFArgs key nonce <- CF.randomArgs + CFArgs key nonce <- atomically . CF.randomArgs =<< C.newRandom cKey <- encodedCString key cNonce <- encodedCString nonce let toPath' = tmp "missing_file.decrypted.pdf" @@ -335,6 +344,9 @@ testMissingFileEncryptionCApi tmp = do err' <- peekCAString =<< cChatDecryptFile cToPath cKey cNonce cToPath' err' `shouldContain` toPath +mkCCPtr :: FilePath -> IO (StablePtr ChatController) +mkCCPtr tmp = either (error . show) newStablePtr =<< chatMigrateInit (tmp "1") "" "yesUp" + testValidNameCApi :: FilePath -> IO () testValidNameCApi _ = do let goodName = "Джон Доу 👍" diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs index 13bc2942fc..ff0e5cb2d1 100644 --- a/tests/RemoteTests.hs +++ b/tests/RemoteTests.hs @@ -11,18 +11,14 @@ import Control.Logger.Simple import qualified Data.Aeson as J import qualified Data.ByteString as B import qualified Data.ByteString.Lazy.Char8 as LB -import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.Map.Strict as M -import qualified Network.TLS as TLS import Simplex.Chat.Archive (archiveFilesFolder) import Simplex.Chat.Controller (ChatConfig (..), XFTPFileConfig (..), versionNumber) import qualified Simplex.Chat.Controller as Controller import Simplex.Chat.Mobile.File import Simplex.Chat.Remote.Types -import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFileArgs (..)) import Simplex.Messaging.Encoding.String (strEncode) -import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials) import Simplex.Messaging.Util import System.FilePath (()) import Test.Hspec @@ -571,12 +567,6 @@ contactBob desktop bob = do (desktop <## "bob (Bob): contact is connected") (bob <## "alice (Alice): contact is connected") -genTestCredentials :: IO (C.KeyHash, TLS.Credentials) -genTestCredentials = do - caCreds <- liftIO $ genCredentials Nothing (0, 24) "CA" - sessionCreds <- liftIO $ genCredentials (Just caCreds) (0, 24) "Session" - pure . tlsCredentials $ sessionCreds :| [caCreds] - stopDesktop :: HasCallStack => TestCC -> TestCC -> IO () stopDesktop mobile desktop = do logWarn "stopping via desktop" diff --git a/tests/Test.hs b/tests/Test.hs index ee5804aa9a..21aa379c17 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -26,7 +26,7 @@ main = do describe "JSON Tests" jsonTests describe "SimpleX chat view" viewTests describe "SimpleX chat protocol" protocolTests - describe "WebRTC encryption" webRTCTests + around tmpBracket $ describe "WebRTC encryption" webRTCTests describe "Valid names" validNameTests around testBracket $ do describe "Mobile API Tests" mobileTests @@ -35,10 +35,11 @@ main = do xdescribe'' "SimpleX Directory service bot" directoryServiceTests describe "Remote session" remoteTests where - testBracket test = do + testBracket test = withSmpServer $ tmpBracket test + tmpBracket test = do t <- getSystemTime let ts = show (systemSeconds t) <> show (systemNanoseconds t) - withSmpServer $ withTmpFiles $ withTempDirectory "tests/tmp" ts test + withTmpFiles $ withTempDirectory "tests/tmp" ts test logCfg :: LogConfig logCfg = LogConfig {lc_file = Nothing, lc_stderr = True} diff --git a/tests/WebRTCTests.hs b/tests/WebRTCTests.hs index 7dd24e6082..a473afef36 100644 --- a/tests/WebRTCTests.hs +++ b/tests/WebRTCTests.hs @@ -1,36 +1,49 @@ +{-# LANGUAGE OverloadedStrings #-} + module WebRTCTests where import Control.Monad.Except import Crypto.Random (getRandomBytes) import qualified Data.ByteString.Base64.URL as U import qualified Data.ByteString.Char8 as B +import Foreign.StablePtr +import Simplex.Chat.Mobile import Simplex.Chat.Mobile.WebRTC import qualified Simplex.Messaging.Crypto as C +import System.FilePath (()) import Test.Hspec -webRTCTests :: Spec +webRTCTests :: SpecWith FilePath webRTCTests = describe "WebRTC crypto" $ do - it "encrypts and decrypts media" $ do + it "encrypts and decrypts media" $ \tmp -> do + Right c <- chatMigrateInit (tmp "1") "" "yesUp" + cc <- newStablePtr c key <- U.encode <$> getRandomBytes 32 frame <- getRandomBytes 1000 - Right frame' <- runExceptT $ chatEncryptMedia key $ frame <> B.replicate reservedSize '\NUL' + Right frame' <- runExceptT $ chatEncryptMedia cc key $ frame <> B.replicate reservedSize '\NUL' B.length frame' `shouldBe` B.length frame + reservedSize Right frame'' <- runExceptT $ chatDecryptMedia key frame' frame'' `shouldBe` frame <> B.replicate reservedSize '\NUL' - it "should fail on invalid frame size" $ do + it "should fail on invalid frame size" $ \tmp -> do + Right c <- chatMigrateInit (tmp "1") "" "yesUp" + cc <- newStablePtr c key <- U.encode <$> getRandomBytes 32 frame <- getRandomBytes 10 - runExceptT (chatEncryptMedia key frame) `shouldReturn` Left "frame has no [reserved space for] IV and/or auth tag" + runExceptT (chatEncryptMedia cc key frame) `shouldReturn` Left "frame has no [reserved space for] IV and/or auth tag" runExceptT (chatDecryptMedia key frame) `shouldReturn` Left "frame has no [reserved space for] IV and/or auth tag" - it "should fail on invalid key" $ do + it "should fail on invalid key" $ \tmp -> do + Right c <- chatMigrateInit (tmp "1") "" "yesUp" + cc <- newStablePtr c let key = B.replicate 32 '#' frame <- (<> B.replicate reservedSize '\NUL') <$> getRandomBytes 100 - runExceptT (chatEncryptMedia key frame) `shouldReturn` Left "invalid key: invalid character at offset: 0" + runExceptT (chatEncryptMedia cc key frame) `shouldReturn` Left "invalid key: invalid character at offset: 0" runExceptT (chatDecryptMedia key frame) `shouldReturn` Left "invalid key: invalid character at offset: 0" - it "should fail on invalid auth tag" $ do + it "should fail on invalid auth tag" $ \tmp -> do + Right c <- chatMigrateInit (tmp "1") "" "yesUp" + cc <- newStablePtr c key <- U.encode <$> getRandomBytes 32 frame <- getRandomBytes 1000 - Right frame' <- runExceptT $ chatEncryptMedia key $ frame <> B.replicate reservedSize '\NUL' + Right frame' <- runExceptT $ chatEncryptMedia cc key $ frame <> B.replicate reservedSize '\NUL' Right frame'' <- runExceptT $ chatDecryptMedia key frame' frame'' `shouldBe` frame <> B.replicate reservedSize '\NUL' let (encFrame, rest) = B.splitAt (B.length frame' - reservedSize) frame