From ee2ea152dc95053bdbb966536da430555a993663 Mon Sep 17 00:00:00 2001 From: Evgeny Date: Sat, 24 May 2025 21:13:10 +0100 Subject: [PATCH] core: refactor types for DB entity (#5945) --- cabal.project | 2 +- scripts/nix/sha256map.nix | 2 +- simplex-chat.cabal | 2 +- src/Simplex/Chat.hs | 1 + src/Simplex/Chat/Library/Commands.hs | 5 ++- src/Simplex/Chat/Operators.hs | 63 +-------------------------- src/Simplex/Chat/Operators/Presets.hs | 1 + src/Simplex/Chat/Store/Profiles.hs | 5 ++- src/Simplex/Chat/Store/Remote.hs | 5 ++- src/Simplex/Chat/View.hs | 1 + tests/OperatorTests.hs | 1 + 11 files changed, 18 insertions(+), 70 deletions(-) diff --git a/cabal.project b/cabal.project index c6abdfbbde..012eb62618 100644 --- a/cabal.project +++ b/cabal.project @@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: ffecd4a17af68677dedf05c95a80dc0f5c584236 + tag: 56ea2fdd56af5f5a5da41642486aa086d7371823 source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 954f2f0341..fa637db5bc 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."ffecd4a17af68677dedf05c95a80dc0f5c584236" = "09c4yjn1329844f7dxw5fklxxh6jmn8d5g72mw113bs99sp9mcf7"; + "https://github.com/simplex-chat/simplexmq.git"."56ea2fdd56af5f5a5da41642486aa086d7371823" = "1ninimiccsk0ba4wls2i9rqxj6g057m2k30zw19jvzma4xbalzg8"; "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/simplex-chat.cabal b/simplex-chat.cabal index 553f2ec6cd..d35e76f344 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -256,6 +256,7 @@ library , constraints >=0.12 && <0.14 , containers ==0.6.* , crypton ==0.34.* + , crypton-x509 ==1.7.* , data-default ==0.7.* , directory ==1.3.* , email-validate ==2.3.* @@ -271,7 +272,6 @@ library , optparse-applicative >=0.15 && <0.17 , random >=1.1 && <1.3 , record-hasfield ==1.0.* - , scientific ==0.3.7.* , simple-logger ==0.1.* , simplexmq >=6.3 , socks ==0.6.* diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 6b554d29c4..e14275b75c 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -44,6 +44,7 @@ import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers import Simplex.Messaging.Agent.Protocol import Simplex.Messaging.Agent.Store.Common (DBStore (dbNew)) import qualified Simplex.Messaging.Agent.Store.DB as DB +import Simplex.Messaging.Agent.Store.Entity import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..), MigrationError) import Simplex.Messaging.Client (defaultNetworkConfig) import qualified Simplex.Messaging.Crypto as C diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 744bb2ba26..1653c33aaa 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -88,6 +88,7 @@ import Simplex.FileTransfer.Description (FileDescriptionURI (..), maxFileSize, m import Simplex.Messaging.Agent as Agent import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..), allRoles) import Simplex.Messaging.Agent.Protocol +import Simplex.Messaging.Agent.Store.Entity import Simplex.Messaging.Agent.Store.Interface (execSQL) import Simplex.Messaging.Agent.Store.Shared (upMigration) import qualified Simplex.Messaging.Agent.Store.DB as DB @@ -197,7 +198,7 @@ startChatController mainApp enableSndFiles = do startExpireCIThread user setExpireCIFlag user True where - shouldExpireChats = + shouldExpireChats = fmap (fromRight False) $ runExceptT $ withStore' $ \db -> do ttl <- getChatItemTTL db user ttlCount <- getChatTTLCount db user @@ -3683,7 +3684,7 @@ startExpireCIThread user@User {userId} = do liftIO $ threadDelay' interval setChatItemsExpiration :: User -> Int64 -> Int -> CM' () -setChatItemsExpiration user newTTL ttlCount +setChatItemsExpiration user newTTL ttlCount | newTTL > 0 || ttlCount > 0 = do startExpireCIThread user whenM chatStarted $ setExpireCIFlag user True diff --git a/src/Simplex/Chat/Operators.hs b/src/Simplex/Chat/Operators.hs index 8c4490a2c4..c9b5e020d9 100644 --- a/src/Simplex/Chat/Operators.hs +++ b/src/Simplex/Chat/Operators.hs @@ -37,7 +37,6 @@ import qualified Data.List.NonEmpty as L import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe, isNothing, mapMaybe) -import Data.Scientific (floatingOrInteger) import Data.Set (Set) import qualified Data.Set as S import Data.Text (Text) @@ -46,11 +45,11 @@ import Data.Time (addUTCTime) import Data.Time.Clock (UTCTime, nominalDay) import Language.Haskell.TH.Syntax (lift) import Simplex.Chat.Operators.Conditions -import Simplex.Chat.Options.DB (FromField (..), ToField (..)) import Simplex.Chat.Types (User) import Simplex.Chat.Types.Util (textParseJSON) import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..), allRoles) -import Simplex.Messaging.Agent.Store.DB (fromTextField_) +import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_) +import Simplex.Messaging.Agent.Store.Entity import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON) import Simplex.Messaging.Protocol (AProtocolType (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI, SProtocolType (..), UserProtocol) @@ -69,32 +68,6 @@ usageConditionsText = in [|stripFrontMatter $(lift (safeDecodeUtf8 s))|] ) -data DBStored = DBStored | DBNew - -data SDBStored (s :: DBStored) where - SDBStored :: SDBStored 'DBStored - SDBNew :: SDBStored 'DBNew - -deriving instance Show (SDBStored s) - -class DBStoredI s where sdbStored :: SDBStored s - -instance DBStoredI 'DBStored where sdbStored = SDBStored - -instance DBStoredI 'DBNew where sdbStored = SDBNew - -data DBEntityId' (s :: DBStored) where - DBEntityId :: Int64 -> DBEntityId' 'DBStored - DBNewEntity :: DBEntityId' 'DBNew - -deriving instance Show (DBEntityId' s) - -deriving instance Eq (DBEntityId' s) - -type DBEntityId = DBEntityId' 'DBStored - -type DBNewEntity = DBEntityId' 'DBNew - data OperatorTag = OTSimplex | OTFlux deriving (Eq, Ord, Show) @@ -118,19 +91,6 @@ instance TextEncoding OperatorTag where OTSimplex -> "simplex" OTFlux -> "flux" --- this and other types only define instances of serialization for known DB IDs only, --- entities without IDs cannot be serialized to JSON -instance FromField DBEntityId -#if defined(dbPostgres) - where - fromField f dat = DBEntityId <$> fromField f dat -#else - where - fromField f = DBEntityId <$> fromField f -#endif - -instance ToField DBEntityId where toField (DBEntityId i) = toField i - data UsageConditions = UsageConditions { conditionsId :: Int64, conditionsCommit :: Text, @@ -486,25 +446,6 @@ validateUserServers curr others = currUserErrs <> concatMap otherUserErrs others userServers :: (UserServersClass u, UserProtocol p) => SProtocolType p -> [u] -> [AUserServer p] userServers p = map aUserServer' . concatMap (servers' p) -instance ToJSON (DBEntityId' s) where - toEncoding = \case - DBEntityId i -> toEncoding i - DBNewEntity -> JE.null_ - toJSON = \case - DBEntityId i -> toJSON i - DBNewEntity -> J.Null - -instance DBStoredI s => FromJSON (DBEntityId' s) where - parseJSON v = case (v, sdbStored @s) of - (J.Null, SDBNew) -> pure DBNewEntity - (J.Number n, SDBStored) -> case floatingOrInteger n of - Left (_ :: Double) -> fail "bad DBEntityId" - Right i -> pure $ DBEntityId (fromInteger i) - _ -> fail "bad DBEntityId" - omittedField = case sdbStored @s of - SDBStored -> Nothing - SDBNew -> Just DBNewEntity - $(JQ.deriveJSON defaultJSON ''UsageConditions) $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CA") ''ConditionsAcceptance) diff --git a/src/Simplex/Chat/Operators/Presets.hs b/src/Simplex/Chat/Operators/Presets.hs index 06c2e19fab..18a0b7ebed 100644 --- a/src/Simplex/Chat/Operators/Presets.hs +++ b/src/Simplex/Chat/Operators/Presets.hs @@ -9,6 +9,7 @@ import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as L import Simplex.Chat.Operators import Simplex.Messaging.Agent.Env.SQLite (ServerRoles (..), allRoles) +import Simplex.Messaging.Agent.Store.Entity import Simplex.Messaging.Protocol (ProtocolType (..), SMPServer) operatorSimpleXChat :: NewServerOperator diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index 4986ed5140..38b2615686 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -111,6 +111,7 @@ import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (defaultJSON) import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI (..), SProtocolType (..), SubscriptionMode) +import Simplex.Messaging.Agent.Store.Entity import Simplex.Messaging.Transport.Client (TransportHost) import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8) #if defined(dbPostgres) @@ -500,14 +501,14 @@ toGroupLinkInfo (groupId_, mRole_) = getGroupLinkInfo :: DB.Connection -> UserId -> GroupId -> IO (Maybe GroupLinkInfo) getGroupLinkInfo db userId groupId = - fmap join $ maybeFirstRow toGroupLinkInfo $ + fmap join $ maybeFirstRow toGroupLinkInfo $ DB.query db [sql| SELECT group_id, group_link_member_role FROM user_contact_links WHERE user_id = ? AND group_id = ? - |] + |] (userId, groupId) getUserContactLinkByConnReq :: DB.Connection -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe UserContactLink) diff --git a/src/Simplex/Chat/Store/Remote.hs b/src/Simplex/Chat/Store/Remote.hs index 4921369b10..cc626ddcf0 100644 --- a/src/Simplex/Chat/Store/Remote.hs +++ b/src/Simplex/Chat/Store/Remote.hs @@ -10,6 +10,7 @@ import Control.Monad.Except import Data.Int (Int64) import Data.Text (Text) import Data.Text.Encoding (decodeASCII, encodeUtf8) +import qualified Data.X509 as X import Data.Word (Word16) import Simplex.Chat.Remote.Types import Simplex.Chat.Store.Shared @@ -66,7 +67,7 @@ remoteHostQuery = FROM remote_hosts |] -toRemoteHost :: (Int64, Text, FilePath, C.APrivateSignKey, C.SignedObject C.Certificate, C.PrivateKeyEd25519, C.KeyHash, C.PublicKeyX25519, Maybe Text, Maybe Text, Maybe Word16) -> RemoteHost +toRemoteHost :: (Int64, Text, FilePath, C.APrivateSignKey, C.SignedObject X.Certificate, C.PrivateKeyEd25519, C.KeyHash, C.PublicKeyX25519, Maybe Text, Maybe Text, Maybe Word16) -> RemoteHost toRemoteHost (remoteHostId, hostDeviceName, storePath, caKey, C.SignedObject caCert, idPrivKey, hostFingerprint, hostDhPubKey, ifaceName_, ifaceAddr_, bindPort_) = RemoteHost {remoteHostId, hostDeviceName, storePath, hostPairing, bindAddress_, bindPort_} where @@ -133,7 +134,7 @@ toRemoteCtrl :: ( RemoteCtrlId, Text, C.APrivateSignKey, - C.SignedObject C.Certificate, + C.SignedObject X.Certificate, C.KeyHash, C.PublicKeyEd25519, C.PrivateKeyX25519, diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 8a6e6037af..54e888ea86 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -60,6 +60,7 @@ import qualified Simplex.FileTransfer.Transport as XFTP import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), SubscriptionsInfo (..)) import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..), ServerRoles (..)) import Simplex.Messaging.Agent.Protocol +import Simplex.Messaging.Agent.Store.Entity import Simplex.Messaging.Client (SMPProxyFallback, SMPProxyMode (..), SocksMode (..)) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) diff --git a/tests/OperatorTests.hs b/tests/OperatorTests.hs index dbfde6a03d..656f0ae0e2 100644 --- a/tests/OperatorTests.hs +++ b/tests/OperatorTests.hs @@ -23,6 +23,7 @@ import Simplex.Chat.Operators.Presets import Simplex.Chat.Types import Simplex.FileTransfer.Client.Presets (defaultXFTPServers) import Simplex.Messaging.Agent.Env.SQLite (ServerRoles (..), allRoles) +import Simplex.Messaging.Agent.Store.Entity import Simplex.Messaging.Protocol import Test.Hspec