mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-25 12:04:22 +00:00
Evgeny
015d5de364
* core: add custom indexed columns to groups and contacts * directory: use database (TODO search/listing) * triggers to maintain current member count * update simplexmq, fix tests, use summary from GroupInfo * fix all directory tests * remove acceptance fields from group reg * enable all tests * clean up * postgres migrations, fixes * query plans * use function in postgres triggers, improve sqlite query * fix export/import * update schema * prevent admins from promoting groups when approving * update listing every 5 minutes
32 lines
1.1 KiB
Haskell
32 lines
1.1 KiB
Haskell
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
module Directory.Util where
|
|
|
|
import Control.Logger.Simple
|
|
import Control.Monad.Except
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as T
|
|
import Simplex.Chat.Controller
|
|
import Simplex.Chat.Types
|
|
import Simplex.Messaging.Agent.Store.Common (withTransaction)
|
|
import qualified Simplex.Messaging.Agent.Store.DB as DB
|
|
import Simplex.Messaging.Util (catchAll)
|
|
|
|
vr :: ChatController -> VersionRangeChat
|
|
vr ChatController {config = ChatConfig {chatVRange}} = chatVRange
|
|
{-# INLINE vr #-}
|
|
|
|
withDB' :: Text -> ChatController -> (DB.Connection -> IO a) -> IO (Either String a)
|
|
withDB' cxt cc a = withDB cxt cc $ ExceptT . fmap Right . a
|
|
|
|
withDB :: Text -> ChatController -> (DB.Connection -> ExceptT String IO a) -> IO (Either String a)
|
|
withDB cxt ChatController {chatStore} action = do
|
|
r_ <- withTransaction chatStore (runExceptT . action) `catchAll` (pure . Left . show)
|
|
case r_ of
|
|
Left e -> logError $ "Database error: " <> cxt <> " " <> T.pack e
|
|
Right _ -> pure ()
|
|
pure r_
|