core: use ChaChaDRG as the source of randomness (#3551)

* core: use ChaChaDRG as the source of randomness

* do not use entropy directly

* dont use RNG from agent

* simplexmq

* update iOS
This commit is contained in:
Evgeny Poberezkin
2023-12-21 00:42:40 +00:00
committed by GitHub
parent 4a4d470859
commit 7bcda7e54b
19 changed files with 120 additions and 94 deletions
+1 -1
View File
@@ -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,
+3 -3
View File
@@ -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
+18 -13
View File
@@ -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
+10 -5
View File
@@ -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
+2 -2
View File
@@ -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
+2 -2
View File
@@ -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}
+1 -1
View File
@@ -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)
+3 -5
View File
@@ -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