mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-07-02 22:11:54 +00:00
Evgeny
5b93cb0e3f
* core: store context to pass configuration parameters * fix directory * fix test * comment * order --------- Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
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)
|
|
|
|
storeCxt :: ChatController -> StoreCxt
|
|
storeCxt ChatController {config} = mkStoreCxt config
|
|
{-# INLINE storeCxt #-}
|
|
|
|
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_
|