dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-09-01 20:18:26 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #509 from simplex-chat/sqlcipher

Browse Source 
switch to SQLCipher
This commit is contained in:
Evgeny Poberezkin
2022-09-14 21:42:24 +01:00
committed by GitHub
parent e328ae5d06 afecefc3ad
commit f08d81252d
9 changed files with 81 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files
cabal.project
+11
View File
@@ -1,6 +1,17 @@
packages: .
-- packages: . ../direct-sqlcipher ../sqlcipher-simple
source-repository-package
type: git
location: https://github.com/simplex-chat/aeson.git
tag: 3eb66f9a68f103b5f1489382aad89f5712a64db7
source-repository-package
type: git
location: https://github.com/simplex-chat/direct-sqlcipher.git
tag: 34309410eb2069b029b8fc1872deb1e0db123294
source-repository-package
type: git
location: https://github.com/simplex-chat/sqlcipher-simple.git
tag: 5e154a2aeccc33ead6c243ec07195ab673137221
package.yaml
+2 -2
View File
@@ -38,7 +38,7 @@ dependencies:
- cryptonite >= 0.27 && < 0.30
- cryptostore == 0.2.*
- data-default == 0.7.*
- direct-sqlite == 2.3.*
- direct-sqlcipher == 2.3.*
- directory == 1.3.*
- filepath == 1.4.*
- http-types == 0.12.*
@@ -56,7 +56,7 @@ dependencies:
- random >= 1.1 && < 1.3
- simple-logger == 0.1.*
- socks == 0.6.*
- sqlite-simple == 0.4.*
- sqlcipher-simple == 0.4.*
- stm == 2.5.*
- template-haskell == 2.16.*
- text == 1.2.*
simplexmq.cabal
+10 -10
View File
@@ -116,7 +116,7 @@ library
, cryptonite >=0.27 && <0.30
, cryptostore ==0.2.*
, data-default ==0.7.*
, direct-sqlite ==2.3.*
, direct-sqlcipher ==2.3.*
, directory ==1.3.*
, filepath ==1.4.*
, generic-random >=1.3 && <1.5
@@ -133,7 +133,7 @@ library
, random >=1.1 && <1.3
, simple-logger ==0.1.*
, socks ==0.6.*
, sqlite-simple ==0.4.*
, sqlcipher-simple ==0.4.*
, stm ==2.5.*
, template-haskell ==2.16.*
, text ==1.2.*
@@ -177,7 +177,7 @@ executable ntf-server
, cryptonite >=0.27 && <0.30
, cryptostore ==0.2.*
, data-default ==0.7.*
, direct-sqlite ==2.3.*
, direct-sqlcipher ==2.3.*
, directory ==1.3.*
, filepath ==1.4.*
, generic-random >=1.3 && <1.5
@@ -195,7 +195,7 @@ executable ntf-server
, simple-logger ==0.1.*
, simplexmq
, socks ==0.6.*
, sqlite-simple ==0.4.*
, sqlcipher-simple ==0.4.*
, stm ==2.5.*
, template-haskell ==2.16.*
, text ==1.2.*
@@ -239,7 +239,7 @@ executable smp-agent
, cryptonite >=0.27 && <0.30
, cryptostore ==0.2.*
, data-default ==0.7.*
, direct-sqlite ==2.3.*
, direct-sqlcipher ==2.3.*
, directory ==1.3.*
, filepath ==1.4.*
, generic-random >=1.3 && <1.5
@@ -257,7 +257,7 @@ executable smp-agent
, simple-logger ==0.1.*
, simplexmq
, socks ==0.6.*
, sqlite-simple ==0.4.*
, sqlcipher-simple ==0.4.*
, stm ==2.5.*
, template-haskell ==2.16.*
, text ==1.2.*
@@ -301,7 +301,7 @@ executable smp-server
, cryptonite >=0.27 && <0.30
, cryptostore ==0.2.*
, data-default ==0.7.*
, direct-sqlite ==2.3.*
, direct-sqlcipher ==2.3.*
, directory ==1.3.*
, filepath ==1.4.*
, generic-random >=1.3 && <1.5
@@ -319,7 +319,7 @@ executable smp-server
, simple-logger ==0.1.*
, simplexmq
, socks ==0.6.*
, sqlite-simple ==0.4.*
, sqlcipher-simple ==0.4.*
, stm ==2.5.*
, template-haskell ==2.16.*
, text ==1.2.*
@@ -380,7 +380,7 @@ test-suite smp-server-test
, cryptonite >=0.27 && <0.30
, cryptostore ==0.2.*
, data-default ==0.7.*
, direct-sqlite ==2.3.*
, direct-sqlcipher ==2.3.*
, directory ==1.3.*
, filepath ==1.4.*
, generic-random >=1.3 && <1.5
@@ -400,7 +400,7 @@ test-suite smp-server-test
, simple-logger ==0.1.*
, simplexmq
, socks ==0.6.*
, sqlite-simple ==0.4.*
, sqlcipher-simple ==0.4.*
, stm ==2.5.*
, template-haskell ==2.16.*
, text ==1.2.*
src/Simplex/Messaging/Agent/Client.hs
+3 -3
View File
@@ -52,7 +52,7 @@ module Simplex.Messaging.Agent.Client
logServer,
removeSubscription,
hasActiveSubscription,
agentDbPath,
agentStore,
AgentOperation (..),
AgentOpState (..),
AgentState (..),
@@ -232,8 +232,8 @@ newAgentClient InitialAgentServers {smp, ntf, netCfg} agentEnv = do
lock <- newTMVar ()
return AgentClient {active, rcvQ, subQ, msgQ, smpServers, smpClients, ntfServers, ntfClients, useNetworkConfig, subscrConns, activeSubs, pendingSubs, connMsgsQueued, smpQueueMsgQueues, smpQueueMsgDeliveries, connCmdsQueued, asyncCmdQueues, asyncCmdProcesses, ntfNetworkOp, rcvNetworkOp, msgDeliveryOp, sndNetworkOp, databaseOp, agentState, getMsgLocks, reconnections, asyncClients, clientId, agentEnv, lock}
agentDbPath :: AgentClient -> FilePath
agentDbPath AgentClient {agentEnv = Env {store = SQLiteStore {dbFilePath}}} = dbFilePath
agentStore :: AgentClient -> SQLiteStore
agentStore AgentClient {agentEnv = Env {store}} = store
class ProtocolServerClient msg where
getProtocolServerClient :: AgentMonad m => AgentClient -> ProtoServer msg -> m (ProtocolClient msg)
src/Simplex/Messaging/Agent/Env/SQLite.hs
+8 -2
View File
@@ -18,6 +18,7 @@ module Simplex.Messaging.Agent.Env.SQLite
defaultReconnectInterval,
Env (..),
newSMPAgentEnv,
createAgentStore,
NtfSupervisor (..),
NtfSupervisorCommand (..),
)
@@ -65,6 +66,7 @@ data AgentConfig = AgentConfig
connIdBytes :: Int,
tbqSize :: Natural,
dbFile :: FilePath,
dbKey :: String,
yesToMigrations :: Bool,
smpCfg :: ProtocolClientConfig,
ntfCfg :: ProtocolClientConfig,
@@ -108,6 +110,7 @@ defaultAgentConfig =
connIdBytes = 12,
tbqSize = 64,
dbFile = "smp-agent.db",
dbKey = "",
yesToMigrations = False,
smpCfg = defaultClientConfig {defaultTransport = (show defaultSMPPort, transport @TLS)},
ntfCfg = defaultClientConfig {defaultTransport = ("443", transport @TLS)},
@@ -139,14 +142,17 @@ data Env = Env
}
newSMPAgentEnv :: (MonadUnliftIO m, MonadRandom m) => AgentConfig -> m Env
newSMPAgentEnv config@AgentConfig {dbFile, yesToMigrations} = do
newSMPAgentEnv config@AgentConfig {dbFile, dbKey, yesToMigrations} = do
idsDrg <- newTVarIO =<< drgNew
store <- liftIO $ createSQLiteStore dbFile Migrations.app yesToMigrations
store <- liftIO $ createAgentStore dbFile dbKey yesToMigrations
clientCounter <- newTVarIO 0
randomServer <- newTVarIO =<< liftIO newStdGen
ntfSupervisor <- atomically . newNtfSubSupervisor $ tbqSize config
return Env {config, store, idsDrg, clientCounter, randomServer, ntfSupervisor}
createAgentStore :: FilePath -> String -> Bool -> IO SQLiteStore
createAgentStore dbFilePath dbKey = createSQLiteStore dbFilePath dbKey Migrations.app
data NtfSupervisor = NtfSupervisor
{ ntfTkn :: TVar (Maybe NtfToken),
ntfSubQ :: TBQueue (ConnId, NtfSupervisorCommand),
src/Simplex/Messaging/Agent/Store/SQLite.hs
+38 -31
View File
@@ -22,6 +22,8 @@ module Simplex.Messaging.Agent.Store.SQLite
( SQLiteStore (..),
createSQLiteStore,
connectSQLiteStore,
closeSQLiteStore,
sqlString,
-- * Queues and connections
createNewConn,
@@ -150,7 +152,7 @@ import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)
import System.Exit (exitFailure)
import System.FilePath (takeDirectory)
import System.IO (hFlush, stdout)
import UnliftIO.Exception (bracket)
import UnliftIO.Exception (bracket, onException)
import qualified UnliftIO.Exception as E
import UnliftIO.STM
@@ -158,28 +160,19 @@ import UnliftIO.STM
data SQLiteStore = SQLiteStore
{ dbFilePath :: FilePath,
dbEncrypted :: TVar Bool,
dbConnection :: TMVar DB.Connection,
dbNew :: Bool
}
createSQLiteStore :: FilePath -> [Migration] -> Bool -> IO SQLiteStore
createSQLiteStore dbFilePath migrations yesToMigrations = do
createSQLiteStore :: FilePath -> String -> [Migration] -> Bool -> IO SQLiteStore
createSQLiteStore dbFilePath dbKey migrations yesToMigrations = do
let dbDir = takeDirectory dbFilePath
createDirectoryIfMissing False dbDir
st <- connectSQLiteStore dbFilePath
checkThreadsafe st
migrateSchema st migrations yesToMigrations
st <- connectSQLiteStore dbFilePath dbKey
migrateSchema st migrations yesToMigrations `onException` closeSQLiteStore st
pure st
checkThreadsafe :: SQLiteStore -> IO ()
checkThreadsafe st = withConnection st $ \db -> do
compileOptions <- DB.query_ db "pragma COMPILE_OPTIONS;" :: IO [[Text]]
let threadsafeOption = find (T.isPrefixOf "THREADSAFE=") (concat compileOptions)
case threadsafeOption of
Just "THREADSAFE=0" -> confirmOrExit "SQLite compiled with non-threadsafe code."
Nothing -> putStrLn "Warning: SQLite THREADSAFE compile option not found"
_ -> return ()
migrateSchema :: SQLiteStore -> [Migration] -> Bool -> IO ()
migrateSchema st migrations yesToMigrations = withConnection st $ \db -> do
Migrations.initialize db
@@ -202,24 +195,38 @@ confirmOrExit s = do
ok <- getLine
when (map toLower ok /= "y") exitFailure
connectSQLiteStore :: FilePath -> IO SQLiteStore
connectSQLiteStore dbFilePath = do
connectSQLiteStore :: FilePath -> String -> IO SQLiteStore
connectSQLiteStore dbFilePath dbKey = do
dbNew <- not <$> doesFileExist dbFilePath
dbConnection <- newTMVarIO =<< connectDB dbFilePath
pure SQLiteStore {dbFilePath, dbConnection, dbNew}
dbConnection <- newTMVarIO =<< connectDB dbFilePath dbKey
dbEncrypted <- newTVarIO . not $ null dbKey
pure SQLiteStore {dbFilePath, dbEncrypted, dbConnection, dbNew}
connectDB :: FilePath -> IO DB.Connection
connectDB path = do
dbConn <- DB.open path
SQLite3.exec (DB.connectionHandle dbConn) . fromQuery $
[sql|
PRAGMA foreign_keys = ON;
-- PRAGMA trusted_schema = OFF;
PRAGMA secure_delete = ON;
PRAGMA auto_vacuum = FULL;
|]
-- _printPragmas dbConn path
pure dbConn
connectDB :: FilePath -> String -> IO DB.Connection
connectDB path key = do
db <- DB.open path
prepare db `onException` DB.close db
-- _printPragmas db path
pure db
where
prepare db = do
let exec = SQLite3.exec $ DB.connectionHandle db
unless (null key) . exec $ "PRAGMA key = " <> sqlString key <> ";"
exec . fromQuery $
[sql|
PRAGMA foreign_keys = ON;
-- PRAGMA trusted_schema = OFF;
PRAGMA secure_delete = ON;
PRAGMA auto_vacuum = FULL;
|]
closeSQLiteStore :: SQLiteStore -> IO ()
closeSQLiteStore st = atomically (takeTMVar $ dbConnection st) >>= DB.close
sqlString :: String -> Text
sqlString s = quote <> T.replace quote "''" (T.pack s) <> quote
where
quote = "'"
-- _printPragmas :: DB.Connection -> FilePath -> IO ()
-- _printPragmas db path = do
stack.yaml
+6
View File
@@ -48,6 +48,12 @@ extra-deps:
- time-compat-1.9.6.1@sha256:42d8f2e08e965e1718917d54ad69e1d06bd4b87d66c41dc7410f59313dba4ed1,5033
- github: simplex-chat/aeson
commit: 3eb66f9a68f103b5f1489382aad89f5712a64db7
# - ../direct-sqlcipher
- github: simplex-chat/direct-sqlcipher
commit: 34309410eb2069b029b8fc1872deb1e0db123294
# - ../sqlcipher-simple
- github: simplex-chat/sqlcipher-simple
commit: 5e154a2aeccc33ead6c243ec07195ab673137221
# - ../hs-tls/core
# - github: simplex-chat/hs-tls
# commit: f6cc753611f80af300401cfae63846e9d7c40d9e
tests/AgentTests/SQLiteTests.hs
+2 -2
View File
@@ -43,7 +43,7 @@ withStore2 = before connect2 . after (removeStore . fst)
connect2 :: IO (SQLiteStore, SQLiteStore)
connect2 = do
s1 <- createStore
s2 <- connectSQLiteStore (dbFilePath s1)
s2 <- connectSQLiteStore (dbFilePath s1) ""
pure (s1, s2)
createStore :: IO SQLiteStore
@@ -51,7 +51,7 @@ createStore = do
-- Randomize DB file name to avoid SQLite IO errors supposedly caused by asynchronous
-- IO operations on multiple similarly named files; error seems to be environment specific
r <- randomIO :: IO Word32
createSQLiteStore (testDB <> show r) Migrations.app True
createSQLiteStore (testDB <> show r) "" Migrations.app True
removeStore :: SQLiteStore -> IO ()
removeStore db = do
tests/AgentTests/SchemaDump.hs
+1 -1
View File
@@ -20,7 +20,7 @@ schemaDumpTest =
testVerifySchemaDump :: IO ()
testVerifySchemaDump = do
void $ createSQLiteStore testDB Migrations.app False
void $ createSQLiteStore testDB "" Migrations.app False
void $ readCreateProcess (shell $ "touch " <> schema) ""
savedSchema <- readFile schema
savedSchema `seq` pure ()