This commit is contained in:
Evgeny Poberezkin
2026-07-01 22:25:06 +01:00
parent 3d36896f91
commit 80ddf976bd
2 changed files with 5 additions and 3 deletions
+3 -1
View File
@@ -100,6 +100,7 @@ where
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Data.Bifunctor (first)
import Data.Either (rights)
import Data.Functor (($>))
import Data.Int (Int64)
@@ -121,6 +122,7 @@ import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Crypto.Ratchet (PQSupport, pattern PQSupportOff)
import qualified Simplex.Messaging.Crypto.Ratchet as CR
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Util ((<$$>))
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..), Query, (:.) (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
@@ -801,7 +803,7 @@ getContactByName db cxt user localDisplayName = do
getContactToConnect :: DB.Connection -> StoreCxt -> User -> ContactNameOrLink -> ExceptT StoreError IO (Maybe (CreatedLinkContact, Contact))
getContactToConnect db cxt user@User {userId} = \case
CTLink sl -> fmap (fmap (\(cReq, ct) -> (CCLink cReq (Just sl), ct))) (getContactViaShortLinkToConnect db cxt user sl)
CTLink sl -> first (`CCLink` Just sl) <$$> getContactViaShortLinkToConnect db cxt user sl
CTName ni ->
liftIO (maybeFirstRow id $ DB.query db byNameQuery (userId, ni)) >>= \case
Just (ctId :: Int64, Just (ACR cMode cReq), Just (sLnk :: ShortLinkContact)) | Just Refl <- testEquality cMode SCMContact ->
+2 -2
View File
@@ -207,7 +207,7 @@ import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Crypto.Random (ChaChaDRG)
import Data.Bifunctor (second)
import Data.Bifunctor (first, second)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Char (toLower)
@@ -1076,7 +1076,7 @@ getGroupInfoByName db cxt user gName = do
getGroupToConnect :: DB.Connection -> StoreCxt -> User -> ContactNameOrLink -> ExceptT StoreError IO (Maybe (CreatedLinkContact, GroupInfo))
getGroupToConnect db cxt user@User {userId} = \case
CTLink sl -> fmap (fmap (\(cReq, g) -> (CCLink cReq (Just sl), g))) (getGroupViaShortLinkToConnect db cxt user sl)
CTLink sl -> first (`CCLink` Just sl) <$$> getGroupViaShortLinkToConnect db cxt user sl
CTName ni ->
liftIO (maybeFirstRow id $ DB.query db byNameQuery (userId, ni)) >>= \case
Just (gId :: Int64, Just cReq, Just (sLnk :: ShortLinkContact)) -> Just . (CCLink cReq (Just sLnk),) <$> getGroupInfo db cxt user gId